From fe55e939f95b198602ca12659fc13759c33a6fc5 Mon Sep 17 00:00:00 2001 From: Jason Merrill Date: Thu, 12 Feb 2009 23:13:16 -0500 Subject: [PATCH 001/119] Added math.dual and math.derivatives for computing with dual numbers. Also made a few more methods in math.functions generic in order to specialize them on dual numbers. --- basis/math/functions/functions.factor | 8 +- extra/math/derivatives/authors.txt | 1 + .../math/derivatives/derivatives-docs.factor | 11 +++ .../math/derivatives/derivatives-tests.factor | 4 + extra/math/derivatives/derivatives.factor | 34 +++++++ extra/math/derivatives/syntax/authors.txt | 1 + .../derivatives/syntax/syntax-docs.factor | 18 ++++ extra/math/derivatives/syntax/syntax.factor | 10 +++ extra/math/dual/authors.txt | 1 + extra/math/dual/dual-docs.factor | 90 +++++++++++++++++++ extra/math/dual/dual-tests.factor | 14 +++ extra/math/dual/dual.factor | 80 +++++++++++++++++ 12 files changed, 270 insertions(+), 2 deletions(-) create mode 100644 extra/math/derivatives/authors.txt create mode 100644 extra/math/derivatives/derivatives-docs.factor create mode 100644 extra/math/derivatives/derivatives-tests.factor create mode 100644 extra/math/derivatives/derivatives.factor create mode 100644 extra/math/derivatives/syntax/authors.txt create mode 100644 extra/math/derivatives/syntax/syntax-docs.factor create mode 100644 extra/math/derivatives/syntax/syntax.factor create mode 100644 extra/math/dual/authors.txt create mode 100644 extra/math/dual/dual-docs.factor create mode 100644 extra/math/dual/dual-tests.factor create mode 100644 extra/math/dual/dual.factor diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 85b4d711ac..3a1ce18daa 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -252,10 +252,14 @@ M: real tanh ftanh ; : -i* ( x -- y ) >rect swap neg rect> ; -: asin ( x -- y ) +GENERIC: asin ( x -- y ) foldable + +M: number asin dup [-1,1]? [ fasin ] [ i* asinh -i* ] if ; inline -: acos ( x -- y ) +GENERIC: acos ( x -- y ) foldable + +M: number acos dup [-1,1]? [ facos ] [ asin pi 2 / swap - ] if ; inline diff --git a/extra/math/derivatives/authors.txt b/extra/math/derivatives/authors.txt new file mode 100644 index 0000000000..b6089d8622 --- /dev/null +++ b/extra/math/derivatives/authors.txt @@ -0,0 +1 @@ +Jason W. Merrill \ No newline at end of file diff --git a/extra/math/derivatives/derivatives-docs.factor b/extra/math/derivatives/derivatives-docs.factor new file mode 100644 index 0000000000..4905f260bc --- /dev/null +++ b/extra/math/derivatives/derivatives-docs.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2009 Jason W. Merrill. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax ; +IN: math.derivatives + +ARTICLE: "math.derivatives" "Derivatives" +"The " { $vocab-link "math.derivatives" } " vocabulary defines the derivative of many of the words in the " { $vocab-link "math" } " and " { $vocab-link "math.functions" } " vocabularies. The derivative for a word is given by a sequence of quotations stored in its " { $snippet "derivative" } " word property that give the partial derivative of the word with respect to each of its inputs." +{ $see-also "math.derivatives.syntax" } +; + +ABOUT: "math.derivatives" diff --git a/extra/math/derivatives/derivatives-tests.factor b/extra/math/derivatives/derivatives-tests.factor new file mode 100644 index 0000000000..f95eb43849 --- /dev/null +++ b/extra/math/derivatives/derivatives-tests.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2009 Jason W. Merrill. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test automatic-differentiation.derivatives ; +IN: automatic-differentiation.derivatives.tests diff --git a/extra/math/derivatives/derivatives.factor b/extra/math/derivatives/derivatives.factor new file mode 100644 index 0000000000..8e69cec129 --- /dev/null +++ b/extra/math/derivatives/derivatives.factor @@ -0,0 +1,34 @@ +! Copyright (C) 2009 Jason W. Merrill. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math math.functions math.derivatives.syntax ; +IN: math.derivatives + +DERIVATIVE: + [ 2drop ] [ 2drop ] +DERIVATIVE: - [ 2drop ] [ 2drop neg ] +DERIVATIVE: * [ nip * ] [ drop * ] +DERIVATIVE: / [ nip / ] [ sq / neg * ] +! Conditional checks if the epsilon-part of the exponent is +! 0 to avoid getting float answers for integer powers. +DERIVATIVE: ^ [ [ 1 - ^ ] keep * * ] + [ [ dup zero? ] 2dip [ 3drop 0 ] [ [ ^ ] keep log * * ] if ] + +DERIVATIVE: sqrt [ sqrt 2 * / ] + +DERIVATIVE: exp [ exp * ] +DERIVATIVE: log [ / ] + +DERIVATIVE: sin [ cos * ] +DERIVATIVE: cos [ sin neg * ] +DERIVATIVE: tan [ sec sq * ] + +DERIVATIVE: sinh [ cosh * ] +DERIVATIVE: cosh [ sinh * ] +DERIVATIVE: tanh [ sech sq * ] + +DERIVATIVE: asin [ sq neg 1 + sqrt / ] +DERIVATIVE: acos [ sq neg 1 + sqrt neg / ] +DERIVATIVE: atan [ sq 1 + / ] + +DERIVATIVE: asinh [ sq 1 + sqrt / ] +DERIVATIVE: acosh [ [ 1 + sqrt ] [ 1 - sqrt ] bi * / ] +DERIVATIVE: atanh [ sq neg 1 + / ] \ No newline at end of file diff --git a/extra/math/derivatives/syntax/authors.txt b/extra/math/derivatives/syntax/authors.txt new file mode 100644 index 0000000000..b6089d8622 --- /dev/null +++ b/extra/math/derivatives/syntax/authors.txt @@ -0,0 +1 @@ +Jason W. Merrill \ No newline at end of file diff --git a/extra/math/derivatives/syntax/syntax-docs.factor b/extra/math/derivatives/syntax/syntax-docs.factor new file mode 100644 index 0000000000..2273e7b83c --- /dev/null +++ b/extra/math/derivatives/syntax/syntax-docs.factor @@ -0,0 +1,18 @@ +! Copyright (C) 2009 Jason W. Merrill. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax ; +IN: math.derivatives.syntax + +HELP: DERIVATIVE: +{ $description "Defines the derivative of a word by setting its " { $snippet "derivative" } " word property. Reads a word followed by " { $snippet "n" } " quotations, giving the " { $snippet "n" } " partial derivatives of the word with respect to each of its arguments successively. Each quotation should take " { $snippet "n + 1" } " inputs, where the first input is an increment and the last " { $snippet "n" } " inputs are the point at which to evaluate the derivative. The derivative should be a linear function of the increment, and should have the same number of outputs as the original word." } +{ $examples + { $unchecked-example "USING: math math.functions math.derivatives.syntax ;" + "DERIVATIVE: sin [ cos * ]" + "DERIVATIVE: * [ nip * ] [ drop * ]" "" } +} ; + +ARTICLE: "math.derivatives.syntax" "Derivative Syntax" +"The " { $vocab-link "math.derivatives.syntax" } " vocabulary provides the " { $link POSTPONE: DERIVATIVE: } " syntax for specifying the derivative of a word." +; + +ABOUT: "math.derivatives.syntax" diff --git a/extra/math/derivatives/syntax/syntax.factor b/extra/math/derivatives/syntax/syntax.factor new file mode 100644 index 0000000000..02b0608ed8 --- /dev/null +++ b/extra/math/derivatives/syntax/syntax.factor @@ -0,0 +1,10 @@ +! Copyright (C) 2009 Jason W. Merrill. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel parser words effects accessors sequences + math.ranges ; + +IN: math.derivatives.syntax + +: DERIVATIVE: scan-object dup stack-effect in>> length [1,b] + [ drop scan-object ] map + "derivative" set-word-prop ; parsing \ No newline at end of file diff --git a/extra/math/dual/authors.txt b/extra/math/dual/authors.txt new file mode 100644 index 0000000000..b6089d8622 --- /dev/null +++ b/extra/math/dual/authors.txt @@ -0,0 +1 @@ +Jason W. Merrill \ No newline at end of file diff --git a/extra/math/dual/dual-docs.factor b/extra/math/dual/dual-docs.factor new file mode 100644 index 0000000000..de3b0749a5 --- /dev/null +++ b/extra/math/dual/dual-docs.factor @@ -0,0 +1,90 @@ +! Copyright (C) 2009 Jason W. Merrill. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel words math math.functions math.derivatives.syntax ; +IN: math.dual + +HELP: +{ $values + { "ordinary-part" real } { "epsilon-part" real } + { "dual" dual number } +} +{ $description "Creates a dual number from its ordinary and epsilon parts." } ; + +HELP: d* +{ $values + { "x" dual } { "y" dual } + { "x*y" dual } +} +{ $description "Multiply dual numbers." } ; + +HELP: d+ +{ $values + { "x" dual } { "y" dual } + { "x+y" dual } +} +{ $description "Add dual numbers." } ; + +HELP: d- +{ $values + { "x" dual } { "y" dual } + { "x-y" dual } +} +{ $description "Subtract dual numbers." } ; + +HELP: d/ +{ $values + { "x" dual } { "y" dual } + { "x/y" dual } +} +{ $description "Divide dual numbers." } +{ $errors "Throws an error if the ordinary part of " { $snippet "x" } " is zero." } ; + +HELP: d^ +{ $values + { "x" dual } { "y" dual } + { "x^y" dual } +} +{ $description "Raise a dual number to a (possibly dual) power" } ; + +HELP: define-dual-method +{ $values + { "word" word } +} +{ $description "Defines a method on the dual numbers for generic word." } +{ $notes "Uses the derivative word-prop, which holds a list of quotations giving the partial derivatives of the word with respect to each of its arguments. This can be set using " { $link POSTPONE: DERIVATIVE: } "." } ; + +{ define-dual-method dual-op POSTPONE: DERIVATIVE: } related-words + +HELP: dual +{ $class-description "The class of dual numbers with non-zero epsilon part." } ; + +HELP: dual-op +{ $values + { "word" word } +} +{ $description "Similar to " { $link execute } ", but promotes word to operate on duals." } +{ $notes "Uses the derivative word-prop, which holds a list of quotations giving the partial derivatives of the word with respect to each of its arguments. This can be set using " { $link POSTPONE: DERIVATIVE: } ". Once a derivative has been defined for a word, dual-op makes it easy to extend the definition to dual numbers." } +{ $examples + { $unchecked-example "USING: math math.dual math.derivatives.syntax math.functions ;" + "DERIVATIVE: sin [ cos * ]" + "M: dual sin \\sin dual-op ;" "" } + { $unchecked-example "USING: math math.dual math.derivatives.syntax ;" + "DERIVATIVE: * [ drop ] [ nip ]" + ": d* ( x y -- x*y ) \ * dual-op ;" "" } +} ; + +HELP: unpack-dual +{ $values + { "dual" dual } + { "ordinary-part" number } { "epsilon-part" number } +} +{ $description "Extracts the ordinary and epsilon part of a dual number." } ; + +ARTICLE: "math.dual" "Dual Numbers" +"The " { $vocab-link "math.dual" } " vocabulary implements dual numbers, along with arithmetic methods for working with them. Many of the functions in " { $vocab-link "math.functions" } " are extended to work with dual numbers." +$nl +"Dual numbers are ordered pairs " { $snippet ""} "--an ordinary part and an epsilon part--with component-wise addition and multiplication defined by "{ $snippet "* = " } ". They are analagous to complex numbers with " { $snippet "i^2 = 0" } "instead of " { $snippet "i^2 = -1" } ". For well-behaved functions " { $snippet "f" } ", " { $snippet "f() = f(o1) + e1*f'(o1)" } ", where " { $snippet "f'"} " is the derivative of " { $snippet "f" } "." +; + + +ABOUT: "math.dual" diff --git a/extra/math/dual/dual-tests.factor b/extra/math/dual/dual-tests.factor new file mode 100644 index 0000000000..2fe751dd63 --- /dev/null +++ b/extra/math/dual/dual-tests.factor @@ -0,0 +1,14 @@ +! Copyright (C) 2009 Jason W. Merrill. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test math.dual kernel accessors math math.functions + math.constants ; +IN: math.dual.tests + +[ 0.0 1.0 ] [ 0 1 sin unpack-dual ] unit-test +[ 1.0 0.0 ] [ 0 1 cos unpack-dual ] unit-test +[ 3 5 ] [ 1 5 2 d+ unpack-dual ] unit-test +[ 0 -1 ] [ 1 5 1 6 d- unpack-dual ] unit-test +[ 2 1 ] [ 2 3 1 -1 d* unpack-dual ] unit-test +[ 1/2 -1/4 ] [ 2 1 1 swap d/ unpack-dual ] unit-test +[ 2 ] [ 1 1 2 d^ epsilon-part>> ] unit-test +[ 2.0 .25 ] [ 4 1 sqrt unpack-dual ] unit-test \ No newline at end of file diff --git a/extra/math/dual/dual.factor b/extra/math/dual/dual.factor new file mode 100644 index 0000000000..214db9b678 --- /dev/null +++ b/extra/math/dual/dual.factor @@ -0,0 +1,80 @@ +! Copyright (C) 2009 Jason W. Merrill. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math math.functions math.derivatives accessors + macros words effects sequences generalizations fry + combinators.smart generic compiler.units ; + +IN: math.dual + +TUPLE: dual ordinary-part epsilon-part ; + +C: dual + +! Ordinary numbers implement the dual protocol by returning +! themselves as the ordinary part, and 0 as the epsilon part. +M: number ordinary-part>> ; + +M: number epsilon-part>> drop 0 ; + +: unpack-dual ( dual -- ordinary-part epsilon-part ) + [ ordinary-part>> ] [ epsilon-part>> ] bi ; + +> length ; + +MACRO: ordinary-op ( word -- o ) + [ input-length ] keep + '[ [ ordinary-part>> ] _ napply _ execute ] ; + +! Takes N dual numbers ... and weaves +! their ordinary and epsilon parts to produce +! e1 o1 o2 ... oN e2 o1 o2 ... oN ... eN o1 o2 ... oN +! This allows a set of partial derivatives each to be evaluated +! at the same point. +MACRO: duals>nweave ( n -- ) + dup dup dup + '[ + [ [ epsilon-part>> ] _ napply ] + _ nkeep + [ ordinary-part>> ] _ napply + _ nweave + ] ; + +MACRO: chain-rule ( word -- e ) + [ input-length '[ _ duals>nweave ] ] + [ "derivative" word-prop ] + [ input-length 1+ '[ _ nspread ] ] + tri + '[ [ @ _ @ ] sum-outputs ] ; + +PRIVATE> + +MACRO: dual-op ( word -- ) + [ '[ _ ordinary-op ] ] + [ input-length '[ _ nkeep ] ] + [ '[ _ chain-rule ] ] + tri + '[ _ @ @ ] ; + +: define-dual-method ( word -- ) + [ \ dual swap create-method ] keep '[ _ dual-op ] define ; + +! Specialize math functions to operate on dual numbers. +[ { sqrt exp log sin cos tan sinh cosh tanh acos asin atan } + [ define-dual-method ] each ] with-compilation-unit + +! Inverse methods { asinh, acosh, atanh } are not generic, so +! there is no way to specialize them for dual numbers. However, +! they are defined in terms of functions that can operate on +! dual numbers and arithmetic methods, so if it becomes +! possible to make arithmetic operators work directly on dual +! numbers, we will get these for free. + +! Arithmetic methods are not generic (yet?), so we have to +! define special versions of them to operate on dual numbers. +: d+ ( x y -- x+y ) \ + dual-op ; +: d- ( x y -- x-y ) \ - dual-op ; +: d* ( x y -- x*y ) \ * dual-op ; +: d/ ( x y -- x/y ) \ / dual-op ; +: d^ ( x y -- x^y ) \ ^ dual-op ; \ No newline at end of file From b3e20dfdf2bba6c85c6828e7f38876fc35a54d08 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 13 Feb 2009 15:10:46 -0600 Subject: [PATCH 002/119] better factor annotations docs --- extra/annotations/annotations-docs.factor | 30 ++++++++++++++--------- 1 file changed, 19 insertions(+), 11 deletions(-) diff --git a/extra/annotations/annotations-docs.factor b/extra/annotations/annotations-docs.factor index c340554119..1effdf4067 100644 --- a/extra/annotations/annotations-docs.factor +++ b/extra/annotations/annotations-docs.factor @@ -9,6 +9,22 @@ IN: annotations : comment-usage.-word ( base -- word ) "s." append "annotations" lookup ; PRIVATE> +: $annotation ( element -- ) + P first + [ "!" " your comment here" surround 1array $syntax ] + [ [ "Treats the rest of the line after the exclamation point as a code annotation that can be looked up with the " \ $link ] dip comment-usage.-word 2array " word." 3array $description ] + [ ": foo ( x y z -- w )\n !" " --w-ó()ò-w-- kilroy was here\n + * ;" surround 1array $unchecked-example ] + tri ; + +: $annotation-usage. ( element -- ) + first + [ "Displays a list of words, help articles, and vocabularies that contain " \ $link ] dip comment-word 2array " annotations." 3array $description ; + +: $annotation-usage ( element -- ) + first + { "usages" sequence } $values + [ "Returns a list of words, help articles, and vocabularies that contain " \ $link ] dip [ comment-word 2array " annotations. For a more user-friendly display, use the " \ $link ] [ comment-usage.-word 2array " word." 6 narray ] bi 1array $description ; + "Code annotations" { "The " { $vocab-link "annotations" } " vocabulary provides syntax for comment-like annotations that can be looked up with Factor's " { $link usage } " mechanism." @@ -26,17 +42,9 @@ annotation-tags natural-sort annotation-tags [ { - [ [ \ $syntax ] dip "!" " your comment here" surround 2array ] - [ [ \ $description "Treats the rest of the line after the exclamation point as a code annotation that can be looked up with the " \ $link ] dip comment-usage.-word 2array " word." 4array ] - [ [ \ $unchecked-example ] dip ": foo ( x y z -- w )\n !" " --w-ó()ò-w-- kilroy was here\n + * ;" surround 2array 3array ] - [ comment-word set-word-help ] - - [ [ \ $description "Displays a list of words, help articles, and vocabularies that contain " \ $link ] dip comment-word 2array " annotations." 4array 1array ] - [ comment-usage.-word set-word-help ] - - [ [ { $values { "usages" sequence } } \ $description "Returns a list of words, help articles, and vocabularies that contain " \ $link ] dip [ comment-word 2array " annotations. For a more user-friendly display, use the " \ $link ] [ comment-usage.-word 2array " word." 6 narray 2array ] bi ] - [ comment-usage-word set-word-help ] - + [ [ \ $annotation swap 2array 1array ] [ comment-word set-word-help ] bi ] + [ [ \ $annotation-usage swap 2array 1array ] [ comment-usage-word set-word-help ] bi ] + [ [ \ $annotation-usage. swap 2array 1array ] [ comment-usage.-word set-word-help ] bi ] [ [ comment-word ] [ comment-usage-word ] [ comment-usage.-word ] tri 3array related-words ] } cleave ] each From 0f6598d95cee9d38b4c16e8518665ad04a66463a Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sat, 14 Feb 2009 13:44:12 +0100 Subject: [PATCH 003/119] FUEL: Recognised parenthesised forms (e.g., stack effects) as syntactic constructs. --- misc/fuel/fuel-edit.el | 3 +-- misc/fuel/fuel-font-lock.el | 1 - misc/fuel/fuel-syntax.el | 6 +++--- 3 files changed, 4 insertions(+), 6 deletions(-) diff --git a/misc/fuel/fuel-edit.el b/misc/fuel/fuel-edit.el index 941f57140e..f89e2b3eb8 100644 --- a/misc/fuel/fuel-edit.el +++ b/misc/fuel/fuel-edit.el @@ -65,7 +65,6 @@ ;;; Editing commands: (defvar fuel-edit--word-history nil) -(defvar fuel-edit--previous-location nil) (defun fuel-edit-vocabulary (&optional refresh vocab) "Visits vocabulary file in Emacs. @@ -129,7 +128,7 @@ was last invoked." (interactive) (condition-case nil (pop-tag-mark) - (error "No previous location for find word or vocab invokation"))) + (error "No previous location for find word or vocab invocation"))) (defvar fuel-edit--buffer-history nil) diff --git a/misc/fuel/fuel-font-lock.el b/misc/fuel/fuel-font-lock.el index 86ae94fe8a..f3b510fdd9 100644 --- a/misc/fuel/fuel-font-lock.el +++ b/misc/fuel/fuel-font-lock.el @@ -88,7 +88,6 @@ (t 'default)))) ((or (char-equal c ?U) (char-equal c ?C)) 'factor-font-lock-parsing-word) - ((char-equal c ?\() 'factor-font-lock-stack-effect) ((char-equal c ?\") 'factor-font-lock-string) (t 'factor-font-lock-comment))))) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 80bfd0afcb..67341120c1 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -136,7 +136,7 @@ (fuel-syntax--second-word-regex '("&:" "SYMBOL:" "VAR:"))) (defconst fuel-syntax--stack-effect-regex - "\\( ( .* )\\)\\|\\( (( .* ))\\)") + "\\( ( [^\n]* )\\)\\|\\( (( [^\n]* ))\\)") (defconst fuel-syntax--using-lines-regex "^USING: +\\([^;]+\\);") @@ -239,6 +239,8 @@ (modify-syntax-entry ?\r " " table) (modify-syntax-entry ?\ " " table) (modify-syntax-entry ?\n " " table) + (modify-syntax-entry ?\( "()" table) + (modify-syntax-entry ?\) ")(" table) table)) (defconst fuel-syntax--syntactic-keywords @@ -247,8 +249,6 @@ ;; Comments: ("\\_<\\(#?!\\) .*\\(\n\\|$\\)" (1 "<") (2 ">")) ("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">")) - (" \\((\\)( \\([^\n]*\\) )\\()\\)\\( \\|\n\\)" (1 "b")) - (" \\((\\) \\([^\n]*\\) \\()\\)\\( \\|\n\\)" (1 "b")) ;; Strings ("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)\\(\"\\)\\([^\n\r\f\\\"]\\|\\\\.\\)*?\\(\"\\)" (3 "\"") (5 "\"")) From 9363ecc1086b1183295628cb874362a088451d60 Mon Sep 17 00:00:00 2001 From: Tim Wawrzynczak Date: Sun, 15 Feb 2009 19:12:46 -0600 Subject: [PATCH 004/119] Removed extra nulls from v1 tags --- extra/id3/id3-tests.factor | 8 ++++---- extra/id3/id3.factor | 10 +++++----- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/extra/id3/id3-tests.factor b/extra/id3/id3-tests.factor index b9d45b1b04..fdbaf69f03 100644 --- a/extra/id3/id3-tests.factor +++ b/extra/id3/id3-tests.factor @@ -164,17 +164,17 @@ IN: id3.tests [ T{ mp3v1-file { title - "BLAH\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" + "BLAH" } { artist - "ARTIST\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" + "ARTIST" } { album - "ALBUM\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" + "ALBUM" } { year "2009" } { comment - "COMMENT\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" + "COMMENT" } { genre 89 } } diff --git a/extra/id3/id3.factor b/extra/id3/id3.factor index 64e1ff1d10..5b0d3f373e 100644 --- a/extra/id3/id3.factor +++ b/extra/id3/id3.factor @@ -127,11 +127,11 @@ TUPLE: mp3v1-file title artist album year comment genre ; : (read-v1-tag-data) ( seq -- mp3-file ) [ ] dip { - [ read-title ascii decode >>title ] - [ read-artist ascii decode >>artist ] - [ read-album ascii decode >>album ] - [ read-year ascii decode >>year ] - [ read-comment ascii decode >>comment ] + [ read-title ascii decode filter-text-data >>title ] + [ read-artist ascii decode filter-text-data >>artist ] + [ read-album ascii decode filter-text-data >>album ] + [ read-year ascii decode filter-text-data >>year ] + [ read-comment ascii decode filter-text-data >>comment ] [ read-genre >fixnum >>genre ] } cleave ; From 6b99b04531b5cc5d35225b600a38642ab6297e55 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 15 Feb 2009 19:53:21 -0600 Subject: [PATCH 005/119] Add vocab: for vocab-relative paths --- basis/bootstrap/help/help.factor | 2 +- basis/bootstrap/stage2.factor | 6 +- basis/cpu/ppc/linux/bootstrap.factor | 2 +- basis/cpu/ppc/macosx/bootstrap.factor | 2 +- basis/cpu/x86/32/bootstrap.factor | 2 +- basis/cpu/x86/64/bootstrap.factor | 2 +- basis/cpu/x86/64/unix/bootstrap.factor | 2 +- basis/cpu/x86/64/winnt/bootstrap.factor | 2 +- basis/help/html/html.factor | 2 +- basis/html/templates/chloe/chloe-tests.factor | 2 +- basis/html/templates/fhtml/fhtml-tests.factor | 2 +- basis/http/http-tests.factor | 4 +- basis/images/bitmap/bitmap-tests.factor | 8 +-- basis/io/encodings/8-bit/8-bit.factor | 2 +- basis/io/encodings/chinese/chinese.factor | 2 +- basis/io/encodings/iana/iana.factor | 2 +- basis/io/encodings/japanese/japanese.factor | 4 +- basis/io/sockets/secure/secure-tests.factor | 4 +- basis/io/sockets/secure/secure.factor | 2 +- .../io/sockets/secure/unix/debug/debug.factor | 4 +- basis/mime/types/types.factor | 2 +- basis/openssl/openssl-tests.factor | 10 +-- .../porter-stemmer-tests.factor | 4 +- basis/syndication/syndication-tests.factor | 6 +- basis/tools/crossref/crossref-tests.factor | 2 +- basis/tools/deploy/deploy-tests.factor | 2 +- basis/tools/deploy/shaker/shaker.factor | 8 +-- basis/tools/vocabs/vocabs.factor | 6 ++ basis/unicode/breaks/breaks-tests.factor | 4 +- basis/unicode/breaks/breaks.factor | 2 +- .../unicode/collation/collation-tests.factor | 2 +- basis/unicode/collation/collation.factor | 2 +- basis/unicode/data/data.factor | 8 +-- .../unicode/normalize/normalize-tests.factor | 2 +- basis/unicode/script/script.factor | 2 +- basis/xml/entities/html/html.factor | 2 +- basis/xml/tests/encodings.factor | 24 +++---- basis/xml/tests/funny-dtd.factor | 2 +- basis/xml/tests/soap.factor | 2 +- basis/xml/tests/test.factor | 4 +- basis/xml/tests/xmltest.factor | 2 +- basis/xml/tests/xmode-dtd.factor | 2 +- basis/xml/writer/writer-tests.factor | 2 +- basis/xmode/catalog/catalog.factor | 4 +- basis/xmode/utilities/utilities-tests.factor | 2 +- core/bootstrap/primitives.factor | 6 +- core/bootstrap/stage1.factor | 4 +- core/io/encodings/encodings-tests.factor | 8 +-- core/io/files/files-tests.factor | 4 +- core/io/io-tests.factor | 2 +- core/io/pathnames/pathnames.factor | 22 ++++-- core/parser/parser-tests.factor | 2 +- core/vocabs/loader/loader.factor | 67 +++++++++---------- core/vocabs/vocabs.factor | 38 +++++------ extra/benchmark/crc32/crc32.factor | 2 +- extra/benchmark/md5/md5.factor | 2 +- extra/benchmark/sha1/sha1.factor | 2 +- extra/benchmark/xml/xml.factor | 2 +- extra/webapps/todo/todo.factor | 4 +- .../concatenative/concatenative.factor | 4 +- 60 files changed, 172 insertions(+), 163 deletions(-) diff --git a/basis/bootstrap/help/help.factor b/basis/bootstrap/help/help.factor index 145738ff45..bd994a160d 100644 --- a/basis/bootstrap/help/help.factor +++ b/basis/bootstrap/help/help.factor @@ -10,7 +10,7 @@ IN: bootstrap.help t load-help? set-global - [ drop ] load-vocab-hook [ + [ vocab ] load-vocab-hook [ dictionary get values [ docs-loaded?>> not ] filter [ load-docs ] each diff --git a/basis/bootstrap/stage2.factor b/basis/bootstrap/stage2.factor index b521244fe0..070618ebb4 100644 --- a/basis/bootstrap/stage2.factor +++ b/basis/bootstrap/stage2.factor @@ -93,9 +93,9 @@ SYMBOL: bootstrap-time "tools.deploy.shaker" run ] [ "staging" get [ - "resource:basis/bootstrap/finish-staging.factor" run-file + "vocab:bootstrap/finish-staging.factor" run-file ] [ - "resource:basis/bootstrap/finish-bootstrap.factor" run-file + "vocab:bootstrap/finish-bootstrap.factor" run-file ] if "output-image" get save-image-and-exit @@ -104,6 +104,6 @@ SYMBOL: bootstrap-time drop [ load-help? off - "resource:basis/bootstrap/bootstrap-error.factor" run-file + "vocab:bootstrap/bootstrap-error.factor" run-file ] with-scope ] recover diff --git a/basis/cpu/ppc/linux/bootstrap.factor b/basis/cpu/ppc/linux/bootstrap.factor index fd9bab4835..cf6517b664 100644 --- a/basis/cpu/ppc/linux/bootstrap.factor +++ b/basis/cpu/ppc/linux/bootstrap.factor @@ -6,5 +6,5 @@ IN: bootstrap.ppc : c-area-size ( -- n ) 10 bootstrap-cells ; : lr-save ( -- n ) bootstrap-cell ; -<< "resource:basis/cpu/ppc/bootstrap.factor" parse-file parsed >> +<< "vocab:cpu/ppc/bootstrap.factor" parse-file parsed >> call diff --git a/basis/cpu/ppc/macosx/bootstrap.factor b/basis/cpu/ppc/macosx/bootstrap.factor index f2ddc42688..0c383c2fb0 100644 --- a/basis/cpu/ppc/macosx/bootstrap.factor +++ b/basis/cpu/ppc/macosx/bootstrap.factor @@ -6,5 +6,5 @@ IN: bootstrap.ppc : c-area-size ( -- n ) 14 bootstrap-cells ; : lr-save ( -- n ) 2 bootstrap-cells ; -<< "resource:basis/cpu/ppc/bootstrap.factor" parse-file parsed >> +<< "vocab:cpu/ppc/bootstrap.factor" parse-file parsed >> call diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor index f29dec128c..5d88f699b8 100644 --- a/basis/cpu/x86/32/bootstrap.factor +++ b/basis/cpu/x86/32/bootstrap.factor @@ -30,5 +30,5 @@ IN: bootstrap.x86 (JMP) drop ] rc-relative rt-primitive 1 jit-primitive jit-define -<< "resource:basis/cpu/x86/bootstrap.factor" parse-file parsed >> +<< "vocab:cpu/x86/bootstrap.factor" parse-file parsed >> call diff --git a/basis/cpu/x86/64/bootstrap.factor b/basis/cpu/x86/64/bootstrap.factor index efa3de3065..ddf5791009 100644 --- a/basis/cpu/x86/64/bootstrap.factor +++ b/basis/cpu/x86/64/bootstrap.factor @@ -30,5 +30,5 @@ IN: bootstrap.x86 temp1 JMP ! go ] rc-absolute-cell rt-primitive 1 rex-length + jit-primitive jit-define -<< "resource:basis/cpu/x86/bootstrap.factor" parse-file parsed >> +<< "vocab:cpu/x86/bootstrap.factor" parse-file parsed >> call diff --git a/basis/cpu/x86/64/unix/bootstrap.factor b/basis/cpu/x86/64/unix/bootstrap.factor index 20a953b6d5..e48a20a9de 100644 --- a/basis/cpu/x86/64/unix/bootstrap.factor +++ b/basis/cpu/x86/64/unix/bootstrap.factor @@ -7,5 +7,5 @@ IN: bootstrap.x86 : stack-frame-size ( -- n ) 4 bootstrap-cells ; : arg ( -- reg ) RDI ; -<< "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >> +<< "vocab:cpu/x86/64/bootstrap.factor" parse-file parsed >> call diff --git a/basis/cpu/x86/64/winnt/bootstrap.factor b/basis/cpu/x86/64/winnt/bootstrap.factor index 3accca400f..ff15ef27af 100644 --- a/basis/cpu/x86/64/winnt/bootstrap.factor +++ b/basis/cpu/x86/64/winnt/bootstrap.factor @@ -7,5 +7,5 @@ IN: bootstrap.x86 : stack-frame-size ( -- n ) 8 bootstrap-cells ; : arg ( -- reg ) RCX ; -<< "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >> +<< "vocab:cpu/x86/64/bootstrap.factor" parse-file parsed >> call diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index cccf320e44..f8d06064f0 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -54,7 +54,7 @@ M: f topic>filename* drop \ f topic>filename* ; M: topic url-of topic>filename ; : help-stylesheet ( -- string ) - "resource:basis/help/html/stylesheet.css" ascii file-contents + "vocab:help/html/stylesheet.css" ascii file-contents [XML XML] ; : help>html ( topic -- xml ) diff --git a/basis/html/templates/chloe/chloe-tests.factor b/basis/html/templates/chloe/chloe-tests.factor index 4e454dcee4..86f86a8468 100644 --- a/basis/html/templates/chloe/chloe-tests.factor +++ b/basis/html/templates/chloe/chloe-tests.factor @@ -10,7 +10,7 @@ IN: html.templates.chloe.tests "?>" split1 nip ; inline : test-template ( name -- template ) - "resource:basis/html/templates/chloe/test/" + "vocab:html/templates/chloe/test/" prepend ; [ "Hello world" ] [ diff --git a/basis/html/templates/fhtml/fhtml-tests.factor b/basis/html/templates/fhtml/fhtml-tests.factor index 6cebb55688..55cf90c2dd 100644 --- a/basis/html/templates/fhtml/fhtml-tests.factor +++ b/basis/html/templates/fhtml/fhtml-tests.factor @@ -4,7 +4,7 @@ tools.test sequences parser splitting prettyprint ; IN: html.templates.fhtml.tests : test-template ( path -- ? ) - "resource:basis/html/templates/fhtml/test/" + "vocab:html/templates/fhtml/test/" prepend [ ".fhtml" append [ call-template ] with-string-writer ] [ ".html" append utf8 file-contents ] bi diff --git a/basis/http/http-tests.factor b/basis/http/http-tests.factor index 4f685945aa..229d05615e 100644 --- a/basis/http/http-tests.factor +++ b/basis/http/http-tests.factor @@ -213,7 +213,7 @@ test-db [ add-quit-action - "resource:basis/http/test" >>default + "vocab:http/test" >>default "nested" add-responder [ URL" redirect-loop" ] >>display @@ -226,7 +226,7 @@ test-db [ >url clone "port" get >>port ; [ t ] [ - "resource:basis/http/test/foo.html" ascii file-contents + "vocab:http/test/foo.html" ascii file-contents "http://localhost/nested/foo.html" add-port http-get nip = ] unit-test diff --git a/basis/images/bitmap/bitmap-tests.factor b/basis/images/bitmap/bitmap-tests.factor index 102c13c295..e250d81ae5 100644 --- a/basis/images/bitmap/bitmap-tests.factor +++ b/basis/images/bitmap/bitmap-tests.factor @@ -3,16 +3,16 @@ io.files io.files.unique kernel tools.test ; IN: images.bitmap.tests : test-bitmap24 ( -- path ) - "resource:basis/images/test-images/thiswayup24.bmp" ; + "vocab:images/test-images/thiswayup24.bmp" ; : test-bitmap8 ( -- path ) - "resource:basis/images/test-images/rgb8bit.bmp" ; + "vocab:images/test-images/rgb8bit.bmp" ; : test-bitmap4 ( -- path ) - "resource:basis/images/test-images/rgb4bit.bmp" ; + "vocab:images/test-images/rgb4bit.bmp" ; : test-bitmap1 ( -- path ) - "resource:basis/images/test-images/1bit.bmp" ; + "vocab:images/test-images/1bit.bmp" ; [ t ] [ diff --git a/basis/io/encodings/8-bit/8-bit.factor b/basis/io/encodings/8-bit/8-bit.factor index a11edeb703..b3519a7990 100644 --- a/basis/io/encodings/8-bit/8-bit.factor +++ b/basis/io/encodings/8-bit/8-bit.factor @@ -33,7 +33,7 @@ IN: io.encodings.8-bit } ; : encoding-file ( file-name -- stream ) - "resource:basis/io/encodings/8-bit/" swap ".TXT" + "vocab:io/encodings/8-bit/" swap ".TXT" 3append ascii ; : process-contents ( lines -- assoc ) diff --git a/basis/io/encodings/chinese/chinese.factor b/basis/io/encodings/chinese/chinese.factor index b0013b6e08..1d6ef52d8d 100644 --- a/basis/io/encodings/chinese/chinese.factor +++ b/basis/io/encodings/chinese/chinese.factor @@ -80,7 +80,7 @@ VALUE: gb>u VALUE: u>gb VALUE: mapping -"resource:basis/io/encodings/chinese/gb-18030-2000.xml" +"vocab:io/encodings/chinese/gb-18030-2000.xml" ascii xml>gb-data [ ranges-u>gb to: u>gb ] [ ranges-gb>u to: gb>u ] bi >biassoc to: mapping diff --git a/basis/io/encodings/iana/iana.factor b/basis/io/encodings/iana/iana.factor index 6afae92429..07b0429696 100644 --- a/basis/io/encodings/iana/iana.factor +++ b/basis/io/encodings/iana/iana.factor @@ -44,7 +44,7 @@ ERROR: missing-name encoding ; PRIVATE> -"resource:basis/io/encodings/iana/character-sets" +"vocab:io/encodings/iana/character-sets" utf8 make-aliases aliases set-global n>e-table [ initial-n>e ] initialize diff --git a/basis/io/encodings/japanese/japanese.factor b/basis/io/encodings/japanese/japanese.factor index 194ade377b..8f38f597ca 100644 --- a/basis/io/encodings/japanese/japanese.factor +++ b/basis/io/encodings/japanese/japanese.factor @@ -44,10 +44,10 @@ TUPLE: jis assoc ; : make-jis ( filename -- jis ) ascii file-lines process-jis ; -"resource:basis/io/encodings/japanese/CP932.txt" +"vocab:io/encodings/japanese/CP932.txt" make-jis to: windows-31j-table -"resource:basis/io/encodings/japanese/sjis-0208-1997-std.txt" +"vocab:io/encodings/japanese/sjis-0208-1997-std.txt" make-jis to: shift-jis-table : small? ( char -- ? ) diff --git a/basis/io/sockets/secure/secure-tests.factor b/basis/io/sockets/secure/secure-tests.factor index 557bba52d2..b5af130168 100644 --- a/basis/io/sockets/secure/secure-tests.factor +++ b/basis/io/sockets/secure/secure-tests.factor @@ -5,8 +5,8 @@ USING: accessors kernel io.sockets io.sockets.secure tools.test ; [ ] [ - "resource:basis/openssl/test/server.pem" >>key-file - "resource:basis/openssl/test/dh1024.pem" >>dh-file + "vocab:openssl/test/server.pem" >>key-file + "vocab:openssl/test/dh1024.pem" >>dh-file "password" >>password [ ] with-secure-context ] unit-test diff --git a/basis/io/sockets/secure/secure.factor b/basis/io/sockets/secure/secure.factor index c4a1475f48..bff2dbaf1a 100644 --- a/basis/io/sockets/secure/secure.factor +++ b/basis/io/sockets/secure/secure.factor @@ -26,7 +26,7 @@ ephemeral-key-bits ; secure-config new SSLv23 >>method 1024 >>ephemeral-key-bits - "resource:basis/openssl/cacert.pem" >>ca-file + "vocab:openssl/cacert.pem" >>ca-file t >>verify ; TUPLE: secure-context config handle disposed ; diff --git a/basis/io/sockets/secure/unix/debug/debug.factor b/basis/io/sockets/secure/unix/debug/debug.factor index d32cdee2ed..10df82ae7b 100644 --- a/basis/io/sockets/secure/unix/debug/debug.factor +++ b/basis/io/sockets/secure/unix/debug/debug.factor @@ -5,7 +5,7 @@ IN: io.sockets.secure.unix.debug : with-test-context ( quot -- ) - "resource:basis/openssl/test/server.pem" >>key-file - "resource:basis/openssl/test/dh1024.pem" >>dh-file + "vocab:openssl/test/server.pem" >>key-file + "vocab:openssl/test/dh1024.pem" >>dh-file "password" >>password swap with-secure-context ; inline diff --git a/basis/mime/types/types.factor b/basis/mime/types/types.factor index ac5233c543..5693aa9162 100644 --- a/basis/mime/types/types.factor +++ b/basis/mime/types/types.factor @@ -5,7 +5,7 @@ splitting kernel namespaces fry memoize ; IN: mime.types MEMO: mime-db ( -- seq ) - "resource:basis/mime/types/mime.types" ascii file-lines + "vocab:mime/types/mime.types" ascii file-lines [ "#" head? not ] filter [ " \t" split harvest ] map harvest ; : nonstandard-mime-types ( -- assoc ) diff --git a/basis/openssl/openssl-tests.factor b/basis/openssl/openssl-tests.factor index 93af70b3e0..aaae521a62 100644 --- a/basis/openssl/openssl-tests.factor +++ b/basis/openssl/openssl-tests.factor @@ -4,17 +4,17 @@ openssl namespaces accessors tools.test continuations kernel ; openssl secure-socket-backend [ [ ] [ - "resource:basis/openssl/test/server.pem" >>key-file - "resource:basis/openssl/test/root.pem" >>ca-file - "resource:basis/openssl/test/dh1024.pem" >>dh-file + "vocab:openssl/test/server.pem" >>key-file + "vocab:openssl/test/root.pem" >>ca-file + "vocab:openssl/test/dh1024.pem" >>dh-file "password" >>password [ ] with-secure-context ] unit-test [ - "resource:basis/openssl/test/server.pem" >>key-file - "resource:basis/openssl/test/root.pem" >>ca-file + "vocab:openssl/test/server.pem" >>key-file + "vocab:openssl/test/root.pem" >>ca-file "wrong password" >>password [ ] with-secure-context ] must-fail diff --git a/basis/porter-stemmer/porter-stemmer-tests.factor b/basis/porter-stemmer/porter-stemmer-tests.factor index 72bf5c0bb5..4403541608 100644 --- a/basis/porter-stemmer/porter-stemmer-tests.factor +++ b/basis/porter-stemmer/porter-stemmer-tests.factor @@ -57,8 +57,8 @@ io.files io.encodings.utf8 ; [ "mate" ] [ "mate" step5 "" like ] unit-test [ { } ] [ - "resource:basis/porter-stemmer/test/voc.txt" utf8 file-lines + "vocab:porter-stemmer/test/voc.txt" utf8 file-lines [ stem ] map - "resource:basis/porter-stemmer/test/output.txt" utf8 file-lines + "vocab:porter-stemmer/test/output.txt" utf8 file-lines [ 2array ] 2map [ first2 = not ] filter ] unit-test diff --git a/basis/syndication/syndication-tests.factor b/basis/syndication/syndication-tests.factor index 8cfdc9e1d5..616ce2723a 100644 --- a/basis/syndication/syndication-tests.factor +++ b/basis/syndication/syndication-tests.factor @@ -25,7 +25,7 @@ IN: syndication.tests f } } -} ] [ "resource:basis/syndication/test/rss1.xml" load-news-file ] unit-test +} ] [ "vocab:syndication/test/rss1.xml" load-news-file ] unit-test [ T{ feed f @@ -42,5 +42,5 @@ IN: syndication.tests T{ timestamp f 2003 12 13 8 29 29 T{ duration f 0 0 0 -4 0 0 } } } } -} ] [ "resource:basis/syndication/test/atom.xml" load-news-file ] unit-test -[ ] [ "resource:basis/syndication/test/atom.xml" load-news-file feed>xml xml>string drop ] unit-test +} ] [ "vocab:syndication/test/atom.xml" load-news-file ] unit-test +[ ] [ "vocab:syndication/test/atom.xml" load-news-file feed>xml xml>string drop ] unit-test diff --git a/basis/tools/crossref/crossref-tests.factor b/basis/tools/crossref/crossref-tests.factor index 3d09802576..d4f2fea2e5 100755 --- a/basis/tools/crossref/crossref-tests.factor +++ b/basis/tools/crossref/crossref-tests.factor @@ -7,7 +7,7 @@ GENERIC: foo M: integer foo + ; -"resource:basis/tools/crossref/test/foo.factor" run-file +"vocab:tools/crossref/test/foo.factor" run-file [ t ] [ integer \ foo method \ + usage member? ] unit-test [ t ] [ \ foo usage [ pathname? ] any? ] unit-test diff --git a/basis/tools/deploy/deploy-tests.factor b/basis/tools/deploy/deploy-tests.factor index 8b36947f43..600b1d8d55 100644 --- a/basis/tools/deploy/deploy-tests.factor +++ b/basis/tools/deploy/deploy-tests.factor @@ -65,7 +65,7 @@ M: quit-responder call-responder* [ ] [ add-quot-responder - "resource:basis/http/test" >>default + "vocab:http/test" >>default test-httpd ] unit-test diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index c894a8931b..0a0aa82c52 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -42,21 +42,21 @@ IN: tools.deploy.shaker : strip-debugger ( -- ) strip-debugger? "debugger" vocab and [ "Stripping debugger" show - "resource:basis/tools/deploy/shaker/strip-debugger.factor" + "vocab:tools/deploy/shaker/strip-debugger.factor" run-file ] when ; : strip-libc ( -- ) "libc" vocab [ "Stripping manual memory management debug code" show - "resource:basis/tools/deploy/shaker/strip-libc.factor" + "vocab:tools/deploy/shaker/strip-libc.factor" run-file ] when ; : strip-cocoa ( -- ) "cocoa" vocab [ "Stripping unused Cocoa methods" show - "resource:basis/tools/deploy/shaker/strip-cocoa.factor" + "vocab:tools/deploy/shaker/strip-cocoa.factor" run-file ] when ; @@ -380,7 +380,7 @@ SYMBOL: deploy-vocab dup next-method-quot "next-method-quot" set-word-prop ] assoc-each ] each - "resource:basis/tools/deploy/shaker/next-methods.factor" run-file ; + "vocab:tools/deploy/shaker/next-methods.factor" run-file ; : strip ( -- ) init-stripper diff --git a/basis/tools/vocabs/vocabs.factor b/basis/tools/vocabs/vocabs.factor index fe380e0afe..6167a5be23 100644 --- a/basis/tools/vocabs/vocabs.factor +++ b/basis/tools/vocabs/vocabs.factor @@ -241,6 +241,12 @@ M: vocab-link summary vocab-summary ; swap [ "." glue ] with map ] unless-empty ; +: vocab-dir? ( root name -- ? ) + over + [ ".factor" vocab-dir+ append-path exists? ] + [ 2drop f ] + if ; + : vocabs-in-dir ( root name -- ) dupd (all-child-vocabs) [ 2dup vocab-dir? [ dup >vocab-link , ] when diff --git a/basis/unicode/breaks/breaks-tests.factor b/basis/unicode/breaks/breaks-tests.factor index b91cb2b26c..d8e220cf18 100644 --- a/basis/unicode/breaks/breaks-tests.factor +++ b/basis/unicode/breaks/breaks-tests.factor @@ -10,10 +10,10 @@ IN: unicode.breaks.tests dup last-grapheme head last-grapheme ] unit-test : grapheme-break-test ( -- filename ) - "resource:basis/unicode/breaks/GraphemeBreakTest.txt" ; + "vocab:unicode/breaks/GraphemeBreakTest.txt" ; : word-break-test ( -- filename ) - "resource:basis/unicode/breaks/WordBreakTest.txt" ; + "vocab:unicode/breaks/WordBreakTest.txt" ; : parse-test-file ( file-name -- tests ) utf8 file-lines diff --git a/basis/unicode/breaks/breaks.factor b/basis/unicode/breaks/breaks.factor index 6bcf8b50cc..2f8daef8b2 100644 --- a/basis/unicode/breaks/breaks.factor +++ b/basis/unicode/breaks/breaks.factor @@ -127,7 +127,7 @@ to: grapheme-table VALUE: word-break-table -"resource:basis/unicode/data/WordBreakProperty.txt" load-script +"vocab:unicode/data/WordBreakProperty.txt" load-script to: word-break-table C-ENUM: wOther wCR wLF wNewline wExtend wFormat wKatakana wALetter wMidLetter diff --git a/basis/unicode/collation/collation-tests.factor b/basis/unicode/collation/collation-tests.factor index d3d0b8199d..f53a1382ae 100644 --- a/basis/unicode/collation/collation-tests.factor +++ b/basis/unicode/collation/collation-tests.factor @@ -4,7 +4,7 @@ tools.test assocs words ; IN: unicode.collation.tests : parse-test ( -- strings ) - "resource:basis/unicode/collation/CollationTest_SHIFTED.txt" + "vocab:unicode/collation/CollationTest_SHIFTED.txt" utf8 file-lines 5 tail [ ";" split1 drop " " split [ hex> ] "" map-as ] map ; diff --git a/basis/unicode/collation/collation.factor b/basis/unicode/collation/collation.factor index a8bd788e2a..78727b16e2 100755 --- a/basis/unicode/collation/collation.factor +++ b/basis/unicode/collation/collation.factor @@ -28,7 +28,7 @@ TUPLE: weight primary secondary tertiary ignorable? ; lines filter-comments [ parse-line ] H{ } map>assoc ; -"resource:basis/unicode/collation/allkeys.txt" +"vocab:unicode/collation/allkeys.txt" ascii parse-ducet to: ducet ! Fix up table for long contractions diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor index 2407b740b0..d40024eb1e 100644 --- a/basis/unicode/data/data.factor +++ b/basis/unicode/data/data.factor @@ -38,7 +38,7 @@ VALUE: properties ascii file-lines [ split-; ] map ; : load-data ( -- data ) - "resource:basis/unicode/data/UnicodeData.txt" data ; + "vocab:unicode/data/UnicodeData.txt" data ; : filter-comments ( lines -- lines ) [ "#@" split first ] map harvest ; @@ -68,7 +68,7 @@ VALUE: properties [ " " split [ hex> ] map ] assoc-map ; : exclusions-file ( -- filename ) - "resource:basis/unicode/data/CompositionExclusions.txt" ; + "vocab:unicode/data/CompositionExclusions.txt" ; : exclusions ( -- set ) exclusions-file utf8 file-lines @@ -147,7 +147,7 @@ C: code-point ! Extra properties : properties-lines ( -- lines ) - "resource:basis/unicode/data/PropList.txt" + "vocab:unicode/data/PropList.txt" ascii file-lines ; : parse-properties ( -- {{[a,b],prop}} ) @@ -166,7 +166,7 @@ C: code-point ! Special casing data : load-special-casing ( -- special-casing ) - "resource:basis/unicode/data/SpecialCasing.txt" data + "vocab:unicode/data/SpecialCasing.txt" data [ length 5 = ] filter [ [ set-code-point ] each ] H{ } make-assoc ; diff --git a/basis/unicode/normalize/normalize-tests.factor b/basis/unicode/normalize/normalize-tests.factor index 1242e1d358..f3ecb96af9 100644 --- a/basis/unicode/normalize/normalize-tests.factor +++ b/basis/unicode/normalize/normalize-tests.factor @@ -23,7 +23,7 @@ IN: unicode.normalize.tests [ "\u00d55c" ] [ "\u001112\u001161\u0011ab" nfc ] unit-test : parse-test ( -- tests ) - "resource:basis/unicode/normalize/NormalizationTest.txt" + "vocab:unicode/normalize/NormalizationTest.txt" utf8 file-lines filter-comments [ ";" split 5 head [ " " split [ hex> ] "" map-as ] map ] map ; diff --git a/basis/unicode/script/script.factor b/basis/unicode/script/script.factor index aaa6767685..383f9e3de3 100644 --- a/basis/unicode/script/script.factor +++ b/basis/unicode/script/script.factor @@ -9,7 +9,7 @@ IN: unicode.script VALUE: script-table -"resource:basis/unicode/script/Scripts.txt" load-script +"vocab:unicode/script/Scripts.txt" load-script to: script-table : script-of ( char -- script ) diff --git a/basis/xml/entities/html/html.factor b/basis/xml/entities/html/html.factor index f1e52319f1..04c0b66063 100644 --- a/basis/xml/entities/html/html.factor +++ b/basis/xml/entities/html/html.factor @@ -11,7 +11,7 @@ VALUE: html-entities : get-html ( -- table ) { "lat1" "special" "symbol" } [ - "resource:basis/xml/entities/html/xhtml-" + "vocab:xml/entities/html/xhtml-" swap ".ent" 3append read-entities-file ] map first3 assoc-union assoc-union ; diff --git a/basis/xml/tests/encodings.factor b/basis/xml/tests/encodings.factor index aec3e40a52..2f1d73f9ca 100644 --- a/basis/xml/tests/encodings.factor +++ b/basis/xml/tests/encodings.factor @@ -1,15 +1,15 @@ USING: xml xml.data xml.traversal tools.test accessors kernel io.encodings.8-bit ; -[ "\u000131" ] [ "resource:basis/xml/tests/latin5.xml" file>xml children>string ] unit-test -[ "\u0000e9" ] [ "resource:basis/xml/tests/latin1.xml" file>xml children>string ] unit-test -[ "\u0000e9" ] [ "resource:basis/xml/tests/spaces.xml" file>xml children>string ] unit-test -[ "\u0000e9" ] [ "resource:basis/xml/tests/utf8.xml" file>xml children>string ] unit-test -[ "\u0000e9" ] [ "resource:basis/xml/tests/utf16.xml" file>xml children>string ] unit-test -[ "\u0000e9" ] [ "resource:basis/xml/tests/utf16be.xml" file>xml children>string ] unit-test -[ "\u0000e9" ] [ "resource:basis/xml/tests/utf16le.xml" file>xml children>string ] unit-test -[ "\u0000e9" ] [ "resource:basis/xml/tests/utf16be-bom.xml" file>xml children>string ] unit-test -[ "\u0000e9" ] [ "resource:basis/xml/tests/utf16le-bom.xml" file>xml children>string ] unit-test -[ "\u0000e9" ] [ "resource:basis/xml/tests/prologless.xml" file>xml children>string ] unit-test -[ "e" ] [ "resource:basis/xml/tests/ascii.xml" file>xml children>string ] unit-test -[ "\u0000e9" "x" ] [ "resource:basis/xml/tests/unitag.xml" file>xml [ name>> main>> ] [ children>string ] bi ] unit-test +[ "\u000131" ] [ "vocab:xml/tests/latin5.xml" file>xml children>string ] unit-test +[ "\u0000e9" ] [ "vocab:xml/tests/latin1.xml" file>xml children>string ] unit-test +[ "\u0000e9" ] [ "vocab:xml/tests/spaces.xml" file>xml children>string ] unit-test +[ "\u0000e9" ] [ "vocab:xml/tests/utf8.xml" file>xml children>string ] unit-test +[ "\u0000e9" ] [ "vocab:xml/tests/utf16.xml" file>xml children>string ] unit-test +[ "\u0000e9" ] [ "vocab:xml/tests/utf16be.xml" file>xml children>string ] unit-test +[ "\u0000e9" ] [ "vocab:xml/tests/utf16le.xml" file>xml children>string ] unit-test +[ "\u0000e9" ] [ "vocab:xml/tests/utf16be-bom.xml" file>xml children>string ] unit-test +[ "\u0000e9" ] [ "vocab:xml/tests/utf16le-bom.xml" file>xml children>string ] unit-test +[ "\u0000e9" ] [ "vocab:xml/tests/prologless.xml" file>xml children>string ] unit-test +[ "e" ] [ "vocab:xml/tests/ascii.xml" file>xml children>string ] unit-test +[ "\u0000e9" "x" ] [ "vocab:xml/tests/unitag.xml" file>xml [ name>> main>> ] [ children>string ] bi ] unit-test diff --git a/basis/xml/tests/funny-dtd.factor b/basis/xml/tests/funny-dtd.factor index 1160af62bc..e9a38ae96b 100644 --- a/basis/xml/tests/funny-dtd.factor +++ b/basis/xml/tests/funny-dtd.factor @@ -4,6 +4,6 @@ IN: xml.tests USING: xml xml.writer io.files io.encodings.utf8 tools.test kernel ; [ t ] [ - "resource:basis/xml/tests/funny-dtd.xml" utf8 file-contents string>xml + "vocab:xml/tests/funny-dtd.xml" utf8 file-contents string>xml dup xml>string string>xml = ] unit-test diff --git a/basis/xml/tests/soap.factor b/basis/xml/tests/soap.factor index 3d1ac2379e..464002b060 100644 --- a/basis/xml/tests/soap.factor +++ b/basis/xml/tests/soap.factor @@ -10,6 +10,6 @@ IN: xml.tests [ assemble-data ] map ; [ "http://www.foxnews.com/oreilly/" ] [ - "resource:basis/xml/tests/soap.xml" file>xml + "vocab:xml/tests/soap.xml" file>xml parse-result first first ] unit-test diff --git a/basis/xml/tests/test.factor b/basis/xml/tests/test.factor index 0372132736..818a28c892 100644 --- a/basis/xml/tests/test.factor +++ b/basis/xml/tests/test.factor @@ -13,11 +13,11 @@ sequences.deep accessors io.streams.string ; SYMBOL: xml-file [ ] [ - "resource:basis/xml/tests/test.xml" + "vocab:xml/tests/test.xml" [ file>xml ] with-html-entities xml-file set ] unit-test [ t ] [ - "resource:basis/xml/tests/test.xml" binary file-contents + "vocab:xml/tests/test.xml" binary file-contents [ bytes>xml ] with-html-entities xml-file get = ] unit-test [ "1.0" ] [ xml-file get prolog>> version>> ] unit-test diff --git a/basis/xml/tests/xmltest.factor b/basis/xml/tests/xmltest.factor index 80472fc788..2ab9ff98dd 100644 --- a/basis/xml/tests/xmltest.factor +++ b/basis/xml/tests/xmltest.factor @@ -17,7 +17,7 @@ TUPLE: xml-test id uri sections description type ; : parse-tests ( xml -- tests ) "TEST" tags-named [ >xml-test ] map ; -: base "resource:basis/xml/tests/xmltest/" ; +: base "vocab:xml/tests/xmltest/" ; MACRO: drop-output ( quot -- newquot ) dup infer out>> '[ @ _ ndrop ] ; diff --git a/basis/xml/tests/xmode-dtd.factor b/basis/xml/tests/xmode-dtd.factor index 4408655d9c..ae223bf82f 100644 --- a/basis/xml/tests/xmode-dtd.factor +++ b/basis/xml/tests/xmode-dtd.factor @@ -4,5 +4,5 @@ USING: xml xml.data kernel tools.test ; IN: xml.tests [ t ] [ - "resource:basis/xmode/xmode.dtd" file>dtd dtd? + "vocab:xmode/xmode.dtd" file>dtd dtd? ] unit-test diff --git a/basis/xml/writer/writer-tests.factor b/basis/xml/writer/writer-tests.factor index 23fb7a5074..f2802abbe0 100644 --- a/basis/xml/writer/writer-tests.factor +++ b/basis/xml/writer/writer-tests.factor @@ -61,7 +61,7 @@ IN: xml.writer.tests [ " bar " string>xml pprint-xml>string ] unit-test [ "" ] [ "" xml>string ] unit-test -: test-file "resource:basis/xml/writer/test.xml" ; +: test-file "vocab: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 diff --git a/basis/xmode/catalog/catalog.factor b/basis/xmode/catalog/catalog.factor index 4e3af0af56..47186d2090 100644 --- a/basis/xmode/catalog/catalog.factor +++ b/basis/xmode/catalog/catalog.factor @@ -25,7 +25,7 @@ TAGS> ] keep ; MEMO: modes ( -- modes ) - "resource:basis/xmode/modes/catalog" + "vocab:xmode/modes/catalog" file>xml parse-modes-tag ; MEMO: mode-names ( -- modes ) @@ -37,7 +37,7 @@ MEMO: mode-names ( -- modes ) MEMO: (load-mode) ( name -- rule-sets ) modes at [ file>> - "resource:basis/xmode/modes/" prepend + "vocab:xmode/modes/" prepend utf8 parse-mode ] [ "text" (load-mode) diff --git a/basis/xmode/utilities/utilities-tests.factor b/basis/xmode/utilities/utilities-tests.factor index 45238ca2b1..1339430cf8 100644 --- a/basis/xmode/utilities/utilities-tests.factor +++ b/basis/xmode/utilities/utilities-tests.factor @@ -47,6 +47,6 @@ TAGS> "PUBLIC" } ] [ - "resource:basis/xmode/utilities/test.xml" + "vocab:xmode/utilities/test.xml" file>xml parse-company-tag ] unit-test diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index f1e8b8b65e..ceeab571b8 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -16,9 +16,9 @@ crossref off H{ } clone sub-primitives set -"resource:core/bootstrap/syntax.factor" parse-file +"vocab:bootstrap/syntax.factor" parse-file -"resource:basis/cpu/" architecture get { +"vocab:cpu/" architecture get { { "x86.32" "x86/32" } { "winnt-x86.64" "x86/64/winnt" } { "unix-x86.64" "x86/64/unix" } @@ -27,7 +27,7 @@ H{ } clone sub-primitives set { "arm" "arm" } } at "/bootstrap.factor" 3append parse-file -"resource:core/bootstrap/layouts/layouts.factor" parse-file +"vocab:bootstrap/layouts/layouts.factor" parse-file ! Now we have ( syntax-quot arch-quot layouts-quot ) on the stack diff --git a/core/bootstrap/stage1.factor b/core/bootstrap/stage1.factor index 9a40796bda..1da2dfee59 100644 --- a/core/bootstrap/stage1.factor +++ b/core/bootstrap/stage1.factor @@ -9,7 +9,7 @@ IN: bootstrap.stage1 "Bootstrap stage 1..." print flush -"resource:core/bootstrap/primitives.factor" run-file +"vocab:bootstrap/primitives.factor" run-file load-help? off { "resource:core" } vocab-roots set @@ -40,7 +40,7 @@ load-help? off "bootstrap.layouts" require [ - "resource:basis/bootstrap/stage2.factor" + "vocab:bootstrap/stage2.factor" dup exists? [ run-file ] [ diff --git a/core/io/encodings/encodings-tests.factor b/core/io/encodings/encodings-tests.factor index ea74490858..cb066dd3a5 100644 --- a/core/io/encodings/encodings-tests.factor +++ b/core/io/encodings/encodings-tests.factor @@ -4,7 +4,7 @@ namespaces accessors io.encodings ; IN: io.streams.encodings.tests [ { } ] -[ "resource:core/io/test/empty-file.txt" ascii lines ] +[ "vocab:io/test/empty-file.txt" ascii lines ] unit-test : lines-test ( stream -- line1 line2 ) @@ -14,7 +14,7 @@ unit-test "This is a line." "This is another line." ] [ - "resource:core/io/test/windows-eol.txt" + "vocab:io/test/windows-eol.txt" ascii lines-test ] unit-test @@ -22,7 +22,7 @@ unit-test "This is a line." "This is another line." ] [ - "resource:core/io/test/mac-os-eol.txt" + "vocab:io/test/mac-os-eol.txt" ascii lines-test ] unit-test @@ -30,7 +30,7 @@ unit-test "This is a line." "This is another line." ] [ - "resource:core/io/test/unix-eol.txt" + "vocab:io/test/unix-eol.txt" ascii lines-test ] unit-test diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 152d1bb85d..c49fcb7aea 100644 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -14,14 +14,14 @@ IN: io.files.tests [ "This is a line.\rThis is another line.\r" ] [ - "resource:core/io/test/mac-os-eol.txt" latin1 + "vocab:io/test/mac-os-eol.txt" latin1 [ 500 read ] with-input-stream ] unit-test [ 255 ] [ - "resource:core/io/test/binary.txt" latin1 + "vocab:io/test/binary.txt" latin1 [ read1 ] with-input-stream >fixnum ] unit-test diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index cf6b935215..f0cbd33114 100644 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -2,7 +2,7 @@ USING: io parser tools.test words ; IN: io.tests [ f ] [ - "resource:core/io/test/no-trailing-eol.factor" run-file + "vocab:io/test/no-trailing-eol.factor" run-file "foo" "io.tests" lookup ] unit-test diff --git a/core/io/pathnames/pathnames.factor b/core/io/pathnames/pathnames.factor index 1673e73083..96ac872826 100644 --- a/core/io/pathnames/pathnames.factor +++ b/core/io/pathnames/pathnames.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2008 Slava Pestov, Doug Coleman. +! Copyright (C) 2004, 2009 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors combinators io.backend kernel math math.order namespaces sequences splitting strings system ; @@ -71,10 +71,17 @@ PRIVATE> [ f ] } cond ; +: special-path? ( path -- rest ? ) + { + { [ "resource:" ?head ] [ t ] } + { [ "vocab:" ?head ] [ t ] } + [ f ] + } cond ; + : absolute-path? ( path -- ? ) { { [ dup empty? ] [ f ] } - { [ dup "resource:" head? ] [ t ] } + { [ dup special-path? nip ] [ t ] } { [ os windows? ] [ windows-absolute-path? ] } { [ dup first path-separator? ] [ t ] } [ f ] @@ -107,7 +114,7 @@ PRIVATE> dup root-directory? [ trim-tail-separators dup last-path-separator [ 1+ tail ] [ - drop "resource:" ?head [ file-name ] when + drop special-path? [ file-name ] when ] if ] unless ; @@ -117,6 +124,8 @@ PRIVATE> : resource-path ( path -- newpath ) "resource-path" get prepend-path ; +GENERIC: vocab-path ( path -- newpath ) + GENERIC: (normalize-path) ( path -- path' ) M: string (normalize-path) @@ -124,7 +133,12 @@ M: string (normalize-path) trim-head-separators resource-path (normalize-path) ] [ - current-directory get prepend-path + "vocab:" ?head [ + trim-head-separators vocab-path + (normalize-path) + ] [ + current-directory get prepend-path + ] if ] if ; M: object normalize-path ( path -- path' ) diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index 2870be9a4f..3fcf489413 100644 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -402,7 +402,7 @@ IN: parser.tests [ t ] [ "foo" "parser.tests" lookup symbol? ] unit-test ] times -[ "resource:core/parser/test/assert-depth.factor" run-file ] +[ "vocab:parser/test/assert-depth.factor" run-file ] [ got>> { 1 2 3 } sequence= ] must-fail-with diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index 48e8737fd2..00c4df92a6 100644 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007, 2008 Eduardo Cavazos, Slava Pestov. +! Copyright (C) 2007, 2009 Eduardo Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: namespaces make sequences io io.files io.pathnames kernel assocs words vocabs definitions parser continuations hashtables @@ -18,6 +18,22 @@ V{ : add-vocab-root ( root -- ) vocab-roots get adjoin ; +SYMBOL: root-cache + +root-cache [ H{ } clone ] initialize + +ERROR: not-found-in-roots path ; + + + : vocab-dir ( vocab -- dir ) vocab-name { { CHAR: . CHAR: / } } substitute ; @@ -26,25 +42,9 @@ V{ [ [ dup peek ] dip append suffix ] when* "/" join ; -: vocab-dir? ( root name -- ? ) - over - [ ".factor" vocab-dir+ append-path exists? ] - [ 2drop f ] - if ; - -SYMBOL: root-cache - -H{ } clone root-cache set-global - - - : find-vocab-root ( vocab -- path/f ) - vocab-name dup root-cache get at [ ] [ (find-vocab-root) ] ?if ; + vocab-name dup root-cache get at + [ ] [ ".factor" vocab-dir+ find-root-for ] ?if ; : vocab-append-path ( vocab path -- newpath ) swap find-vocab-root dup [ prepend-path ] [ 2drop f ] if ; @@ -104,14 +104,14 @@ SYMBOL: blacklist : add-to-blacklist ( error vocab -- ) vocab-name blacklist get dup [ set-at ] [ 3drop ] if ; -GENERIC: (load-vocab) ( name -- ) +GENERIC: (load-vocab) ( name -- vocab ) M: vocab (load-vocab) [ dup source-loaded?>> +parsing+ eq? [ dup source-loaded?>> [ dup load-source ] unless dup docs-loaded?>> [ dup load-docs ] unless - ] unless drop + ] unless ] [ [ swap add-to-blacklist ] keep rethrow ] recover ; M: vocab-link (load-vocab) @@ -120,22 +120,15 @@ M: vocab-link (load-vocab) M: string (load-vocab) create-vocab (load-vocab) ; -[ - [ - dup vocab-name blacklist get at* [ rethrow ] [ - drop dup find-vocab-root - [ [ (load-vocab) ] with-compiler-errors ] - [ dup vocab [ drop ] [ no-vocab ] if ] - if - ] if - ] with-compiler-errors -] load-vocab-hook set-global - PRIVATE> -: vocab-where ( vocab -- loc ) - vocab-source-path dup [ 1 2array ] when ; +[ + dup vocab-name blacklist get at* [ rethrow ] [ + drop dup find-vocab-root + [ [ (load-vocab) ] with-compiler-errors ] + [ dup vocab [ ] [ no-vocab ] ?if ] + if + ] if +] load-vocab-hook set-global -M: vocab where vocab-where ; - -M: vocab-link where vocab-where ; +M: vocab-spec where vocab-source-path dup [ 1 2array ] when ; diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor index fb9ce54672..977eac2b35 100644 --- a/core/vocabs/vocabs.factor +++ b/core/vocabs/vocabs.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007, 2008 Eduardo Cavazos, Slava Pestov. +! Copyright (C) 2007, 2009 Eduardo Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs strings kernel sorting namespaces sequences definitions ; @@ -21,18 +21,26 @@ SYMBOL: +done+ swap >>name H{ } clone >>words ; +TUPLE: vocab-link name ; + +C: vocab-link + +UNION: vocab-spec vocab vocab-link ; + GENERIC: vocab-name ( vocab-spec -- name ) +M: vocab vocab-name name>> ; + +M: vocab-link vocab-name name>> ; + +M: string vocab-name ; + GENERIC: vocab ( vocab-spec -- vocab ) M: vocab vocab ; M: object vocab ( name -- vocab ) vocab-name dictionary get at ; -M: vocab vocab-name name>> ; - -M: string vocab-name ; - GENERIC: vocab-words ( vocab-spec -- words ) M: vocab vocab-words words>> ; @@ -62,11 +70,6 @@ M: f vocab-main ; ERROR: no-vocab name ; -SYMBOL: load-vocab-hook ! ( name -- ) - -: load-vocab ( name -- vocab ) - dup load-vocab-hook get call vocab ; - : vocabs ( -- seq ) dictionary get keys natural-sort ; @@ -88,17 +91,6 @@ SYMBOL: load-vocab-hook ! ( name -- ) : child-vocabs ( vocab -- seq ) vocab-name vocabs [ child-vocab? ] with filter ; -TUPLE: vocab-link name ; - -: ( name -- vocab-link ) - vocab-link boa ; - -M: vocab-link hashcode* name>> hashcode* ; - -M: vocab-link vocab-name name>> ; - -UNION: vocab-spec vocab vocab-link ; - GENERIC: >vocab-link ( name -- vocab ) M: vocab-spec >vocab-link ; @@ -110,3 +102,7 @@ M: string >vocab-link dup vocab [ ] [ ] ?if ; vocab-name dictionary get delete-at ; M: vocab-spec forget* forget-vocab ; + +SYMBOL: load-vocab-hook ! ( name -- vocab ) + +: load-vocab ( name -- vocab ) load-vocab-hook get call ; \ No newline at end of file diff --git a/extra/benchmark/crc32/crc32.factor b/extra/benchmark/crc32/crc32.factor index 2fea4eb1f1..03d1585574 100755 --- a/extra/benchmark/crc32/crc32.factor +++ b/extra/benchmark/crc32/crc32.factor @@ -3,7 +3,7 @@ IN: benchmark.crc32 : crc32-file ( -- ) 10 [ - "resource:basis/mime/multipart/multipart-tests.factor" + "vocab:mime/multipart/multipart-tests.factor" crc32 checksum-file drop ] times ; diff --git a/extra/benchmark/md5/md5.factor b/extra/benchmark/md5/md5.factor index 24578ec677..5030cb6904 100644 --- a/extra/benchmark/md5/md5.factor +++ b/extra/benchmark/md5/md5.factor @@ -2,6 +2,6 @@ USING: checksums checksums.md5 io.files kernel ; IN: benchmark.md5 : md5-file ( -- ) - "resource:basis/mime/multipart/multipart-tests.factor" md5 checksum-file drop ; + "vocab:mime/multipart/multipart-tests.factor" md5 checksum-file drop ; MAIN: md5-file diff --git a/extra/benchmark/sha1/sha1.factor b/extra/benchmark/sha1/sha1.factor index 585368e836..8e19ba9a8f 100644 --- a/extra/benchmark/sha1/sha1.factor +++ b/extra/benchmark/sha1/sha1.factor @@ -2,6 +2,6 @@ USING: checksums checksums.sha1 io.files kernel ; IN: benchmark.sha1 : sha1-file ( -- ) - "resource:basis/mime/multipart/multipart-tests.factor" sha1 checksum-file drop ; + "vocab:mime/multipart/multipart-tests.factor" sha1 checksum-file drop ; MAIN: sha1-file diff --git a/extra/benchmark/xml/xml.factor b/extra/benchmark/xml/xml.factor index a32a98a133..5f8955b97c 100644 --- a/extra/benchmark/xml/xml.factor +++ b/extra/benchmark/xml/xml.factor @@ -5,7 +5,7 @@ sequences xml ; IN: benchmark.xml : xml-benchmark ( -- ) - "resource:basis/xmode/modes/" [ + "vocab:xmode/modes/" [ [ utf8 read-xml drop ] each ] with-directory-files ; diff --git a/extra/webapps/todo/todo.factor b/extra/webapps/todo/todo.factor index 6ef60c198f..4f6edee031 100755 --- a/extra/webapps/todo/todo.factor +++ b/extra/webapps/todo/todo.factor @@ -143,8 +143,8 @@ io.sockets.secure ; : ( -- config ) ! This is only suitable for testing! - "resource:basis/openssl/test/dh1024.pem" >>dh-file - "resource:basis/openssl/test/server.pem" >>key-file + "vocab:openssl/test/dh1024.pem" >>dh-file + "vocab:openssl/test/server.pem" >>key-file "password" >>password ; : ( -- responder ) diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 35a1129338..d7b132d4f2 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -69,8 +69,8 @@ SYMBOL: dh-file init-factor-db ; : init-testing ( -- ) - "resource:basis/openssl/test/dh1024.pem" dh-file set-global - "resource:basis/openssl/test/server.pem" key-file set-global + "vocab:openssl/test/dh1024.pem" dh-file set-global + "vocab:openssl/test/server.pem" key-file set-global "password" key-password set-global common-configuration From e8c3fe2afc0df3d2a0def09df866553c70054617 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 15 Feb 2009 20:08:00 -0600 Subject: [PATCH 006/119] Use vocab: in io.encodings.korean --- basis/io/encodings/korean/korean.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/encodings/korean/korean.factor b/basis/io/encodings/korean/korean.factor index 4f387d8987..cd98bb1eb0 100644 --- a/basis/io/encodings/korean/korean.factor +++ b/basis/io/encodings/korean/korean.factor @@ -17,7 +17,7 @@ cp949 "EUC-KR" register-encoding : cp949.txt-lines ( -- seq ) ! "cp949.txt" from ... ! - "resource:basis/io/encodings/korean/data/cp949.txt" + "vocab:io/encodings/korean/data/cp949.txt" ascii file-lines ; : drop-comments ( seq -- newseq ) From e1866ff0e401e97cfe1dba394c73d051177b6bc2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 15 Feb 2009 20:11:36 -0600 Subject: [PATCH 007/119] Fix xml.writer unit test --- basis/xml/writer/writer-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/xml/writer/writer-tests.factor b/basis/xml/writer/writer-tests.factor index f2802abbe0..23fb7a5074 100644 --- a/basis/xml/writer/writer-tests.factor +++ b/basis/xml/writer/writer-tests.factor @@ -61,7 +61,7 @@ IN: xml.writer.tests [ " bar " string>xml pprint-xml>string ] unit-test [ "" ] [ "" xml>string ] unit-test -: test-file "vocab:xml/writer/test.xml" ; +: 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 From 72e3210f33e51d9b4eadd7481e2102af06509725 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 15 Feb 2009 20:31:28 -0600 Subject: [PATCH 008/119] Add summary for new error --- basis/debugger/debugger.factor | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index 1440e7ca5d..23fd101991 100644 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2008 Slava Pestov. +! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: slots arrays definitions generic hashtables summary io kernel math namespaces make prettyprint prettyprint.config @@ -9,7 +9,7 @@ combinators generic.math classes.builtin classes compiler.units generic.standard vocabs init kernel.private io.encodings accessors math.order destructors source-files parser classes.tuple.parser effects.parser lexer compiler.errors -generic.parser strings.parser vocabs.parser ; +generic.parser strings.parser vocabs.loader vocabs.parser ; IN: debugger GENERIC: error. ( error -- ) @@ -323,3 +323,5 @@ M: bad-escape summary drop "Bad escape code" ; M: bad-literal-tuple summary drop "Bad literal tuple" ; M: check-mixin-class summary drop "Not a mixin class" ; + +M: not-found-in-roots summary drop "Cannot resolve vocab: path" ; From 2fe934ba9d5accdb611e1753de20111a278dd096 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 15 Feb 2009 20:36:04 -0600 Subject: [PATCH 009/119] Remove some code duplication in io.directories.unix --- basis/io/directories/unix/unix.factor | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/basis/io/directories/unix/unix.factor b/basis/io/directories/unix/unix.factor index 1ef80b3438..89e091f919 100644 --- a/basis/io/directories/unix/unix.factor +++ b/basis/io/directories/unix/unix.factor @@ -27,16 +27,8 @@ M: unix make-directory ( path -- ) M: unix delete-directory ( path -- ) normalize-path rmdir io-error ; -: (copy-file) ( from to -- ) - dup parent-directory make-directories - binary [ - swap binary [ - swap stream-copy - ] with-disposal - ] with-disposal ; - M: unix copy-file ( from to -- ) - [ normalize-path ] bi@ (copy-file) ; + [ normalize-path ] bi@ call-next-method ; : with-unix-directory ( path quot -- ) [ opendir dup [ (io-error) ] unless ] dip From ebd0e9250f2891b5ccbae60fad103b75be9f018a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 15 Feb 2009 20:45:06 -0600 Subject: [PATCH 010/119] Clean up some usages to use file-lines, file>csv, and file>xml instead --- basis/html/templates/chloe/chloe.factor | 2 +- basis/io/encodings/8-bit/8-bit.factor | 6 +++--- basis/io/encodings/iana/iana.factor | 8 ++++---- basis/unicode/collation/collation.factor | 7 +++---- basis/unicode/data/data.factor | 6 +++--- basis/xmode/catalog/catalog.factor | 3 +-- basis/xmode/loader/loader.factor | 4 ++-- core/io/encodings/encodings-tests.factor | 12 ++++++------ core/io/files/files-tests.factor | 12 ++++++------ extra/benchmark/xml/xml.factor | 2 +- extra/usa-cities/usa-cities.factor | 4 ++-- 11 files changed, 32 insertions(+), 34 deletions(-) diff --git a/basis/html/templates/chloe/chloe.factor b/basis/html/templates/chloe/chloe.factor index 439b207063..da0d45a9d4 100644 --- a/basis/html/templates/chloe/chloe.factor +++ b/basis/html/templates/chloe/chloe.factor @@ -107,7 +107,7 @@ TUPLE: cached-template path last-modified quot ; path>> ".xml" append [ ] [ file-info modified>> ] - [ utf8 read-xml compile-template ] tri + [ file>xml compile-template ] tri \ cached-template boa ; \ load-template DEBUG add-input-logging diff --git a/basis/io/encodings/8-bit/8-bit.factor b/basis/io/encodings/8-bit/8-bit.factor index b3519a7990..bad2d9fd82 100644 --- a/basis/io/encodings/8-bit/8-bit.factor +++ b/basis/io/encodings/8-bit/8-bit.factor @@ -34,7 +34,7 @@ IN: io.encodings.8-bit : encoding-file ( file-name -- stream ) "vocab:io/encodings/8-bit/" swap ".TXT" - 3append ascii ; + 3append ; : process-contents ( lines -- assoc ) [ "#" split1 drop ] map harvest @@ -47,8 +47,8 @@ IN: io.encodings.8-bit : ch>byte ( assoc -- newassoc ) [ swap ] assoc-map >hashtable ; -: parse-file ( stream -- byte>ch ch>byte ) - lines process-contents +: parse-file ( path -- byte>ch ch>byte ) + ascii file-lines process-contents [ byte>ch ] [ ch>byte ] bi ; SYMBOL: 8-bit-encodings diff --git a/basis/io/encodings/iana/iana.factor b/basis/io/encodings/iana/iana.factor index 07b0429696..a8555ac339 100644 --- a/basis/io/encodings/iana/iana.factor +++ b/basis/io/encodings/iana/iana.factor @@ -21,14 +21,14 @@ ERROR: missing-name encoding ; dup e>n-table get-global at [ ] [ missing-name ] ?if ; e ) +: make-aliases ( file -- n>e ) parse-iana [ [ first ] [ ] bi ] H{ } map>assoc ; : initial-n>e ( -- assoc ) @@ -45,7 +45,7 @@ ERROR: missing-name encoding ; PRIVATE> "vocab:io/encodings/iana/character-sets" -utf8 make-aliases aliases set-global +make-aliases aliases set-global n>e-table [ initial-n>e ] initialize e>n-table [ initial-e>n ] initialize diff --git a/basis/unicode/collation/collation.factor b/basis/unicode/collation/collation.factor index 78727b16e2..2a94d501bd 100755 --- a/basis/unicode/collation/collation.factor +++ b/basis/unicode/collation/collation.factor @@ -24,12 +24,11 @@ TUPLE: weight primary secondary tertiary ignorable? ; ";" split1 [ [ blank? ] trim ] bi@ [ " " split [ hex> ] "" map-as ] [ parse-weight ] bi* ; -: parse-ducet ( stream -- ducet ) - lines filter-comments +: parse-ducet ( file -- ducet ) + ascii file-lines filter-comments [ parse-line ] H{ } map>assoc ; -"vocab:unicode/collation/allkeys.txt" -ascii parse-ducet to: ducet +"vocab:unicode/collation/allkeys.txt" parse-ducet to: ducet ! Fix up table for long contractions : help-one ( assoc key -- ) diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor index d40024eb1e..de8d28ad2e 100644 --- a/basis/unicode/data/data.factor +++ b/basis/unicode/data/data.factor @@ -196,9 +196,9 @@ load-properties to: properties SYMBOL: interned -: parse-script ( stream -- assoc ) +: parse-script ( filename -- assoc ) ! assoc is code point/range => name - lines filter-comments [ split-; ] map ; + ascii file-lines filter-comments [ split-; ] map ; : range, ( value key -- ) swap interned get @@ -218,7 +218,7 @@ SYMBOL: interned [ expand-ranges ] with-variable ; : load-script ( filename -- table ) - ascii parse-script process-script ; + parse-script process-script ; [ name>char [ "Invalid character" throw ] unless* ] name>char-hook set-global diff --git a/basis/xmode/catalog/catalog.factor b/basis/xmode/catalog/catalog.factor index 47186d2090..7a935d31a4 100644 --- a/basis/xmode/catalog/catalog.factor +++ b/basis/xmode/catalog/catalog.factor @@ -37,8 +37,7 @@ MEMO: mode-names ( -- modes ) MEMO: (load-mode) ( name -- rule-sets ) modes at [ file>> - "vocab:xmode/modes/" prepend - utf8 parse-mode + "vocab:xmode/modes/" prepend parse-mode ] [ "text" (load-mode) ] if* ; diff --git a/basis/xmode/loader/loader.factor b/basis/xmode/loader/loader.factor index 70466913a0..ef1defc4da 100644 --- a/basis/xmode/loader/loader.factor +++ b/basis/xmode/loader/loader.factor @@ -84,5 +84,5 @@ TAGS> [ merge-rule-set-props ] with each ] when* ; -: parse-mode ( stream -- rule-sets ) - read-xml parse-mode-tag ; +: parse-mode ( filename -- rule-sets ) + file>xml parse-mode-tag ; diff --git a/core/io/encodings/encodings-tests.factor b/core/io/encodings/encodings-tests.factor index cb066dd3a5..fa8832deab 100644 --- a/core/io/encodings/encodings-tests.factor +++ b/core/io/encodings/encodings-tests.factor @@ -4,18 +4,18 @@ namespaces accessors io.encodings ; IN: io.streams.encodings.tests [ { } ] -[ "vocab:io/test/empty-file.txt" ascii lines ] +[ "vocab:io/test/empty-file.txt" ascii file-lines ] unit-test -: lines-test ( stream -- line1 line2 ) - [ readln readln ] with-input-stream ; +: lines-test ( file encoding -- line1 line2 ) + [ readln readln ] with-file-reader ; [ "This is a line." "This is another line." ] [ "vocab:io/test/windows-eol.txt" - ascii lines-test + ascii lines-test ] unit-test [ @@ -23,7 +23,7 @@ unit-test "This is another line." ] [ "vocab:io/test/mac-os-eol.txt" - ascii lines-test + ascii lines-test ] unit-test [ @@ -31,7 +31,7 @@ unit-test "This is another line." ] [ "vocab:io/test/unix-eol.txt" - ascii lines-test + ascii lines-test ] unit-test [ diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index c49fcb7aea..ce15a69773 100644 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -14,15 +14,15 @@ IN: io.files.tests [ "This is a line.\rThis is another line.\r" ] [ - "vocab:io/test/mac-os-eol.txt" latin1 - [ 500 read ] with-input-stream + "vocab:io/test/mac-os-eol.txt" latin1 + [ 500 read ] with-file-reader ] unit-test [ 255 ] [ - "vocab:io/test/binary.txt" latin1 - [ read1 ] with-input-stream >fixnum + "vocab:io/test/binary.txt" latin1 + [ read1 ] with-file-reader >fixnum ] unit-test [ ] [ @@ -39,11 +39,11 @@ IN: io.files.tests ] [ [ "separator-test.txt" temp-file - latin1 [ + latin1 [ "J" read-until 2array , "i" read-until 2array , "X" read-until 2array , - ] with-input-stream + ] with-file-reader ] { } make ] unit-test diff --git a/extra/benchmark/xml/xml.factor b/extra/benchmark/xml/xml.factor index 5f8955b97c..0450331ddf 100644 --- a/extra/benchmark/xml/xml.factor +++ b/extra/benchmark/xml/xml.factor @@ -6,7 +6,7 @@ IN: benchmark.xml : xml-benchmark ( -- ) "vocab:xmode/modes/" [ - [ utf8 read-xml drop ] each + [ file>xml drop ] each ] with-directory-files ; MAIN: xml-benchmark diff --git a/extra/usa-cities/usa-cities.factor b/extra/usa-cities/usa-cities.factor index 25ec30ac78..0ee2a114dd 100644 --- a/extra/usa-cities/usa-cities.factor +++ b/extra/usa-cities/usa-cities.factor @@ -28,8 +28,8 @@ TUPLE: city first-zip name state latitude longitude gmt-offset dst-offset ; MEMO: cities ( -- seq ) - "resource:extra/usa-cities/zipcode.csv" ascii - csv rest-slice [ + "resource:extra/usa-cities/zipcode.csv" ascii file>csv + rest-slice [ [ { [ string>number ] From 20053c7f5c00b0d3127d71bc63a9aa4f58cb79d5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 16 Feb 2009 19:00:09 -0600 Subject: [PATCH 011/119] Deploy tool: if debugger is not stripped out, actually use it to report errors; print an error if vocab has no MAIN: word --- basis/debugger/debugger.factor | 2 +- basis/tools/deploy/backend/backend.factor | 13 ------ basis/tools/deploy/deploy-tests.factor | 5 +++ basis/tools/deploy/shaker/shaker.factor | 48 ++++++++++++++++++----- 4 files changed, 45 insertions(+), 23 deletions(-) diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index 23fd101991..5f7431ecf3 100644 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -70,7 +70,7 @@ M: string error. print ; "Type :help for debugging help." print flush ; : try ( quot -- ) - [ print-error-and-restarts ] recover ; + [ print-error-and-restarts ] recover ; inline : expired-error. ( obj -- ) "Object did not survive image save/load: " write third . ; diff --git a/basis/tools/deploy/backend/backend.factor b/basis/tools/deploy/backend/backend.factor index ff851edce6..7d8f357240 100755 --- a/basis/tools/deploy/backend/backend.factor +++ b/basis/tools/deploy/backend/backend.factor @@ -58,25 +58,17 @@ DEFER: ?make-staging-image : staging-command-line ( profile -- flags ) [ "-staging" , - dup empty? [ "-i=" my-boot-image-name append , ] [ dup but-last ?make-staging-image - "-resource-path=" "" resource-path append , - "-i=" over but-last staging-image-name append , - "-run=tools.deploy.restage" , ] if - "-output-image=" over staging-image-name append , - "-include=" swap " " join append , - strip-word-names? [ "-no-stack-traces" , ] when - "-no-user-init" , ] { } make ; @@ -101,16 +93,11 @@ DEFER: ?make-staging-image [ "-i=" bootstrap-profile staging-image-name append , - "-resource-path=" "" resource-path append , - "-run=tools.deploy.shaker" , - [ "-deploy-vocab=" prepend , ] [ make-deploy-config "-deploy-config=" prepend , ] bi - "-output-image=" prepend , - strip-word-names? [ "-no-stack-traces" , ] when ] { } make ] bind ; diff --git a/basis/tools/deploy/deploy-tests.factor b/basis/tools/deploy/deploy-tests.factor index 600b1d8d55..0dea093081 100644 --- a/basis/tools/deploy/deploy-tests.factor +++ b/basis/tools/deploy/deploy-tests.factor @@ -104,3 +104,8 @@ M: quit-responder call-responder* "tools.deploy.test.10" shake-and-bake run-temp-image ] unit-test + +[ ] [ + "tools.deploy.test.11" shake-and-bake + run-temp-image +] unit-test \ No newline at end of file diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 0a0aa82c52..7ba5cee507 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007, 2008 Slava Pestov. +! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors io.backend io.streams.c init fry namespaces make assocs kernel parser lexer strings.parser vocabs @@ -232,7 +232,6 @@ IN: tools.deploy.shaker "tools" "io.launcher" "random" - "compiler" "stack-checker" "bootstrap" "listener" @@ -241,7 +240,7 @@ IN: tools.deploy.shaker strip-dictionary? [ "libraries" "alien" lookup , - { } { "cpu" } strip-vocab-globals % + { } { "cpu" "compiler" } strip-vocab-globals % { gensym @@ -359,12 +358,26 @@ IN: tools.deploy.shaker SYMBOL: deploy-vocab -: set-boot-quot* ( word -- ) +: [:c] ( -- word ) ":c" "debugger" lookup ; + +: [print-error] ( -- word ) "print-error" "debugger" lookup ; + +: deploy-boot-quot ( word -- ) [ - \ boot , + [ boot ] % init-hooks get values concat % - , - strip-io? [ \ flush , ] unless + strip-debugger? [ , ] [ + ! Don't reference try directly + [:c] + [print-error] + '[ + [ _ execute ] [ + _ execute nl + _ execute + ] recover + ] % + ] if + strip-io? [ [ flush ] % ] unless [ 0 exit ] % ] [ ] make set-boot-quot ; @@ -392,7 +405,7 @@ SYMBOL: deploy-vocab strip-init-hooks strip-c-io f 5 setenv ! we can't use the Factor debugger or Factor I/O anymore - deploy-vocab get vocab-main set-boot-quot* + deploy-vocab get vocab-main deploy-boot-quot stripped-word-props stripped-globals strip-globals compress-byte-arrays @@ -401,16 +414,33 @@ SYMBOL: deploy-vocab compress-wrappers strip-words ; +: deploy-error-handler ( quot -- ) + [ + strip-debugger? + [ error-continuation get call>> callstack>array die ] + ! Don't reference these words literally, if we're stripping the + ! debugger out we don't want to load the prettyprinter at all + [ [:c] nl [print-error] ] if + 1 exit + ] recover ; inline + : (deploy) ( final-image vocab config -- ) #! Does the actual work of a deployment in the slave #! stage2 image [ [ + strip-debugger? [ + "debugger" require + "inspector" require + ] unless deploy-vocab set deploy-vocab get require + deploy-vocab get vocab-main [ + "Vocabulary has no MAIN: word." print flush 1 exit + ] unless strip finish-deploy - ] [ error-continuation get call>> callstack>array die 1 exit ] recover + ] deploy-error-handler ] bind ; : do-deploy ( -- ) From 1a4aaf219fcc930ac8e5b4dedf63feab594547cc Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 16 Feb 2009 19:36:02 -0600 Subject: [PATCH 012/119] Fix deploy tool: error wasn't printed properly --- basis/tools/deploy/shaker/shaker.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 7ba5cee507..5095f9e93e 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -420,7 +420,7 @@ SYMBOL: deploy-vocab [ error-continuation get call>> callstack>array die ] ! Don't reference these words literally, if we're stripping the ! debugger out we don't want to load the prettyprinter at all - [ [:c] nl [print-error] ] if + [ [:c] execute nl [print-error] execute flush ] if 1 exit ] recover ; inline From 6b25e994703de26f7d37eceb6aa11d7bd1f5c0d5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 16 Feb 2009 21:05:13 -0600 Subject: [PATCH 013/119] Add summary for heaps more vocabs --- basis/alien/complex/functor/summary.txt | 1 + basis/alien/parser/summary.txt | 1 + basis/alien/prettyprint/summary.txt | 1 + basis/alien/strings/summary.txt | 1 + basis/alien/strings/unix/summary.txt | 1 + basis/alien/strings/windows/summary.txt | 1 + basis/alien/structs/fields/summary.txt | 1 + basis/assoc-heaps/summary.txt | 1 + basis/bitstreams/summary.txt | 1 + basis/bootstrap/help/help.factor | 1 + basis/cairo/ffi/summary.txt | 1 + basis/cairo/gadgets/summary.txt | 1 + basis/calendar/format/macros/summary.txt | 1 + basis/calendar/unix/summary.txt | 1 + basis/calendar/windows/summary.txt | 1 + basis/call/summary.txt | 1 + basis/checksums/adler-32/summary.txt | 1 + basis/checksums/md5/summary.txt | 1 + basis/checksums/null/summary.txt | 1 + basis/checksums/openssl/summary.txt | 1 + basis/checksums/sha1/summary.txt | 1 + basis/checksums/sha2/summary.txt | 1 + basis/checksums/stream/summary.txt | 1 + basis/cocoa/enumeration/summary.txt | 1 + basis/cocoa/plists/summary.txt | 1 + basis/colors/gray/summary.txt | 1 + basis/colors/hsv/summary.txt | 1 + basis/combinators/short-circuit/smart/summary.txt | 1 + basis/combinators/short-circuit/summary.txt | 1 + basis/combinators/smart/summary.txt | 1 + basis/compiler/alien/summary.txt | 1 + basis/compiler/cfg/alias-analysis/summary.txt | 1 + basis/compiler/cfg/copy-prop/summary.txt | 1 + basis/compiler/cfg/dead-code/summary.txt | 1 + basis/compiler/cfg/debugger/summary.txt | 1 + basis/compiler/cfg/def-use/summary.txt | 1 + basis/compiler/cfg/hats/summary.txt | 1 + basis/compiler/cfg/height/summary.txt | 1 + basis/compiler/cfg/instructions/summary.txt | 1 + .../compiler/cfg/instructions/syntax/summary.txt | 1 + basis/compiler/cfg/intrinsics/alien/summary.txt | 1 + basis/compiler/cfg/intrinsics/allot/summary.txt | 1 + basis/compiler/cfg/intrinsics/fixnum/summary.txt | 1 + basis/compiler/cfg/intrinsics/float/summary.txt | 1 + basis/compiler/cfg/intrinsics/misc/summary.txt | 1 + basis/compiler/cfg/intrinsics/slots/summary.txt | 1 + basis/compiler/cfg/intrinsics/summary.txt | 1 + basis/compiler/cfg/iterator/summary.txt | 1 + .../cfg/linear-scan/allocation/summary.txt | 1 + .../cfg/linear-scan/assignment/summary.txt | 1 + .../compiler/cfg/linear-scan/debugger/summary.txt | 1 + .../cfg/linear-scan/live-intervals/summary.txt | 1 + basis/compiler/cfg/linear-scan/summary.txt | 1 + basis/compiler/cfg/linearization/summary.txt | 1 + basis/compiler/cfg/optimizer/summary.txt | 1 + basis/compiler/cfg/predecessors/summary.txt | 1 + basis/compiler/cfg/registers/summary.txt | 1 + basis/compiler/cfg/rpo/summary.txt | 1 + basis/compiler/cfg/stack-frame/summary.txt | 1 + basis/compiler/cfg/stacks/summary.txt | 1 + basis/compiler/cfg/summary.txt | 1 + basis/compiler/cfg/two-operand/summary.txt | 1 + basis/compiler/cfg/useless-blocks/summary.txt | 1 + basis/compiler/cfg/utilities/summary.txt | 1 + .../cfg/value-numbering/expressions/summary.txt | 1 + .../cfg/value-numbering/graph/summary.txt | 1 + .../cfg/value-numbering/propagate/summary.txt | 1 + .../cfg/value-numbering/rewrite/summary.txt | 1 + .../cfg/value-numbering/simplify/summary.txt | 1 + basis/compiler/cfg/value-numbering/summary.txt | 1 + basis/compiler/cfg/write-barrier/summary.txt | 1 + basis/compiler/codegen/summary.txt | 1 + basis/compiler/tree/builder/summary.txt | 1 + basis/compiler/tree/checker/summary.txt | 1 + basis/compiler/tree/cleanup/summary.txt | 1 + basis/compiler/tree/combinators/summary.txt | 1 + basis/compiler/tree/comparisons/summary.txt | 1 + .../compiler/tree/dead-code/branches/summary.txt | 1 + .../compiler/tree/dead-code/liveness/summary.txt | 1 + .../compiler/tree/dead-code/recursive/summary.txt | 1 + basis/compiler/tree/dead-code/simple/summary.txt | 1 + basis/compiler/tree/dead-code/summary.txt | 1 + basis/compiler/tree/debugger/summary.txt | 1 + .../compiler/tree/def-use/simplified/summary.txt | 1 + .../tree/escape-analysis/allocations/summary.txt | 1 + .../tree/escape-analysis/branches/summary.txt | 1 + .../tree/escape-analysis/check/summary.txt | 1 + .../tree/escape-analysis/nodes/summary.txt | 1 + .../tree/escape-analysis/recursive/summary.txt | 1 + .../tree/escape-analysis/simple/summary.txt | 1 + basis/compiler/tree/escape-analysis/summary.txt | 1 + basis/compiler/tree/finalization/summary.txt | 1 + basis/compiler/tree/identities/summary.txt | 1 + .../compiler/tree/late-optimizations/summary.txt | 1 + .../compiler/tree/modular-arithmetic/summary.txt | 1 + .../tree/normalization/introductions/summary.txt | 1 + .../tree/normalization/renaming/summary.txt | 1 + basis/compiler/tree/normalization/summary.txt | 1 + basis/compiler/tree/optimizer/summary.txt | 1 + .../tree/propagation/branches/summary.txt | 1 + .../tree/propagation/constraints/summary.txt | 1 + basis/compiler/tree/propagation/copy/summary.txt | 1 + basis/compiler/tree/propagation/info/summary.txt | 1 + .../tree/propagation/inlining/summary.txt | 1 + .../tree/propagation/known-words/summary.txt | 1 + basis/compiler/tree/propagation/nodes/summary.txt | 1 + .../tree/propagation/recursive/summary.txt | 1 + .../compiler/tree/propagation/simple/summary.txt | 1 + basis/compiler/tree/propagation/slots/summary.txt | 1 + basis/compiler/tree/recursive/summary.txt | 1 + basis/compiler/tree/tuple-unboxing/summary.txt | 1 + basis/compiler/utilities/summary.txt | 1 + basis/compression/lzw/summary.txt | 1 + basis/compression/zlib/ffi/summary.txt | 1 + basis/compression/zlib/summary.txt | 1 + basis/concurrency/flags/summary.txt | 1 + basis/concurrency/mailboxes/summary.txt | 1 + basis/constructors/summary.txt | 1 + basis/core-foundation/arrays/summary.txt | 1 + basis/core-foundation/bundles/summary.txt | 1 + basis/core-foundation/data/summary.txt | 1 + .../core-foundation/file-descriptors/summary.txt | 1 + basis/core-foundation/fsevents/summary.txt | 1 + basis/core-foundation/strings/summary.txt | 1 + basis/core-foundation/time/summary.txt | 1 + basis/core-foundation/timers/summary.txt | 1 + basis/core-foundation/urls/summary.txt | 1 + basis/cpu/ppc/linux/summary.txt | 1 + basis/cpu/ppc/macosx/summary.txt | 1 + basis/cpu/x86/32/summary.txt | 1 + basis/cpu/x86/64/unix/summary.txt | 1 + basis/cpu/x86/64/winnt/summary.txt | 1 + basis/cpu/x86/assembler/summary.txt | 1 + basis/cpu/x86/assembler/syntax/summary.txt | 1 + basis/db/errors/summary.txt | 1 + basis/db/pools/summary.txt | 1 + basis/db/postgresql/summary.txt | 1 + basis/db/queries/summary.txt | 1 + basis/db/sqlite/summary.txt | 1 + basis/db/tuples/summary.txt | 1 + basis/db/types/summary.txt | 1 + basis/delegate/protocols/summary.txt | 1 + basis/endian/summary.txt | 1 + basis/environment/unix/macosx/summary.txt | 1 + basis/environment/unix/summary.txt | 1 + basis/environment/winnt/summary.txt | 1 + basis/farkup/tags.txt | 1 + basis/ftp/client/summary.txt | 1 + basis/ftp/server/summary.txt | 1 + basis/ftp/summary.txt | 1 + basis/help/html/summary.txt | 1 + basis/html/summary.txt | 1 + basis/html/templates/chloe/compiler/summary.txt | 1 + basis/http/server/dispatchers/summary.txt | 1 + basis/http/server/filters/summary.txt | 1 + basis/http/server/redirection/summary.txt | 1 + basis/http/server/remapping/summary.txt | 1 + basis/http/server/responses/summary.txt | 1 + basis/http/server/static/summary.txt | 1 + basis/images/bitmap/summary.txt | 1 + basis/images/loader/summary.txt | 1 + basis/images/summary.txt | 1 + basis/images/tiff/summary.txt | 1 + basis/interpolate/summary.txt | 1 + .../backend/unix/multiplexers/epoll/summary.txt | 1 + .../backend/unix/multiplexers/kqueue/summary.txt | 1 + .../unix/multiplexers/run-loop/summary.txt | 1 + .../backend/unix/multiplexers/select/summary.txt | 1 + basis/io/backend/unix/multiplexers/summary.txt | 1 + basis/io/directories/search/summary.txt | 1 + basis/io/encodings/chinese/summary.txt | 1 + basis/io/encodings/korean/tags.txt | 1 - basis/io/encodings/strict/tags.txt | 1 - basis/io/encodings/string/summary.txt | 2 +- basis/io/encodings/string/tags.factor | 1 - basis/io/encodings/{8-bit => string}/tags.txt | 0 basis/io/encodings/utf16/tags.txt | 1 - basis/io/encodings/utf16n/summary.txt | 1 + basis/io/encodings/utf32/tags.txt | 1 - basis/io/files/types/summary.txt | 1 + basis/io/files/unique/summary.txt | 1 + basis/io/pipes/summary.txt | 1 + basis/io/streams/byte-array/summary.txt | 1 + basis/io/streams/limited/summary.txt | 1 + basis/io/streams/memory/summary.txt | 1 + basis/lcs/diff2html/summary.txt | 1 + basis/lists/lazy/examples/summary.txt | 1 + basis/locals/backend/summary.txt | 1 + basis/locals/definitions/summary.txt | 1 + basis/locals/errors/summary.txt | 1 + basis/locals/fry/summary.txt | 1 + basis/locals/macros/summary.txt | 1 + basis/locals/parser/summary.txt | 1 + basis/locals/prettyprint/summary.txt | 1 + basis/locals/rewrite/closures/summary.txt | 1 + basis/locals/rewrite/point-free/summary.txt | 1 + basis/locals/rewrite/sugar/summary.txt | 1 + basis/locals/types/summary.txt | 1 + basis/macros/expander/summary.txt | 1 + basis/math/partial-dispatch/summary.txt | 1 + .../positioning/positioning-docs.factor | 0 basis/mime/multipart/summary.txt | 1 + basis/mime/types/summary.txt | 1 + basis/models/compose/summary.txt | 1 + basis/models/delay/summary.txt | 1 + basis/models/filter/summary.txt | 1 + basis/models/history/summary.txt | 1 + basis/models/mapping/summary.txt | 1 + basis/models/range/summary.txt | 1 + basis/nibble-arrays/summary.txt | 1 + basis/openssl/libcrypto/summary.txt | 1 + basis/openssl/libssl/summary.txt | 1 + basis/pack/summary.txt | 1 + basis/peg/ebnf/summary.txt | 2 +- basis/peg/ebnf/tags.txt | 1 + basis/peg/parsers/summary.txt | 1 + .../{io/encodings/ascii => peg/parsers}/tags.txt | 0 basis/peg/summary.txt | 2 +- basis/prettyprint/custom/summary.txt | 1 + basis/random/dummy/summary.txt | 1 + basis/random/unix/summary.txt | 1 + basis/random/windows/summary.txt | 1 + basis/smtp/server/summary.txt | 1 + basis/sorting/slots/summary.txt | 1 + .../specialized-arrays/direct/functor/summary.txt | 1 + basis/specialized-arrays/functor/summary.txt | 1 + basis/specialized-vectors/functor/summary.txt | 1 + basis/stack-checker/alien/summary.txt | 1 + basis/stack-checker/branches/summary.txt | 1 + basis/stack-checker/inlining/summary.txt | 1 + basis/stack-checker/recursive-state/summary.txt | 1 + .../recursive-state/tree/summary.txt | 1 + basis/stack-checker/values/summary.txt | 1 + basis/stack-checker/visitor/dummy/summary.txt | 1 + basis/stack-checker/visitor/summary.txt | 1 + basis/tools/deploy/test/11/11-tests.factor | 4 ++++ basis/tools/deploy/test/11/11.factor | 8 ++++++++ basis/tools/deploy/test/11/authors.txt | 1 + basis/tools/deploy/test/11/deploy.factor | 15 +++++++++++++++ basis/tools/files/summary.txt | 1 + basis/tools/scaffold/summary.txt | 1 + basis/tools/threads/summary.txt | 1 + basis/tools/vocabs/browser/summary.txt | 1 + basis/tools/vocabs/summary.txt | 1 + basis/ui/gadgets/canvas/summary.txt | 1 + basis/ui/tools/deploy/summary.txt | 1 + basis/ui/windows/summary.txt | 1 + basis/ui/x11/summary.txt | 1 + basis/unicode/breaks/summary.txt | 1 + basis/unicode/case/summary.txt | 1 + basis/unicode/categories/summary.txt | 1 + basis/unicode/collation/summary.txt | 1 + .../binary => unicode/collation}/tags.txt | 0 basis/unicode/data/summary.txt | 1 + basis/unicode/normalize/summary.txt | 1 + .../japanese => unicode/script}/tags.txt | 0 basis/unicode/summary.txt | 2 +- basis/unicode/syntax/summary.txt | 1 + basis/unix/groups/summary.txt | 1 + basis/unix/users/summary.txt | 1 + basis/unrolled-lists/summary.txt | 1 + basis/urls/secure/summary.txt | 1 + basis/vlists/summary.txt | 1 + basis/wrap/strings/summary.txt | 1 + basis/wrap/words/summary.txt | 1 + basis/xml/entities/html/summary.txt | 1 + basis/xmode/code2html/summary.txt | 1 + basis/xmode/marker/summary.txt | 1 + core/classes/algebra/summary.txt | 1 + core/classes/builtin/summary.txt | 1 + core/classes/intersection/summary.txt | 1 + core/classes/parser/summary.txt | 1 + core/classes/singleton/summary.txt | 1 + core/classes/tuple/parser/summary.txt | 1 + core/classes/tuple/summary.txt | 2 +- core/combinators/summary.txt | 2 +- core/effects/parser/summary.txt | 1 + core/generic/parser/summary.txt | 1 + .../standard/engines/predicate/summary.txt | 1 + core/generic/standard/engines/summary.txt | 1 + core/generic/standard/engines/tag/summary.txt | 1 + core/generic/standard/engines/tuple/summary.txt | 1 + core/io/encodings/utf8/tags.txt | 1 - core/io/streams/null/summary.txt | 1 + core/math/order/summary.txt | 1 + core/splitting/tags.txt | 1 + core/strings/parser/summary.txt | 1 + core/system/summary.txt | 2 +- core/vocabs/parser/summary.txt | 1 + core/words/constant/summary.txt | 1 + core/words/symbol/summary.txt | 1 + extra/peg/javascript/ast/tags.txt | 1 - extra/peg/javascript/parser/tags.txt | 1 - extra/peg/javascript/tags.txt | 1 - extra/peg/javascript/tokenizer/tags.txt | 1 - 295 files changed, 304 insertions(+), 17 deletions(-) create mode 100644 basis/alien/complex/functor/summary.txt create mode 100644 basis/alien/parser/summary.txt create mode 100644 basis/alien/prettyprint/summary.txt create mode 100644 basis/alien/strings/summary.txt create mode 100644 basis/alien/strings/unix/summary.txt create mode 100644 basis/alien/strings/windows/summary.txt create mode 100644 basis/alien/structs/fields/summary.txt create mode 100644 basis/assoc-heaps/summary.txt create mode 100644 basis/bitstreams/summary.txt create mode 100644 basis/cairo/ffi/summary.txt create mode 100644 basis/cairo/gadgets/summary.txt create mode 100644 basis/calendar/format/macros/summary.txt create mode 100644 basis/calendar/unix/summary.txt create mode 100644 basis/calendar/windows/summary.txt create mode 100644 basis/call/summary.txt create mode 100644 basis/checksums/adler-32/summary.txt create mode 100644 basis/checksums/md5/summary.txt create mode 100644 basis/checksums/null/summary.txt create mode 100644 basis/checksums/openssl/summary.txt create mode 100644 basis/checksums/sha1/summary.txt create mode 100644 basis/checksums/sha2/summary.txt create mode 100644 basis/checksums/stream/summary.txt create mode 100644 basis/cocoa/enumeration/summary.txt create mode 100644 basis/cocoa/plists/summary.txt create mode 100644 basis/colors/gray/summary.txt create mode 100644 basis/colors/hsv/summary.txt create mode 100644 basis/combinators/short-circuit/smart/summary.txt create mode 100644 basis/combinators/short-circuit/summary.txt create mode 100644 basis/combinators/smart/summary.txt create mode 100644 basis/compiler/alien/summary.txt create mode 100644 basis/compiler/cfg/alias-analysis/summary.txt create mode 100644 basis/compiler/cfg/copy-prop/summary.txt create mode 100644 basis/compiler/cfg/dead-code/summary.txt create mode 100644 basis/compiler/cfg/debugger/summary.txt create mode 100644 basis/compiler/cfg/def-use/summary.txt create mode 100644 basis/compiler/cfg/hats/summary.txt create mode 100644 basis/compiler/cfg/height/summary.txt create mode 100644 basis/compiler/cfg/instructions/summary.txt create mode 100644 basis/compiler/cfg/instructions/syntax/summary.txt create mode 100644 basis/compiler/cfg/intrinsics/alien/summary.txt create mode 100644 basis/compiler/cfg/intrinsics/allot/summary.txt create mode 100644 basis/compiler/cfg/intrinsics/fixnum/summary.txt create mode 100644 basis/compiler/cfg/intrinsics/float/summary.txt create mode 100644 basis/compiler/cfg/intrinsics/misc/summary.txt create mode 100644 basis/compiler/cfg/intrinsics/slots/summary.txt create mode 100644 basis/compiler/cfg/intrinsics/summary.txt create mode 100644 basis/compiler/cfg/iterator/summary.txt create mode 100644 basis/compiler/cfg/linear-scan/allocation/summary.txt create mode 100644 basis/compiler/cfg/linear-scan/assignment/summary.txt create mode 100644 basis/compiler/cfg/linear-scan/debugger/summary.txt create mode 100644 basis/compiler/cfg/linear-scan/live-intervals/summary.txt create mode 100644 basis/compiler/cfg/linear-scan/summary.txt create mode 100644 basis/compiler/cfg/linearization/summary.txt create mode 100644 basis/compiler/cfg/optimizer/summary.txt create mode 100644 basis/compiler/cfg/predecessors/summary.txt create mode 100644 basis/compiler/cfg/registers/summary.txt create mode 100644 basis/compiler/cfg/rpo/summary.txt create mode 100644 basis/compiler/cfg/stack-frame/summary.txt create mode 100644 basis/compiler/cfg/stacks/summary.txt create mode 100644 basis/compiler/cfg/summary.txt create mode 100644 basis/compiler/cfg/two-operand/summary.txt create mode 100644 basis/compiler/cfg/useless-blocks/summary.txt create mode 100644 basis/compiler/cfg/utilities/summary.txt create mode 100644 basis/compiler/cfg/value-numbering/expressions/summary.txt create mode 100644 basis/compiler/cfg/value-numbering/graph/summary.txt create mode 100644 basis/compiler/cfg/value-numbering/propagate/summary.txt create mode 100644 basis/compiler/cfg/value-numbering/rewrite/summary.txt create mode 100644 basis/compiler/cfg/value-numbering/simplify/summary.txt create mode 100644 basis/compiler/cfg/value-numbering/summary.txt create mode 100644 basis/compiler/cfg/write-barrier/summary.txt create mode 100644 basis/compiler/codegen/summary.txt create mode 100644 basis/compiler/tree/builder/summary.txt create mode 100644 basis/compiler/tree/checker/summary.txt create mode 100644 basis/compiler/tree/cleanup/summary.txt create mode 100644 basis/compiler/tree/combinators/summary.txt create mode 100644 basis/compiler/tree/comparisons/summary.txt create mode 100644 basis/compiler/tree/dead-code/branches/summary.txt create mode 100644 basis/compiler/tree/dead-code/liveness/summary.txt create mode 100644 basis/compiler/tree/dead-code/recursive/summary.txt create mode 100644 basis/compiler/tree/dead-code/simple/summary.txt create mode 100644 basis/compiler/tree/dead-code/summary.txt create mode 100644 basis/compiler/tree/debugger/summary.txt create mode 100644 basis/compiler/tree/def-use/simplified/summary.txt create mode 100644 basis/compiler/tree/escape-analysis/allocations/summary.txt create mode 100644 basis/compiler/tree/escape-analysis/branches/summary.txt create mode 100644 basis/compiler/tree/escape-analysis/check/summary.txt create mode 100644 basis/compiler/tree/escape-analysis/nodes/summary.txt create mode 100644 basis/compiler/tree/escape-analysis/recursive/summary.txt create mode 100644 basis/compiler/tree/escape-analysis/simple/summary.txt create mode 100644 basis/compiler/tree/escape-analysis/summary.txt create mode 100644 basis/compiler/tree/finalization/summary.txt create mode 100644 basis/compiler/tree/identities/summary.txt create mode 100644 basis/compiler/tree/late-optimizations/summary.txt create mode 100644 basis/compiler/tree/modular-arithmetic/summary.txt create mode 100644 basis/compiler/tree/normalization/introductions/summary.txt create mode 100644 basis/compiler/tree/normalization/renaming/summary.txt create mode 100644 basis/compiler/tree/normalization/summary.txt create mode 100644 basis/compiler/tree/optimizer/summary.txt create mode 100644 basis/compiler/tree/propagation/branches/summary.txt create mode 100644 basis/compiler/tree/propagation/constraints/summary.txt create mode 100644 basis/compiler/tree/propagation/copy/summary.txt create mode 100644 basis/compiler/tree/propagation/info/summary.txt create mode 100644 basis/compiler/tree/propagation/inlining/summary.txt create mode 100644 basis/compiler/tree/propagation/known-words/summary.txt create mode 100644 basis/compiler/tree/propagation/nodes/summary.txt create mode 100644 basis/compiler/tree/propagation/recursive/summary.txt create mode 100644 basis/compiler/tree/propagation/simple/summary.txt create mode 100644 basis/compiler/tree/propagation/slots/summary.txt create mode 100644 basis/compiler/tree/recursive/summary.txt create mode 100644 basis/compiler/tree/tuple-unboxing/summary.txt create mode 100644 basis/compiler/utilities/summary.txt create mode 100644 basis/compression/lzw/summary.txt create mode 100644 basis/compression/zlib/ffi/summary.txt create mode 100644 basis/compression/zlib/summary.txt create mode 100644 basis/concurrency/flags/summary.txt create mode 100644 basis/concurrency/mailboxes/summary.txt create mode 100644 basis/constructors/summary.txt create mode 100644 basis/core-foundation/arrays/summary.txt create mode 100644 basis/core-foundation/bundles/summary.txt create mode 100644 basis/core-foundation/data/summary.txt create mode 100644 basis/core-foundation/file-descriptors/summary.txt create mode 100644 basis/core-foundation/fsevents/summary.txt create mode 100644 basis/core-foundation/strings/summary.txt create mode 100644 basis/core-foundation/time/summary.txt create mode 100644 basis/core-foundation/timers/summary.txt create mode 100644 basis/core-foundation/urls/summary.txt create mode 100644 basis/cpu/ppc/linux/summary.txt create mode 100644 basis/cpu/ppc/macosx/summary.txt create mode 100644 basis/cpu/x86/32/summary.txt create mode 100644 basis/cpu/x86/64/unix/summary.txt create mode 100644 basis/cpu/x86/64/winnt/summary.txt create mode 100644 basis/cpu/x86/assembler/summary.txt create mode 100644 basis/cpu/x86/assembler/syntax/summary.txt create mode 100644 basis/db/errors/summary.txt create mode 100644 basis/db/pools/summary.txt create mode 100644 basis/db/postgresql/summary.txt create mode 100644 basis/db/queries/summary.txt create mode 100644 basis/db/sqlite/summary.txt create mode 100644 basis/db/tuples/summary.txt create mode 100644 basis/db/types/summary.txt create mode 100644 basis/delegate/protocols/summary.txt create mode 100644 basis/endian/summary.txt create mode 100644 basis/environment/unix/macosx/summary.txt create mode 100644 basis/environment/unix/summary.txt create mode 100644 basis/environment/winnt/summary.txt create mode 100644 basis/ftp/client/summary.txt create mode 100644 basis/ftp/server/summary.txt create mode 100644 basis/ftp/summary.txt create mode 100644 basis/help/html/summary.txt create mode 100644 basis/html/summary.txt create mode 100644 basis/html/templates/chloe/compiler/summary.txt create mode 100644 basis/http/server/dispatchers/summary.txt create mode 100644 basis/http/server/filters/summary.txt create mode 100644 basis/http/server/redirection/summary.txt create mode 100644 basis/http/server/remapping/summary.txt create mode 100644 basis/http/server/responses/summary.txt create mode 100644 basis/http/server/static/summary.txt create mode 100644 basis/images/bitmap/summary.txt create mode 100644 basis/images/loader/summary.txt create mode 100644 basis/images/summary.txt create mode 100644 basis/images/tiff/summary.txt create mode 100644 basis/interpolate/summary.txt create mode 100644 basis/io/backend/unix/multiplexers/epoll/summary.txt create mode 100644 basis/io/backend/unix/multiplexers/kqueue/summary.txt create mode 100644 basis/io/backend/unix/multiplexers/run-loop/summary.txt create mode 100644 basis/io/backend/unix/multiplexers/select/summary.txt create mode 100644 basis/io/backend/unix/multiplexers/summary.txt create mode 100644 basis/io/directories/search/summary.txt create mode 100644 basis/io/encodings/chinese/summary.txt delete mode 100644 basis/io/encodings/korean/tags.txt delete mode 100644 basis/io/encodings/strict/tags.txt delete mode 100644 basis/io/encodings/string/tags.factor rename basis/io/encodings/{8-bit => string}/tags.txt (100%) delete mode 100644 basis/io/encodings/utf16/tags.txt create mode 100644 basis/io/encodings/utf16n/summary.txt delete mode 100644 basis/io/encodings/utf32/tags.txt create mode 100644 basis/io/files/types/summary.txt create mode 100644 basis/io/files/unique/summary.txt create mode 100644 basis/io/pipes/summary.txt create mode 100644 basis/io/streams/byte-array/summary.txt create mode 100644 basis/io/streams/limited/summary.txt create mode 100644 basis/io/streams/memory/summary.txt create mode 100644 basis/lcs/diff2html/summary.txt create mode 100644 basis/lists/lazy/examples/summary.txt create mode 100644 basis/locals/backend/summary.txt create mode 100644 basis/locals/definitions/summary.txt create mode 100644 basis/locals/errors/summary.txt create mode 100644 basis/locals/fry/summary.txt create mode 100644 basis/locals/macros/summary.txt create mode 100644 basis/locals/parser/summary.txt create mode 100644 basis/locals/prettyprint/summary.txt create mode 100644 basis/locals/rewrite/closures/summary.txt create mode 100644 basis/locals/rewrite/point-free/summary.txt create mode 100644 basis/locals/rewrite/sugar/summary.txt create mode 100644 basis/locals/types/summary.txt create mode 100644 basis/macros/expander/summary.txt create mode 100644 basis/math/partial-dispatch/summary.txt create mode 100644 basis/math/rectangles/positioning/positioning-docs.factor create mode 100644 basis/mime/multipart/summary.txt create mode 100644 basis/mime/types/summary.txt create mode 100644 basis/models/compose/summary.txt create mode 100644 basis/models/delay/summary.txt create mode 100644 basis/models/filter/summary.txt create mode 100644 basis/models/history/summary.txt create mode 100644 basis/models/mapping/summary.txt create mode 100644 basis/models/range/summary.txt create mode 100644 basis/nibble-arrays/summary.txt create mode 100644 basis/openssl/libcrypto/summary.txt create mode 100644 basis/openssl/libssl/summary.txt create mode 100644 basis/pack/summary.txt create mode 100644 basis/peg/parsers/summary.txt rename basis/{io/encodings/ascii => peg/parsers}/tags.txt (100%) create mode 100644 basis/prettyprint/custom/summary.txt create mode 100644 basis/random/dummy/summary.txt create mode 100644 basis/random/unix/summary.txt create mode 100644 basis/random/windows/summary.txt create mode 100644 basis/smtp/server/summary.txt create mode 100644 basis/sorting/slots/summary.txt create mode 100644 basis/specialized-arrays/direct/functor/summary.txt create mode 100644 basis/specialized-arrays/functor/summary.txt create mode 100644 basis/specialized-vectors/functor/summary.txt create mode 100644 basis/stack-checker/alien/summary.txt create mode 100644 basis/stack-checker/branches/summary.txt create mode 100644 basis/stack-checker/inlining/summary.txt create mode 100644 basis/stack-checker/recursive-state/summary.txt create mode 100644 basis/stack-checker/recursive-state/tree/summary.txt create mode 100644 basis/stack-checker/values/summary.txt create mode 100644 basis/stack-checker/visitor/dummy/summary.txt create mode 100644 basis/stack-checker/visitor/summary.txt create mode 100644 basis/tools/deploy/test/11/11-tests.factor create mode 100644 basis/tools/deploy/test/11/11.factor create mode 100644 basis/tools/deploy/test/11/authors.txt create mode 100644 basis/tools/deploy/test/11/deploy.factor create mode 100644 basis/tools/files/summary.txt create mode 100644 basis/tools/scaffold/summary.txt create mode 100644 basis/tools/threads/summary.txt create mode 100644 basis/tools/vocabs/browser/summary.txt create mode 100644 basis/tools/vocabs/summary.txt create mode 100644 basis/ui/gadgets/canvas/summary.txt create mode 100644 basis/ui/tools/deploy/summary.txt create mode 100644 basis/ui/windows/summary.txt create mode 100644 basis/ui/x11/summary.txt create mode 100644 basis/unicode/breaks/summary.txt create mode 100644 basis/unicode/case/summary.txt create mode 100644 basis/unicode/categories/summary.txt create mode 100644 basis/unicode/collation/summary.txt rename basis/{io/encodings/binary => unicode/collation}/tags.txt (100%) create mode 100644 basis/unicode/data/summary.txt create mode 100644 basis/unicode/normalize/summary.txt rename basis/{io/encodings/japanese => unicode/script}/tags.txt (100%) create mode 100644 basis/unicode/syntax/summary.txt create mode 100644 basis/unix/groups/summary.txt create mode 100644 basis/unix/users/summary.txt create mode 100644 basis/unrolled-lists/summary.txt create mode 100644 basis/urls/secure/summary.txt create mode 100644 basis/vlists/summary.txt create mode 100644 basis/wrap/strings/summary.txt create mode 100644 basis/wrap/words/summary.txt create mode 100644 basis/xml/entities/html/summary.txt create mode 100644 basis/xmode/code2html/summary.txt create mode 100644 basis/xmode/marker/summary.txt create mode 100644 core/classes/algebra/summary.txt create mode 100644 core/classes/builtin/summary.txt create mode 100644 core/classes/intersection/summary.txt create mode 100644 core/classes/parser/summary.txt create mode 100644 core/classes/singleton/summary.txt create mode 100644 core/classes/tuple/parser/summary.txt create mode 100644 core/effects/parser/summary.txt create mode 100644 core/generic/parser/summary.txt create mode 100644 core/generic/standard/engines/predicate/summary.txt create mode 100644 core/generic/standard/engines/summary.txt create mode 100644 core/generic/standard/engines/tag/summary.txt create mode 100644 core/generic/standard/engines/tuple/summary.txt delete mode 100644 core/io/encodings/utf8/tags.txt create mode 100644 core/io/streams/null/summary.txt create mode 100644 core/math/order/summary.txt create mode 100644 core/strings/parser/summary.txt create mode 100644 core/vocabs/parser/summary.txt create mode 100644 core/words/constant/summary.txt create mode 100644 core/words/symbol/summary.txt diff --git a/basis/alien/complex/functor/summary.txt b/basis/alien/complex/functor/summary.txt new file mode 100644 index 0000000000..17454036c5 --- /dev/null +++ b/basis/alien/complex/functor/summary.txt @@ -0,0 +1 @@ +Code generation for C99 complex number support diff --git a/basis/alien/parser/summary.txt b/basis/alien/parser/summary.txt new file mode 100644 index 0000000000..4290040372 --- /dev/null +++ b/basis/alien/parser/summary.txt @@ -0,0 +1 @@ +Utilities used in implementation of alien parsing words diff --git a/basis/alien/prettyprint/summary.txt b/basis/alien/prettyprint/summary.txt new file mode 100644 index 0000000000..06fcfd0078 --- /dev/null +++ b/basis/alien/prettyprint/summary.txt @@ -0,0 +1 @@ +Prettyprinting aliens and DLLs diff --git a/basis/alien/strings/summary.txt b/basis/alien/strings/summary.txt new file mode 100644 index 0000000000..8ea3806523 --- /dev/null +++ b/basis/alien/strings/summary.txt @@ -0,0 +1 @@ +Passing Factor strings as C strings and vice versa diff --git a/basis/alien/strings/unix/summary.txt b/basis/alien/strings/unix/summary.txt new file mode 100644 index 0000000000..27e7f4cfb1 --- /dev/null +++ b/basis/alien/strings/unix/summary.txt @@ -0,0 +1 @@ +Default string encoding on Unix diff --git a/basis/alien/strings/windows/summary.txt b/basis/alien/strings/windows/summary.txt new file mode 100644 index 0000000000..42bffbb300 --- /dev/null +++ b/basis/alien/strings/windows/summary.txt @@ -0,0 +1 @@ +Default string encoding on Windows diff --git a/basis/alien/structs/fields/summary.txt b/basis/alien/structs/fields/summary.txt new file mode 100644 index 0000000000..d9370ca575 --- /dev/null +++ b/basis/alien/structs/fields/summary.txt @@ -0,0 +1 @@ +Struct field implementation and reflection support diff --git a/basis/assoc-heaps/summary.txt b/basis/assoc-heaps/summary.txt new file mode 100644 index 0000000000..792be0a9ec --- /dev/null +++ b/basis/assoc-heaps/summary.txt @@ -0,0 +1 @@ +Priority queue with fast insertion, removal of first element, and lookup of arbitrary elements by key diff --git a/basis/bitstreams/summary.txt b/basis/bitstreams/summary.txt new file mode 100644 index 0000000000..32b21d6e73 --- /dev/null +++ b/basis/bitstreams/summary.txt @@ -0,0 +1 @@ +Reading sequences of bits from a byte stream diff --git a/basis/bootstrap/help/help.factor b/basis/bootstrap/help/help.factor index bd994a160d..c3e74f7863 100644 --- a/basis/bootstrap/help/help.factor +++ b/basis/bootstrap/help/help.factor @@ -5,6 +5,7 @@ IN: bootstrap.help : load-help ( -- ) "help.lint" require + "tools.vocabs.browser" require "alien.syntax" require "compiler" require diff --git a/basis/cairo/ffi/summary.txt b/basis/cairo/ffi/summary.txt new file mode 100644 index 0000000000..7fe88a8026 --- /dev/null +++ b/basis/cairo/ffi/summary.txt @@ -0,0 +1 @@ +Low-level alien interface to Cairo library diff --git a/basis/cairo/gadgets/summary.txt b/basis/cairo/gadgets/summary.txt new file mode 100644 index 0000000000..18dc464b16 --- /dev/null +++ b/basis/cairo/gadgets/summary.txt @@ -0,0 +1 @@ +UI gadget for rendering graphics with Cairo diff --git a/basis/calendar/format/macros/summary.txt b/basis/calendar/format/macros/summary.txt new file mode 100644 index 0000000000..92c347a875 --- /dev/null +++ b/basis/calendar/format/macros/summary.txt @@ -0,0 +1 @@ +Implementation details for calendar.format diff --git a/basis/calendar/unix/summary.txt b/basis/calendar/unix/summary.txt new file mode 100644 index 0000000000..b57628b637 --- /dev/null +++ b/basis/calendar/unix/summary.txt @@ -0,0 +1 @@ +Unix-specific timezone support and C library time data types diff --git a/basis/calendar/windows/summary.txt b/basis/calendar/windows/summary.txt new file mode 100644 index 0000000000..1fdbc43acb --- /dev/null +++ b/basis/calendar/windows/summary.txt @@ -0,0 +1 @@ +Windows-specific timezone support diff --git a/basis/call/summary.txt b/basis/call/summary.txt new file mode 100644 index 0000000000..d449497971 --- /dev/null +++ b/basis/call/summary.txt @@ -0,0 +1 @@ +Calling arbitrary quotations and executing arbitrary words with a static stack effect diff --git a/basis/checksums/adler-32/summary.txt b/basis/checksums/adler-32/summary.txt new file mode 100644 index 0000000000..86ce15b536 --- /dev/null +++ b/basis/checksums/adler-32/summary.txt @@ -0,0 +1 @@ +Adler-32 checksum algorithm diff --git a/basis/checksums/md5/summary.txt b/basis/checksums/md5/summary.txt new file mode 100644 index 0000000000..fae2ff8a1c --- /dev/null +++ b/basis/checksums/md5/summary.txt @@ -0,0 +1 @@ +MD5 checksum algorithm diff --git a/basis/checksums/null/summary.txt b/basis/checksums/null/summary.txt new file mode 100644 index 0000000000..2d4eedd2fc --- /dev/null +++ b/basis/checksums/null/summary.txt @@ -0,0 +1 @@ +Dummy checksum algorithm diff --git a/basis/checksums/openssl/summary.txt b/basis/checksums/openssl/summary.txt new file mode 100644 index 0000000000..e13a387197 --- /dev/null +++ b/basis/checksums/openssl/summary.txt @@ -0,0 +1 @@ +OpenSSL's MD5 and SHA1 checksums diff --git a/basis/checksums/sha1/summary.txt b/basis/checksums/sha1/summary.txt new file mode 100644 index 0000000000..d8da1df0aa --- /dev/null +++ b/basis/checksums/sha1/summary.txt @@ -0,0 +1 @@ +SHA1 checksum algorithm diff --git a/basis/checksums/sha2/summary.txt b/basis/checksums/sha2/summary.txt new file mode 100644 index 0000000000..04365d439f --- /dev/null +++ b/basis/checksums/sha2/summary.txt @@ -0,0 +1 @@ +SHA2 checksum algorithm diff --git a/basis/checksums/stream/summary.txt b/basis/checksums/stream/summary.txt new file mode 100644 index 0000000000..12fcb8cb2f --- /dev/null +++ b/basis/checksums/stream/summary.txt @@ -0,0 +1 @@ +Computing checksums of streaming data diff --git a/basis/cocoa/enumeration/summary.txt b/basis/cocoa/enumeration/summary.txt new file mode 100644 index 0000000000..ce593b730f --- /dev/null +++ b/basis/cocoa/enumeration/summary.txt @@ -0,0 +1 @@ +Support for iterating over NSFastEnumerations diff --git a/basis/cocoa/plists/summary.txt b/basis/cocoa/plists/summary.txt new file mode 100644 index 0000000000..155307fbc3 --- /dev/null +++ b/basis/cocoa/plists/summary.txt @@ -0,0 +1 @@ +Reading and writing Cocoa property lists diff --git a/basis/colors/gray/summary.txt b/basis/colors/gray/summary.txt new file mode 100644 index 0000000000..55db158c19 --- /dev/null +++ b/basis/colors/gray/summary.txt @@ -0,0 +1 @@ +Grayscale colors diff --git a/basis/colors/hsv/summary.txt b/basis/colors/hsv/summary.txt new file mode 100644 index 0000000000..bb946f0282 --- /dev/null +++ b/basis/colors/hsv/summary.txt @@ -0,0 +1 @@ +Hue-saturation-value colors diff --git a/basis/combinators/short-circuit/smart/summary.txt b/basis/combinators/short-circuit/smart/summary.txt new file mode 100644 index 0000000000..7779f91802 --- /dev/null +++ b/basis/combinators/short-circuit/smart/summary.txt @@ -0,0 +1 @@ +Short-circuiting logical operations which infer the arity diff --git a/basis/combinators/short-circuit/summary.txt b/basis/combinators/short-circuit/summary.txt new file mode 100644 index 0000000000..4b930db94c --- /dev/null +++ b/basis/combinators/short-circuit/summary.txt @@ -0,0 +1 @@ +Short-circuiting logical operations diff --git a/basis/combinators/smart/summary.txt b/basis/combinators/smart/summary.txt new file mode 100644 index 0000000000..10475cc5b2 --- /dev/null +++ b/basis/combinators/smart/summary.txt @@ -0,0 +1 @@ +Combinators which infer arities diff --git a/basis/compiler/alien/summary.txt b/basis/compiler/alien/summary.txt new file mode 100644 index 0000000000..5fc715b478 --- /dev/null +++ b/basis/compiler/alien/summary.txt @@ -0,0 +1 @@ +Common code used for analysis and code generation of alien bindings diff --git a/basis/compiler/cfg/alias-analysis/summary.txt b/basis/compiler/cfg/alias-analysis/summary.txt new file mode 100644 index 0000000000..c7e7c030bc --- /dev/null +++ b/basis/compiler/cfg/alias-analysis/summary.txt @@ -0,0 +1 @@ +Alias analysis for stack operations, array elements and tuple slots diff --git a/basis/compiler/cfg/copy-prop/summary.txt b/basis/compiler/cfg/copy-prop/summary.txt new file mode 100644 index 0000000000..4273830158 --- /dev/null +++ b/basis/compiler/cfg/copy-prop/summary.txt @@ -0,0 +1 @@ +Common code used by several passes to perform copy propagation diff --git a/basis/compiler/cfg/dead-code/summary.txt b/basis/compiler/cfg/dead-code/summary.txt new file mode 100644 index 0000000000..c66cd99606 --- /dev/null +++ b/basis/compiler/cfg/dead-code/summary.txt @@ -0,0 +1 @@ +Dead-code elimination diff --git a/basis/compiler/cfg/debugger/summary.txt b/basis/compiler/cfg/debugger/summary.txt new file mode 100644 index 0000000000..43e4191880 --- /dev/null +++ b/basis/compiler/cfg/debugger/summary.txt @@ -0,0 +1 @@ +Tools for debugging low-level optimizer diff --git a/basis/compiler/cfg/def-use/summary.txt b/basis/compiler/cfg/def-use/summary.txt new file mode 100644 index 0000000000..e28231e1bc --- /dev/null +++ b/basis/compiler/cfg/def-use/summary.txt @@ -0,0 +1 @@ +Common code used by several passes for def-use analysis diff --git a/basis/compiler/cfg/hats/summary.txt b/basis/compiler/cfg/hats/summary.txt new file mode 100644 index 0000000000..d0ef839c6b --- /dev/null +++ b/basis/compiler/cfg/hats/summary.txt @@ -0,0 +1 @@ +Utility for constructing basic blocks diff --git a/basis/compiler/cfg/height/summary.txt b/basis/compiler/cfg/height/summary.txt new file mode 100644 index 0000000000..ce1974ad60 --- /dev/null +++ b/basis/compiler/cfg/height/summary.txt @@ -0,0 +1 @@ +Stack height normalization coalesces height changes at start of basic block diff --git a/basis/compiler/cfg/instructions/summary.txt b/basis/compiler/cfg/instructions/summary.txt new file mode 100644 index 0000000000..803d6e3391 --- /dev/null +++ b/basis/compiler/cfg/instructions/summary.txt @@ -0,0 +1 @@ +Basic block instructions diff --git a/basis/compiler/cfg/instructions/syntax/summary.txt b/basis/compiler/cfg/instructions/syntax/summary.txt new file mode 100644 index 0000000000..944c38e972 --- /dev/null +++ b/basis/compiler/cfg/instructions/syntax/summary.txt @@ -0,0 +1 @@ +Parsing word for defining instructions diff --git a/basis/compiler/cfg/intrinsics/alien/summary.txt b/basis/compiler/cfg/intrinsics/alien/summary.txt new file mode 100644 index 0000000000..682acebb81 --- /dev/null +++ b/basis/compiler/cfg/intrinsics/alien/summary.txt @@ -0,0 +1 @@ +Generating instructions for alien calls diff --git a/basis/compiler/cfg/intrinsics/allot/summary.txt b/basis/compiler/cfg/intrinsics/allot/summary.txt new file mode 100644 index 0000000000..dc335f3ab3 --- /dev/null +++ b/basis/compiler/cfg/intrinsics/allot/summary.txt @@ -0,0 +1 @@ +Generating instructions for inline memory allocation diff --git a/basis/compiler/cfg/intrinsics/fixnum/summary.txt b/basis/compiler/cfg/intrinsics/fixnum/summary.txt new file mode 100644 index 0000000000..648573bbe2 --- /dev/null +++ b/basis/compiler/cfg/intrinsics/fixnum/summary.txt @@ -0,0 +1 @@ +Generating instructions for fixnum arithmetic diff --git a/basis/compiler/cfg/intrinsics/float/summary.txt b/basis/compiler/cfg/intrinsics/float/summary.txt new file mode 100644 index 0000000000..3da4a1346d --- /dev/null +++ b/basis/compiler/cfg/intrinsics/float/summary.txt @@ -0,0 +1 @@ +Generating instructions for floating point arithmetic diff --git a/basis/compiler/cfg/intrinsics/misc/summary.txt b/basis/compiler/cfg/intrinsics/misc/summary.txt new file mode 100644 index 0000000000..295a34b049 --- /dev/null +++ b/basis/compiler/cfg/intrinsics/misc/summary.txt @@ -0,0 +1 @@ +Generating instructions for miscellaneous primitives diff --git a/basis/compiler/cfg/intrinsics/slots/summary.txt b/basis/compiler/cfg/intrinsics/slots/summary.txt new file mode 100644 index 0000000000..fd3c17071b --- /dev/null +++ b/basis/compiler/cfg/intrinsics/slots/summary.txt @@ -0,0 +1 @@ +Generating instructions for slot access diff --git a/basis/compiler/cfg/intrinsics/summary.txt b/basis/compiler/cfg/intrinsics/summary.txt new file mode 100644 index 0000000000..511091c400 --- /dev/null +++ b/basis/compiler/cfg/intrinsics/summary.txt @@ -0,0 +1 @@ +Generating instructions from certain primitives diff --git a/basis/compiler/cfg/iterator/summary.txt b/basis/compiler/cfg/iterator/summary.txt new file mode 100644 index 0000000000..b5afb479bd --- /dev/null +++ b/basis/compiler/cfg/iterator/summary.txt @@ -0,0 +1 @@ +Utility for iterating for high-level IR diff --git a/basis/compiler/cfg/linear-scan/allocation/summary.txt b/basis/compiler/cfg/linear-scan/allocation/summary.txt new file mode 100644 index 0000000000..bb0290feb6 --- /dev/null +++ b/basis/compiler/cfg/linear-scan/allocation/summary.txt @@ -0,0 +1 @@ +Allocating registers for live intervals diff --git a/basis/compiler/cfg/linear-scan/assignment/summary.txt b/basis/compiler/cfg/linear-scan/assignment/summary.txt new file mode 100644 index 0000000000..9f6b1b8ff5 --- /dev/null +++ b/basis/compiler/cfg/linear-scan/assignment/summary.txt @@ -0,0 +1 @@ +Assigning registers to live intervals diff --git a/basis/compiler/cfg/linear-scan/debugger/summary.txt b/basis/compiler/cfg/linear-scan/debugger/summary.txt new file mode 100644 index 0000000000..73f2210478 --- /dev/null +++ b/basis/compiler/cfg/linear-scan/debugger/summary.txt @@ -0,0 +1 @@ +Tools for debugging register allocator diff --git a/basis/compiler/cfg/linear-scan/live-intervals/summary.txt b/basis/compiler/cfg/linear-scan/live-intervals/summary.txt new file mode 100644 index 0000000000..e12e4c37e3 --- /dev/null +++ b/basis/compiler/cfg/linear-scan/live-intervals/summary.txt @@ -0,0 +1 @@ +Live intervals diff --git a/basis/compiler/cfg/linear-scan/summary.txt b/basis/compiler/cfg/linear-scan/summary.txt new file mode 100644 index 0000000000..51858c8ada --- /dev/null +++ b/basis/compiler/cfg/linear-scan/summary.txt @@ -0,0 +1 @@ +Linear-scan register allocation diff --git a/basis/compiler/cfg/linearization/summary.txt b/basis/compiler/cfg/linearization/summary.txt new file mode 100644 index 0000000000..96daec8046 --- /dev/null +++ b/basis/compiler/cfg/linearization/summary.txt @@ -0,0 +1 @@ +Flattening CFG into MR (machine representation) diff --git a/basis/compiler/cfg/optimizer/summary.txt b/basis/compiler/cfg/optimizer/summary.txt new file mode 100644 index 0000000000..d6b0ad899a --- /dev/null +++ b/basis/compiler/cfg/optimizer/summary.txt @@ -0,0 +1 @@ +Top-level harness for CFG optimization diff --git a/basis/compiler/cfg/predecessors/summary.txt b/basis/compiler/cfg/predecessors/summary.txt new file mode 100644 index 0000000000..89e9a9026e --- /dev/null +++ b/basis/compiler/cfg/predecessors/summary.txt @@ -0,0 +1 @@ +Computing predecessors of basic blocks in CFG diff --git a/basis/compiler/cfg/registers/summary.txt b/basis/compiler/cfg/registers/summary.txt new file mode 100644 index 0000000000..5258598ab6 --- /dev/null +++ b/basis/compiler/cfg/registers/summary.txt @@ -0,0 +1 @@ +Virtual single-assignment registers diff --git a/basis/compiler/cfg/rpo/summary.txt b/basis/compiler/cfg/rpo/summary.txt new file mode 100644 index 0000000000..bcb03ef9d9 --- /dev/null +++ b/basis/compiler/cfg/rpo/summary.txt @@ -0,0 +1 @@ +Reverse post-order linearization of CFG diff --git a/basis/compiler/cfg/stack-frame/summary.txt b/basis/compiler/cfg/stack-frame/summary.txt new file mode 100644 index 0000000000..1ad913a1d3 --- /dev/null +++ b/basis/compiler/cfg/stack-frame/summary.txt @@ -0,0 +1 @@ +Computing stack frame size and layout diff --git a/basis/compiler/cfg/stacks/summary.txt b/basis/compiler/cfg/stacks/summary.txt new file mode 100644 index 0000000000..63da52fc21 --- /dev/null +++ b/basis/compiler/cfg/stacks/summary.txt @@ -0,0 +1 @@ +Generating instructions for accessing the data and retain stacks diff --git a/basis/compiler/cfg/summary.txt b/basis/compiler/cfg/summary.txt new file mode 100644 index 0000000000..8cbb6a5951 --- /dev/null +++ b/basis/compiler/cfg/summary.txt @@ -0,0 +1 @@ +Low-level control flow graph IR diff --git a/basis/compiler/cfg/two-operand/summary.txt b/basis/compiler/cfg/two-operand/summary.txt new file mode 100644 index 0000000000..6c9154d306 --- /dev/null +++ b/basis/compiler/cfg/two-operand/summary.txt @@ -0,0 +1 @@ +Converting three-operand instructions into two-operand form diff --git a/basis/compiler/cfg/useless-blocks/summary.txt b/basis/compiler/cfg/useless-blocks/summary.txt new file mode 100644 index 0000000000..616fae71c2 --- /dev/null +++ b/basis/compiler/cfg/useless-blocks/summary.txt @@ -0,0 +1 @@ +Eliminating unreachable basic blocks and unconditional jumps diff --git a/basis/compiler/cfg/utilities/summary.txt b/basis/compiler/cfg/utilities/summary.txt new file mode 100644 index 0000000000..7bb20b1609 --- /dev/null +++ b/basis/compiler/cfg/utilities/summary.txt @@ -0,0 +1 @@ +Utility words used by CFG optimization diff --git a/basis/compiler/cfg/value-numbering/expressions/summary.txt b/basis/compiler/cfg/value-numbering/expressions/summary.txt new file mode 100644 index 0000000000..22aacde2f4 --- /dev/null +++ b/basis/compiler/cfg/value-numbering/expressions/summary.txt @@ -0,0 +1 @@ +Value numbering expressions diff --git a/basis/compiler/cfg/value-numbering/graph/summary.txt b/basis/compiler/cfg/value-numbering/graph/summary.txt new file mode 100644 index 0000000000..f6fb58d0dc --- /dev/null +++ b/basis/compiler/cfg/value-numbering/graph/summary.txt @@ -0,0 +1 @@ +Value numbering expression graph diff --git a/basis/compiler/cfg/value-numbering/propagate/summary.txt b/basis/compiler/cfg/value-numbering/propagate/summary.txt new file mode 100644 index 0000000000..fd56a8e099 --- /dev/null +++ b/basis/compiler/cfg/value-numbering/propagate/summary.txt @@ -0,0 +1 @@ +Propagation pass to update code after value numbering diff --git a/basis/compiler/cfg/value-numbering/rewrite/summary.txt b/basis/compiler/cfg/value-numbering/rewrite/summary.txt new file mode 100644 index 0000000000..8b13789179 --- /dev/null +++ b/basis/compiler/cfg/value-numbering/rewrite/summary.txt @@ -0,0 +1 @@ + diff --git a/basis/compiler/cfg/value-numbering/simplify/summary.txt b/basis/compiler/cfg/value-numbering/simplify/summary.txt new file mode 100644 index 0000000000..1027c83ce4 --- /dev/null +++ b/basis/compiler/cfg/value-numbering/simplify/summary.txt @@ -0,0 +1 @@ +Algebraic simplification of expressions diff --git a/basis/compiler/cfg/value-numbering/summary.txt b/basis/compiler/cfg/value-numbering/summary.txt new file mode 100644 index 0000000000..8d48ebe2d2 --- /dev/null +++ b/basis/compiler/cfg/value-numbering/summary.txt @@ -0,0 +1 @@ +Local value numbering for common subexpression elimination diff --git a/basis/compiler/cfg/write-barrier/summary.txt b/basis/compiler/cfg/write-barrier/summary.txt new file mode 100644 index 0000000000..453cda66f4 --- /dev/null +++ b/basis/compiler/cfg/write-barrier/summary.txt @@ -0,0 +1 @@ +Write barrier elimination diff --git a/basis/compiler/codegen/summary.txt b/basis/compiler/codegen/summary.txt new file mode 100644 index 0000000000..7a6e01c0c6 --- /dev/null +++ b/basis/compiler/codegen/summary.txt @@ -0,0 +1 @@ +Code generation from MR (machine representation) diff --git a/basis/compiler/tree/builder/summary.txt b/basis/compiler/tree/builder/summary.txt new file mode 100644 index 0000000000..de3a6f981f --- /dev/null +++ b/basis/compiler/tree/builder/summary.txt @@ -0,0 +1 @@ +Constructing high-level tree IR diff --git a/basis/compiler/tree/checker/summary.txt b/basis/compiler/tree/checker/summary.txt new file mode 100644 index 0000000000..257abfef83 --- /dev/null +++ b/basis/compiler/tree/checker/summary.txt @@ -0,0 +1 @@ +Debugging tool for checking various invariants of tree IR diff --git a/basis/compiler/tree/cleanup/summary.txt b/basis/compiler/tree/cleanup/summary.txt new file mode 100644 index 0000000000..de7b8e32a6 --- /dev/null +++ b/basis/compiler/tree/cleanup/summary.txt @@ -0,0 +1 @@ +Finalizing speculative inlining and constant folding from propagation pass diff --git a/basis/compiler/tree/combinators/summary.txt b/basis/compiler/tree/combinators/summary.txt new file mode 100644 index 0000000000..8e9114ecf4 --- /dev/null +++ b/basis/compiler/tree/combinators/summary.txt @@ -0,0 +1 @@ +Combinators for iterating over tree IR diff --git a/basis/compiler/tree/comparisons/summary.txt b/basis/compiler/tree/comparisons/summary.txt new file mode 100644 index 0000000000..9d92ac4616 --- /dev/null +++ b/basis/compiler/tree/comparisons/summary.txt @@ -0,0 +1 @@ +Utilities for working with binary comparison operations diff --git a/basis/compiler/tree/dead-code/branches/summary.txt b/basis/compiler/tree/dead-code/branches/summary.txt new file mode 100644 index 0000000000..f635191c9a --- /dev/null +++ b/basis/compiler/tree/dead-code/branches/summary.txt @@ -0,0 +1 @@ +Dead branch elimination diff --git a/basis/compiler/tree/dead-code/liveness/summary.txt b/basis/compiler/tree/dead-code/liveness/summary.txt new file mode 100644 index 0000000000..f18a3304b0 --- /dev/null +++ b/basis/compiler/tree/dead-code/liveness/summary.txt @@ -0,0 +1 @@ +Liveness analysis diff --git a/basis/compiler/tree/dead-code/recursive/summary.txt b/basis/compiler/tree/dead-code/recursive/summary.txt new file mode 100644 index 0000000000..3d51eaf5a6 --- /dev/null +++ b/basis/compiler/tree/dead-code/recursive/summary.txt @@ -0,0 +1 @@ +Dead code elimination for inline recursive combinators diff --git a/basis/compiler/tree/dead-code/simple/summary.txt b/basis/compiler/tree/dead-code/simple/summary.txt new file mode 100644 index 0000000000..8f8f091d1a --- /dev/null +++ b/basis/compiler/tree/dead-code/simple/summary.txt @@ -0,0 +1 @@ +Dead code elimination for straight-line code diff --git a/basis/compiler/tree/dead-code/summary.txt b/basis/compiler/tree/dead-code/summary.txt new file mode 100644 index 0000000000..82b391c2bf --- /dev/null +++ b/basis/compiler/tree/dead-code/summary.txt @@ -0,0 +1 @@ +Dead code elimination diff --git a/basis/compiler/tree/debugger/summary.txt b/basis/compiler/tree/debugger/summary.txt new file mode 100644 index 0000000000..c91394ddcf --- /dev/null +++ b/basis/compiler/tree/debugger/summary.txt @@ -0,0 +1 @@ +Tools for debugging high-level optimizer diff --git a/basis/compiler/tree/def-use/simplified/summary.txt b/basis/compiler/tree/def-use/simplified/summary.txt new file mode 100644 index 0000000000..f87e851dba --- /dev/null +++ b/basis/compiler/tree/def-use/simplified/summary.txt @@ -0,0 +1 @@ +Variant form of def-use chains used by modular arithmetic optimization diff --git a/basis/compiler/tree/escape-analysis/allocations/summary.txt b/basis/compiler/tree/escape-analysis/allocations/summary.txt new file mode 100644 index 0000000000..422a8a49aa --- /dev/null +++ b/basis/compiler/tree/escape-analysis/allocations/summary.txt @@ -0,0 +1 @@ +Tracking memory allocations diff --git a/basis/compiler/tree/escape-analysis/branches/summary.txt b/basis/compiler/tree/escape-analysis/branches/summary.txt new file mode 100644 index 0000000000..592797bf4d --- /dev/null +++ b/basis/compiler/tree/escape-analysis/branches/summary.txt @@ -0,0 +1 @@ +Escape analysis for conditionals diff --git a/basis/compiler/tree/escape-analysis/check/summary.txt b/basis/compiler/tree/escape-analysis/check/summary.txt new file mode 100644 index 0000000000..fe000ceb9c --- /dev/null +++ b/basis/compiler/tree/escape-analysis/check/summary.txt @@ -0,0 +1 @@ +Skipping escape analysis pass for code which does not allocate diff --git a/basis/compiler/tree/escape-analysis/nodes/summary.txt b/basis/compiler/tree/escape-analysis/nodes/summary.txt new file mode 100644 index 0000000000..f2febaf020 --- /dev/null +++ b/basis/compiler/tree/escape-analysis/nodes/summary.txt @@ -0,0 +1 @@ +Per-node dispatch for escape analysis diff --git a/basis/compiler/tree/escape-analysis/recursive/summary.txt b/basis/compiler/tree/escape-analysis/recursive/summary.txt new file mode 100644 index 0000000000..e412f5de64 --- /dev/null +++ b/basis/compiler/tree/escape-analysis/recursive/summary.txt @@ -0,0 +1 @@ +Escape analysis for inline recursive combinators diff --git a/basis/compiler/tree/escape-analysis/simple/summary.txt b/basis/compiler/tree/escape-analysis/simple/summary.txt new file mode 100644 index 0000000000..8035abc38c --- /dev/null +++ b/basis/compiler/tree/escape-analysis/simple/summary.txt @@ -0,0 +1 @@ +Escape analysis for straight-line code diff --git a/basis/compiler/tree/escape-analysis/summary.txt b/basis/compiler/tree/escape-analysis/summary.txt new file mode 100644 index 0000000000..dba0e47015 --- /dev/null +++ b/basis/compiler/tree/escape-analysis/summary.txt @@ -0,0 +1 @@ +Escape analysis for tuple unboxing diff --git a/basis/compiler/tree/finalization/summary.txt b/basis/compiler/tree/finalization/summary.txt new file mode 100644 index 0000000000..8967945bc1 --- /dev/null +++ b/basis/compiler/tree/finalization/summary.txt @@ -0,0 +1 @@ +Final pass cleans up high-level IR diff --git a/basis/compiler/tree/identities/summary.txt b/basis/compiler/tree/identities/summary.txt new file mode 100644 index 0000000000..67c9f9f82a --- /dev/null +++ b/basis/compiler/tree/identities/summary.txt @@ -0,0 +1 @@ +Applying arithmetic identities to integer code diff --git a/basis/compiler/tree/late-optimizations/summary.txt b/basis/compiler/tree/late-optimizations/summary.txt new file mode 100644 index 0000000000..9d3e2dbc1a --- /dev/null +++ b/basis/compiler/tree/late-optimizations/summary.txt @@ -0,0 +1 @@ +Utilities used by several optimization passes run in the later stages diff --git a/basis/compiler/tree/modular-arithmetic/summary.txt b/basis/compiler/tree/modular-arithmetic/summary.txt new file mode 100644 index 0000000000..88ecbe16a6 --- /dev/null +++ b/basis/compiler/tree/modular-arithmetic/summary.txt @@ -0,0 +1 @@ +Modular arithmetic optimization diff --git a/basis/compiler/tree/normalization/introductions/summary.txt b/basis/compiler/tree/normalization/introductions/summary.txt new file mode 100644 index 0000000000..baee9c818a --- /dev/null +++ b/basis/compiler/tree/normalization/introductions/summary.txt @@ -0,0 +1 @@ +Coalesce value introduction nodes to beginning of each tree leaf diff --git a/basis/compiler/tree/normalization/renaming/summary.txt b/basis/compiler/tree/normalization/renaming/summary.txt new file mode 100644 index 0000000000..0fc4f5968f --- /dev/null +++ b/basis/compiler/tree/normalization/renaming/summary.txt @@ -0,0 +1 @@ +Support for renaming values diff --git a/basis/compiler/tree/normalization/summary.txt b/basis/compiler/tree/normalization/summary.txt new file mode 100644 index 0000000000..9bb06734a1 --- /dev/null +++ b/basis/compiler/tree/normalization/summary.txt @@ -0,0 +1 @@ +Normalize IR created by high level IR builder to simplify subsequent passes diff --git a/basis/compiler/tree/optimizer/summary.txt b/basis/compiler/tree/optimizer/summary.txt new file mode 100644 index 0000000000..f00b60f8d8 --- /dev/null +++ b/basis/compiler/tree/optimizer/summary.txt @@ -0,0 +1 @@ +Top-level harness for high-level optimizer diff --git a/basis/compiler/tree/propagation/branches/summary.txt b/basis/compiler/tree/propagation/branches/summary.txt new file mode 100644 index 0000000000..c4dc6758e7 --- /dev/null +++ b/basis/compiler/tree/propagation/branches/summary.txt @@ -0,0 +1 @@ +Sparse propagation for branches diff --git a/basis/compiler/tree/propagation/constraints/summary.txt b/basis/compiler/tree/propagation/constraints/summary.txt new file mode 100644 index 0000000000..186b5c036b --- /dev/null +++ b/basis/compiler/tree/propagation/constraints/summary.txt @@ -0,0 +1 @@ +Support for predicated value info diff --git a/basis/compiler/tree/propagation/copy/summary.txt b/basis/compiler/tree/propagation/copy/summary.txt new file mode 100644 index 0000000000..2deae090c9 --- /dev/null +++ b/basis/compiler/tree/propagation/copy/summary.txt @@ -0,0 +1 @@ +Copy propagation diff --git a/basis/compiler/tree/propagation/info/summary.txt b/basis/compiler/tree/propagation/info/summary.txt new file mode 100644 index 0000000000..26faa340d5 --- /dev/null +++ b/basis/compiler/tree/propagation/info/summary.txt @@ -0,0 +1 @@ +Value info data type and operations diff --git a/basis/compiler/tree/propagation/inlining/summary.txt b/basis/compiler/tree/propagation/inlining/summary.txt new file mode 100644 index 0000000000..e4fc7152cd --- /dev/null +++ b/basis/compiler/tree/propagation/inlining/summary.txt @@ -0,0 +1 @@ +Method inlining and dispatch elimination diff --git a/basis/compiler/tree/propagation/known-words/summary.txt b/basis/compiler/tree/propagation/known-words/summary.txt new file mode 100644 index 0000000000..b53506f80d --- /dev/null +++ b/basis/compiler/tree/propagation/known-words/summary.txt @@ -0,0 +1 @@ +Propagation rules for certain known words diff --git a/basis/compiler/tree/propagation/nodes/summary.txt b/basis/compiler/tree/propagation/nodes/summary.txt new file mode 100644 index 0000000000..c4fcd37c59 --- /dev/null +++ b/basis/compiler/tree/propagation/nodes/summary.txt @@ -0,0 +1 @@ +Node dispatch for propagation pass diff --git a/basis/compiler/tree/propagation/recursive/summary.txt b/basis/compiler/tree/propagation/recursive/summary.txt new file mode 100644 index 0000000000..b0c844c747 --- /dev/null +++ b/basis/compiler/tree/propagation/recursive/summary.txt @@ -0,0 +1 @@ +Propagation for inline recursive combinators diff --git a/basis/compiler/tree/propagation/simple/summary.txt b/basis/compiler/tree/propagation/simple/summary.txt new file mode 100644 index 0000000000..25e631f1cc --- /dev/null +++ b/basis/compiler/tree/propagation/simple/summary.txt @@ -0,0 +1 @@ +Propagation for straight-line code diff --git a/basis/compiler/tree/propagation/slots/summary.txt b/basis/compiler/tree/propagation/slots/summary.txt new file mode 100644 index 0000000000..b47a4b5006 --- /dev/null +++ b/basis/compiler/tree/propagation/slots/summary.txt @@ -0,0 +1 @@ +Propagation for read-only tuple slots and array lengths diff --git a/basis/compiler/tree/recursive/summary.txt b/basis/compiler/tree/recursive/summary.txt new file mode 100644 index 0000000000..202a3d1262 --- /dev/null +++ b/basis/compiler/tree/recursive/summary.txt @@ -0,0 +1 @@ +Analysis of inline recursive combinators and loop detection diff --git a/basis/compiler/tree/tuple-unboxing/summary.txt b/basis/compiler/tree/tuple-unboxing/summary.txt new file mode 100644 index 0000000000..3f13c95637 --- /dev/null +++ b/basis/compiler/tree/tuple-unboxing/summary.txt @@ -0,0 +1 @@ +Tuple unboxing diff --git a/basis/compiler/utilities/summary.txt b/basis/compiler/utilities/summary.txt new file mode 100644 index 0000000000..be0857c646 --- /dev/null +++ b/basis/compiler/utilities/summary.txt @@ -0,0 +1 @@ +Utilities used by high-level IR optimizations diff --git a/basis/compression/lzw/summary.txt b/basis/compression/lzw/summary.txt new file mode 100644 index 0000000000..bbc8c67be9 --- /dev/null +++ b/basis/compression/lzw/summary.txt @@ -0,0 +1 @@ +LZW compression and decompression diff --git a/basis/compression/zlib/ffi/summary.txt b/basis/compression/zlib/ffi/summary.txt new file mode 100644 index 0000000000..0047076a95 --- /dev/null +++ b/basis/compression/zlib/ffi/summary.txt @@ -0,0 +1 @@ +Low-level FFI bindings to ZLIB compression library diff --git a/basis/compression/zlib/summary.txt b/basis/compression/zlib/summary.txt new file mode 100644 index 0000000000..e7caf47c49 --- /dev/null +++ b/basis/compression/zlib/summary.txt @@ -0,0 +1 @@ +Wrapper ZLIB compression library diff --git a/basis/concurrency/flags/summary.txt b/basis/concurrency/flags/summary.txt new file mode 100644 index 0000000000..f8981c85ed --- /dev/null +++ b/basis/concurrency/flags/summary.txt @@ -0,0 +1 @@ +Flags for cross-thread notification of conditions diff --git a/basis/concurrency/mailboxes/summary.txt b/basis/concurrency/mailboxes/summary.txt new file mode 100644 index 0000000000..2a228ebc82 --- /dev/null +++ b/basis/concurrency/mailboxes/summary.txt @@ -0,0 +1 @@ +Mailboxes for inter-thread message passing diff --git a/basis/constructors/summary.txt b/basis/constructors/summary.txt new file mode 100644 index 0000000000..6f135bd17a --- /dev/null +++ b/basis/constructors/summary.txt @@ -0,0 +1 @@ +Utility to simplify tuple constructors diff --git a/basis/core-foundation/arrays/summary.txt b/basis/core-foundation/arrays/summary.txt new file mode 100644 index 0000000000..5ac5a7e87f --- /dev/null +++ b/basis/core-foundation/arrays/summary.txt @@ -0,0 +1 @@ +Wrapper for CFArray data type diff --git a/basis/core-foundation/bundles/summary.txt b/basis/core-foundation/bundles/summary.txt new file mode 100644 index 0000000000..911084a182 --- /dev/null +++ b/basis/core-foundation/bundles/summary.txt @@ -0,0 +1 @@ +Wrapper for CFBundle data type diff --git a/basis/core-foundation/data/summary.txt b/basis/core-foundation/data/summary.txt new file mode 100644 index 0000000000..74b02449fa --- /dev/null +++ b/basis/core-foundation/data/summary.txt @@ -0,0 +1 @@ +Wrapper for various CF data types diff --git a/basis/core-foundation/file-descriptors/summary.txt b/basis/core-foundation/file-descriptors/summary.txt new file mode 100644 index 0000000000..ac2afab5a8 --- /dev/null +++ b/basis/core-foundation/file-descriptors/summary.txt @@ -0,0 +1 @@ +Wrapper for CFFileDescriptor diff --git a/basis/core-foundation/fsevents/summary.txt b/basis/core-foundation/fsevents/summary.txt new file mode 100644 index 0000000000..17ab7f49a0 --- /dev/null +++ b/basis/core-foundation/fsevents/summary.txt @@ -0,0 +1 @@ +Wrapper for FSEventStream diff --git a/basis/core-foundation/strings/summary.txt b/basis/core-foundation/strings/summary.txt new file mode 100644 index 0000000000..4242691164 --- /dev/null +++ b/basis/core-foundation/strings/summary.txt @@ -0,0 +1 @@ +Wrapper for CFString diff --git a/basis/core-foundation/time/summary.txt b/basis/core-foundation/time/summary.txt new file mode 100644 index 0000000000..c8f1f3bf59 --- /dev/null +++ b/basis/core-foundation/time/summary.txt @@ -0,0 +1 @@ +Wrapper for CF time-related data types diff --git a/basis/core-foundation/timers/summary.txt b/basis/core-foundation/timers/summary.txt new file mode 100644 index 0000000000..c9b95849c4 --- /dev/null +++ b/basis/core-foundation/timers/summary.txt @@ -0,0 +1 @@ +Wrapper for CFTimer diff --git a/basis/core-foundation/urls/summary.txt b/basis/core-foundation/urls/summary.txt new file mode 100644 index 0000000000..2ae52e53ba --- /dev/null +++ b/basis/core-foundation/urls/summary.txt @@ -0,0 +1 @@ +Wrapper for CFURL diff --git a/basis/cpu/ppc/linux/summary.txt b/basis/cpu/ppc/linux/summary.txt new file mode 100644 index 0000000000..a35c0374b9 --- /dev/null +++ b/basis/cpu/ppc/linux/summary.txt @@ -0,0 +1 @@ +Linux/PPC ABI support diff --git a/basis/cpu/ppc/macosx/summary.txt b/basis/cpu/ppc/macosx/summary.txt new file mode 100644 index 0000000000..52ace04cc8 --- /dev/null +++ b/basis/cpu/ppc/macosx/summary.txt @@ -0,0 +1 @@ +Mac OS X/PPC ABI support diff --git a/basis/cpu/x86/32/summary.txt b/basis/cpu/x86/32/summary.txt new file mode 100644 index 0000000000..09e329f942 --- /dev/null +++ b/basis/cpu/x86/32/summary.txt @@ -0,0 +1 @@ +32-bit x86 code generator diff --git a/basis/cpu/x86/64/unix/summary.txt b/basis/cpu/x86/64/unix/summary.txt new file mode 100644 index 0000000000..8689936077 --- /dev/null +++ b/basis/cpu/x86/64/unix/summary.txt @@ -0,0 +1 @@ +64-bit x86 Unix ABI support diff --git a/basis/cpu/x86/64/winnt/summary.txt b/basis/cpu/x86/64/winnt/summary.txt new file mode 100644 index 0000000000..7f66427cf5 --- /dev/null +++ b/basis/cpu/x86/64/winnt/summary.txt @@ -0,0 +1 @@ +64-bit x86 Windows ABI support diff --git a/basis/cpu/x86/assembler/summary.txt b/basis/cpu/x86/assembler/summary.txt new file mode 100644 index 0000000000..0861fbb17e --- /dev/null +++ b/basis/cpu/x86/assembler/summary.txt @@ -0,0 +1 @@ +x86 assembler diff --git a/basis/cpu/x86/assembler/syntax/summary.txt b/basis/cpu/x86/assembler/syntax/summary.txt new file mode 100644 index 0000000000..82e436dc22 --- /dev/null +++ b/basis/cpu/x86/assembler/syntax/summary.txt @@ -0,0 +1 @@ +Parsing words used by x86 assembler diff --git a/basis/db/errors/summary.txt b/basis/db/errors/summary.txt new file mode 100644 index 0000000000..1cd102173f --- /dev/null +++ b/basis/db/errors/summary.txt @@ -0,0 +1 @@ +Errors thrown by database library diff --git a/basis/db/pools/summary.txt b/basis/db/pools/summary.txt new file mode 100644 index 0000000000..d1f51c47e6 --- /dev/null +++ b/basis/db/pools/summary.txt @@ -0,0 +1 @@ +Database connection pooling diff --git a/basis/db/postgresql/summary.txt b/basis/db/postgresql/summary.txt new file mode 100644 index 0000000000..f0e494623e --- /dev/null +++ b/basis/db/postgresql/summary.txt @@ -0,0 +1 @@ +PostgreSQL database connector diff --git a/basis/db/queries/summary.txt b/basis/db/queries/summary.txt new file mode 100644 index 0000000000..b5f395b183 --- /dev/null +++ b/basis/db/queries/summary.txt @@ -0,0 +1 @@ +Database queries diff --git a/basis/db/sqlite/summary.txt b/basis/db/sqlite/summary.txt new file mode 100644 index 0000000000..f5997a3c69 --- /dev/null +++ b/basis/db/sqlite/summary.txt @@ -0,0 +1 @@ +SQLite database connector diff --git a/basis/db/tuples/summary.txt b/basis/db/tuples/summary.txt new file mode 100644 index 0000000000..3ffaa8acac --- /dev/null +++ b/basis/db/tuples/summary.txt @@ -0,0 +1 @@ +O/R mapper diff --git a/basis/db/types/summary.txt b/basis/db/types/summary.txt new file mode 100644 index 0000000000..c474fe6460 --- /dev/null +++ b/basis/db/types/summary.txt @@ -0,0 +1 @@ +SQL data type support diff --git a/basis/delegate/protocols/summary.txt b/basis/delegate/protocols/summary.txt new file mode 100644 index 0000000000..3a74997468 --- /dev/null +++ b/basis/delegate/protocols/summary.txt @@ -0,0 +1 @@ +Various core protocols for use with delegation diff --git a/basis/endian/summary.txt b/basis/endian/summary.txt new file mode 100644 index 0000000000..e5380c1709 --- /dev/null +++ b/basis/endian/summary.txt @@ -0,0 +1 @@ +Utilities for working with big-endian and little-endian data diff --git a/basis/environment/unix/macosx/summary.txt b/basis/environment/unix/macosx/summary.txt new file mode 100644 index 0000000000..d7f2162a5e --- /dev/null +++ b/basis/environment/unix/macosx/summary.txt @@ -0,0 +1 @@ +Mac OS X environment variables implementation diff --git a/basis/environment/unix/summary.txt b/basis/environment/unix/summary.txt new file mode 100644 index 0000000000..cc4d5ded5b --- /dev/null +++ b/basis/environment/unix/summary.txt @@ -0,0 +1 @@ +Unix environment variables implementation diff --git a/basis/environment/winnt/summary.txt b/basis/environment/winnt/summary.txt new file mode 100644 index 0000000000..905970977f --- /dev/null +++ b/basis/environment/winnt/summary.txt @@ -0,0 +1 @@ +Windows environment variables implementation diff --git a/basis/farkup/tags.txt b/basis/farkup/tags.txt index 8e27be7d61..5df72b3467 100644 --- a/basis/farkup/tags.txt +++ b/basis/farkup/tags.txt @@ -1 +1,2 @@ text +web diff --git a/basis/ftp/client/summary.txt b/basis/ftp/client/summary.txt new file mode 100644 index 0000000000..17a546eea3 --- /dev/null +++ b/basis/ftp/client/summary.txt @@ -0,0 +1 @@ +FTP client diff --git a/basis/ftp/server/summary.txt b/basis/ftp/server/summary.txt new file mode 100644 index 0000000000..e839816e20 --- /dev/null +++ b/basis/ftp/server/summary.txt @@ -0,0 +1 @@ +FTP server diff --git a/basis/ftp/summary.txt b/basis/ftp/summary.txt new file mode 100644 index 0000000000..a1c6bf62e2 --- /dev/null +++ b/basis/ftp/summary.txt @@ -0,0 +1 @@ +Common code shared by FTP client and server diff --git a/basis/help/html/summary.txt b/basis/help/html/summary.txt new file mode 100644 index 0000000000..913a9a5766 --- /dev/null +++ b/basis/help/html/summary.txt @@ -0,0 +1 @@ +Converting help to HTML diff --git a/basis/html/summary.txt b/basis/html/summary.txt new file mode 100644 index 0000000000..6fb5a3ca8d --- /dev/null +++ b/basis/html/summary.txt @@ -0,0 +1 @@ +HTML utilities diff --git a/basis/html/templates/chloe/compiler/summary.txt b/basis/html/templates/chloe/compiler/summary.txt new file mode 100644 index 0000000000..c77d722739 --- /dev/null +++ b/basis/html/templates/chloe/compiler/summary.txt @@ -0,0 +1 @@ +Compiling Chloe templates to Factor quotations diff --git a/basis/http/server/dispatchers/summary.txt b/basis/http/server/dispatchers/summary.txt new file mode 100644 index 0000000000..b3a5b41233 --- /dev/null +++ b/basis/http/server/dispatchers/summary.txt @@ -0,0 +1 @@ +Dispatcher responder for dispaching requests to a set of child responders diff --git a/basis/http/server/filters/summary.txt b/basis/http/server/filters/summary.txt new file mode 100644 index 0000000000..dc07e1a32d --- /dev/null +++ b/basis/http/server/filters/summary.txt @@ -0,0 +1 @@ +Filter responders which wrap an underlying responder diff --git a/basis/http/server/redirection/summary.txt b/basis/http/server/redirection/summary.txt new file mode 100644 index 0000000000..1e5f38e8fe --- /dev/null +++ b/basis/http/server/redirection/summary.txt @@ -0,0 +1 @@ +Redirection responses which redirect the client to another URL diff --git a/basis/http/server/remapping/summary.txt b/basis/http/server/remapping/summary.txt new file mode 100644 index 0000000000..4515eeebe8 --- /dev/null +++ b/basis/http/server/remapping/summary.txt @@ -0,0 +1 @@ +Support for port remapping diff --git a/basis/http/server/responses/summary.txt b/basis/http/server/responses/summary.txt new file mode 100644 index 0000000000..091d5869e4 --- /dev/null +++ b/basis/http/server/responses/summary.txt @@ -0,0 +1 @@ +Constructing various simple responses diff --git a/basis/http/server/static/summary.txt b/basis/http/server/static/summary.txt new file mode 100644 index 0000000000..3aa2f3783c --- /dev/null +++ b/basis/http/server/static/summary.txt @@ -0,0 +1 @@ +Serving static files diff --git a/basis/images/bitmap/summary.txt b/basis/images/bitmap/summary.txt new file mode 100644 index 0000000000..2411e584db --- /dev/null +++ b/basis/images/bitmap/summary.txt @@ -0,0 +1 @@ +Windows BMP image loader diff --git a/basis/images/loader/summary.txt b/basis/images/loader/summary.txt new file mode 100644 index 0000000000..69d35c4597 --- /dev/null +++ b/basis/images/loader/summary.txt @@ -0,0 +1 @@ +Loading bitmap images from files diff --git a/basis/images/summary.txt b/basis/images/summary.txt new file mode 100644 index 0000000000..3c1ddbb47d --- /dev/null +++ b/basis/images/summary.txt @@ -0,0 +1 @@ +Bitmap images diff --git a/basis/images/tiff/summary.txt b/basis/images/tiff/summary.txt new file mode 100644 index 0000000000..ff340daf1b --- /dev/null +++ b/basis/images/tiff/summary.txt @@ -0,0 +1 @@ +TIFF image loader diff --git a/basis/interpolate/summary.txt b/basis/interpolate/summary.txt new file mode 100644 index 0000000000..b9cf1b7724 --- /dev/null +++ b/basis/interpolate/summary.txt @@ -0,0 +1 @@ +Interpolating variable values into strings diff --git a/basis/io/backend/unix/multiplexers/epoll/summary.txt b/basis/io/backend/unix/multiplexers/epoll/summary.txt new file mode 100644 index 0000000000..74c9b80761 --- /dev/null +++ b/basis/io/backend/unix/multiplexers/epoll/summary.txt @@ -0,0 +1 @@ +Linux epoll multiplexer diff --git a/basis/io/backend/unix/multiplexers/kqueue/summary.txt b/basis/io/backend/unix/multiplexers/kqueue/summary.txt new file mode 100644 index 0000000000..74f9ce6edd --- /dev/null +++ b/basis/io/backend/unix/multiplexers/kqueue/summary.txt @@ -0,0 +1 @@ +BSD and Mac OS X kqueue multiplexer diff --git a/basis/io/backend/unix/multiplexers/run-loop/summary.txt b/basis/io/backend/unix/multiplexers/run-loop/summary.txt new file mode 100644 index 0000000000..559de8a088 --- /dev/null +++ b/basis/io/backend/unix/multiplexers/run-loop/summary.txt @@ -0,0 +1 @@ +Mac OS X CFRunLoop multiplexer diff --git a/basis/io/backend/unix/multiplexers/select/summary.txt b/basis/io/backend/unix/multiplexers/select/summary.txt new file mode 100644 index 0000000000..46360fd234 --- /dev/null +++ b/basis/io/backend/unix/multiplexers/select/summary.txt @@ -0,0 +1 @@ +Generic Unix select multiplexer diff --git a/basis/io/backend/unix/multiplexers/summary.txt b/basis/io/backend/unix/multiplexers/summary.txt new file mode 100644 index 0000000000..36ac79d083 --- /dev/null +++ b/basis/io/backend/unix/multiplexers/summary.txt @@ -0,0 +1 @@ +Generic protocol for Unix I/O multiplexers diff --git a/basis/io/directories/search/summary.txt b/basis/io/directories/search/summary.txt new file mode 100644 index 0000000000..a9df0baf4c --- /dev/null +++ b/basis/io/directories/search/summary.txt @@ -0,0 +1 @@ +Recursive directory traversal diff --git a/basis/io/encodings/chinese/summary.txt b/basis/io/encodings/chinese/summary.txt new file mode 100644 index 0000000000..da296942b0 --- /dev/null +++ b/basis/io/encodings/chinese/summary.txt @@ -0,0 +1 @@ +GB18030 encoding for Chinese text diff --git a/basis/io/encodings/korean/tags.txt b/basis/io/encodings/korean/tags.txt deleted file mode 100644 index 8e27be7d61..0000000000 --- a/basis/io/encodings/korean/tags.txt +++ /dev/null @@ -1 +0,0 @@ -text diff --git a/basis/io/encodings/strict/tags.txt b/basis/io/encodings/strict/tags.txt deleted file mode 100644 index 8e27be7d61..0000000000 --- a/basis/io/encodings/strict/tags.txt +++ /dev/null @@ -1 +0,0 @@ -text diff --git a/basis/io/encodings/string/summary.txt b/basis/io/encodings/string/summary.txt index 59b8927dea..da2f7957b2 100644 --- a/basis/io/encodings/string/summary.txt +++ b/basis/io/encodings/string/summary.txt @@ -1 +1 @@ -Encoding and decoding strings +Converting strings to byte arrays and vice versa diff --git a/basis/io/encodings/string/tags.factor b/basis/io/encodings/string/tags.factor deleted file mode 100644 index 8e27be7d61..0000000000 --- a/basis/io/encodings/string/tags.factor +++ /dev/null @@ -1 +0,0 @@ -text diff --git a/basis/io/encodings/8-bit/tags.txt b/basis/io/encodings/string/tags.txt similarity index 100% rename from basis/io/encodings/8-bit/tags.txt rename to basis/io/encodings/string/tags.txt diff --git a/basis/io/encodings/utf16/tags.txt b/basis/io/encodings/utf16/tags.txt deleted file mode 100644 index 8e27be7d61..0000000000 --- a/basis/io/encodings/utf16/tags.txt +++ /dev/null @@ -1 +0,0 @@ -text diff --git a/basis/io/encodings/utf16n/summary.txt b/basis/io/encodings/utf16n/summary.txt new file mode 100644 index 0000000000..4d94d1bbdb --- /dev/null +++ b/basis/io/encodings/utf16n/summary.txt @@ -0,0 +1 @@ +UTF16 encoding with native byte order diff --git a/basis/io/encodings/utf32/tags.txt b/basis/io/encodings/utf32/tags.txt deleted file mode 100644 index 8e27be7d61..0000000000 --- a/basis/io/encodings/utf32/tags.txt +++ /dev/null @@ -1 +0,0 @@ -text diff --git a/basis/io/files/types/summary.txt b/basis/io/files/types/summary.txt new file mode 100644 index 0000000000..1e0118aa37 --- /dev/null +++ b/basis/io/files/types/summary.txt @@ -0,0 +1 @@ +File types for file-info and directory listing diff --git a/basis/io/files/unique/summary.txt b/basis/io/files/unique/summary.txt new file mode 100644 index 0000000000..08584aae17 --- /dev/null +++ b/basis/io/files/unique/summary.txt @@ -0,0 +1 @@ +Temporary files with unique names diff --git a/basis/io/pipes/summary.txt b/basis/io/pipes/summary.txt new file mode 100644 index 0000000000..3a1f8c7d21 --- /dev/null +++ b/basis/io/pipes/summary.txt @@ -0,0 +1 @@ +Pipes for inter-process communication diff --git a/basis/io/streams/byte-array/summary.txt b/basis/io/streams/byte-array/summary.txt new file mode 100644 index 0000000000..2f0b772872 --- /dev/null +++ b/basis/io/streams/byte-array/summary.txt @@ -0,0 +1 @@ +Streams for reading and writing bytes in a byte array diff --git a/basis/io/streams/limited/summary.txt b/basis/io/streams/limited/summary.txt new file mode 100644 index 0000000000..386143403f --- /dev/null +++ b/basis/io/streams/limited/summary.txt @@ -0,0 +1 @@ +Streams with a maximum length cutoff diff --git a/basis/io/streams/memory/summary.txt b/basis/io/streams/memory/summary.txt new file mode 100644 index 0000000000..b0ecbf6d5b --- /dev/null +++ b/basis/io/streams/memory/summary.txt @@ -0,0 +1 @@ +Streams for reading data directly from memory diff --git a/basis/lcs/diff2html/summary.txt b/basis/lcs/diff2html/summary.txt new file mode 100644 index 0000000000..066e78a26e --- /dev/null +++ b/basis/lcs/diff2html/summary.txt @@ -0,0 +1 @@ +Pretty HTML rendering of diffs diff --git a/basis/lists/lazy/examples/summary.txt b/basis/lists/lazy/examples/summary.txt new file mode 100644 index 0000000000..8b13789179 --- /dev/null +++ b/basis/lists/lazy/examples/summary.txt @@ -0,0 +1 @@ + diff --git a/basis/locals/backend/summary.txt b/basis/locals/backend/summary.txt new file mode 100644 index 0000000000..8b13789179 --- /dev/null +++ b/basis/locals/backend/summary.txt @@ -0,0 +1 @@ + diff --git a/basis/locals/definitions/summary.txt b/basis/locals/definitions/summary.txt new file mode 100644 index 0000000000..e08d7bf0a4 --- /dev/null +++ b/basis/locals/definitions/summary.txt @@ -0,0 +1 @@ +Definition protocol implementation for lambda words diff --git a/basis/locals/errors/summary.txt b/basis/locals/errors/summary.txt new file mode 100644 index 0000000000..a5d40df872 --- /dev/null +++ b/basis/locals/errors/summary.txt @@ -0,0 +1 @@ +Errors thrown by locals implementation diff --git a/basis/locals/fry/summary.txt b/basis/locals/fry/summary.txt new file mode 100644 index 0000000000..2173b22649 --- /dev/null +++ b/basis/locals/fry/summary.txt @@ -0,0 +1 @@ +Support for mixing fry and locals diff --git a/basis/locals/macros/summary.txt b/basis/locals/macros/summary.txt new file mode 100644 index 0000000000..92b4c4c775 --- /dev/null +++ b/basis/locals/macros/summary.txt @@ -0,0 +1 @@ +Support for macro expansion inside lambdas diff --git a/basis/locals/parser/summary.txt b/basis/locals/parser/summary.txt new file mode 100644 index 0000000000..095b0e22e7 --- /dev/null +++ b/basis/locals/parser/summary.txt @@ -0,0 +1 @@ +Utility words used by locals parsing words diff --git a/basis/locals/prettyprint/summary.txt b/basis/locals/prettyprint/summary.txt new file mode 100644 index 0000000000..ecfc10483c --- /dev/null +++ b/basis/locals/prettyprint/summary.txt @@ -0,0 +1 @@ +Prettyprinting of lambdas diff --git a/basis/locals/rewrite/closures/summary.txt b/basis/locals/rewrite/closures/summary.txt new file mode 100644 index 0000000000..d0a28aad4f --- /dev/null +++ b/basis/locals/rewrite/closures/summary.txt @@ -0,0 +1 @@ +Rewriting closures to not have any free variables diff --git a/basis/locals/rewrite/point-free/summary.txt b/basis/locals/rewrite/point-free/summary.txt new file mode 100644 index 0000000000..40ab193d72 --- /dev/null +++ b/basis/locals/rewrite/point-free/summary.txt @@ -0,0 +1 @@ +Rewriting applicative code to use the retain stack instead of named values diff --git a/basis/locals/rewrite/sugar/summary.txt b/basis/locals/rewrite/sugar/summary.txt new file mode 100644 index 0000000000..485bb844e4 --- /dev/null +++ b/basis/locals/rewrite/sugar/summary.txt @@ -0,0 +1 @@ +Desugaring locals in literals and let binding diff --git a/basis/locals/types/summary.txt b/basis/locals/types/summary.txt new file mode 100644 index 0000000000..be667d0ffb --- /dev/null +++ b/basis/locals/types/summary.txt @@ -0,0 +1 @@ +Data types used by locals implementation diff --git a/basis/macros/expander/summary.txt b/basis/macros/expander/summary.txt new file mode 100644 index 0000000000..0fd81ed0cf --- /dev/null +++ b/basis/macros/expander/summary.txt @@ -0,0 +1 @@ +Macro expansion utility, used for debugging and in the locals implementation diff --git a/basis/math/partial-dispatch/summary.txt b/basis/math/partial-dispatch/summary.txt new file mode 100644 index 0000000000..a1bc1a16b1 --- /dev/null +++ b/basis/math/partial-dispatch/summary.txt @@ -0,0 +1 @@ +Partially-dispatched math operations, used by the compiler diff --git a/basis/math/rectangles/positioning/positioning-docs.factor b/basis/math/rectangles/positioning/positioning-docs.factor new file mode 100644 index 0000000000..e69de29bb2 diff --git a/basis/mime/multipart/summary.txt b/basis/mime/multipart/summary.txt new file mode 100644 index 0000000000..ab08c83021 --- /dev/null +++ b/basis/mime/multipart/summary.txt @@ -0,0 +1 @@ +MIME multipart parser diff --git a/basis/mime/types/summary.txt b/basis/mime/types/summary.txt new file mode 100644 index 0000000000..7ead547277 --- /dev/null +++ b/basis/mime/types/summary.txt @@ -0,0 +1 @@ +MIME types database diff --git a/basis/models/compose/summary.txt b/basis/models/compose/summary.txt new file mode 100644 index 0000000000..962b30ad90 --- /dev/null +++ b/basis/models/compose/summary.txt @@ -0,0 +1 @@ +Composed models combine the values of a sequence of models into one diff --git a/basis/models/delay/summary.txt b/basis/models/delay/summary.txt new file mode 100644 index 0000000000..46fa0d6a75 --- /dev/null +++ b/basis/models/delay/summary.txt @@ -0,0 +1 @@ +Delay models update a fixed period of time after the underlying model changes diff --git a/basis/models/filter/summary.txt b/basis/models/filter/summary.txt new file mode 100644 index 0000000000..a8267ac7ec --- /dev/null +++ b/basis/models/filter/summary.txt @@ -0,0 +1 @@ +Filter models apply a quotation to the value of an underlying model diff --git a/basis/models/history/summary.txt b/basis/models/history/summary.txt new file mode 100644 index 0000000000..76f7b88159 --- /dev/null +++ b/basis/models/history/summary.txt @@ -0,0 +1 @@ +History models remember prior values diff --git a/basis/models/mapping/summary.txt b/basis/models/mapping/summary.txt new file mode 100644 index 0000000000..5b1562124b --- /dev/null +++ b/basis/models/mapping/summary.txt @@ -0,0 +1 @@ +Mapping models combine an assoc of models into a single model diff --git a/basis/models/range/summary.txt b/basis/models/range/summary.txt new file mode 100644 index 0000000000..b00df47fe1 --- /dev/null +++ b/basis/models/range/summary.txt @@ -0,0 +1 @@ +Range models bound their values diff --git a/basis/nibble-arrays/summary.txt b/basis/nibble-arrays/summary.txt new file mode 100644 index 0000000000..ae8abe6b2e --- /dev/null +++ b/basis/nibble-arrays/summary.txt @@ -0,0 +1 @@ +Space-efficient arrays of 4-bit values diff --git a/basis/openssl/libcrypto/summary.txt b/basis/openssl/libcrypto/summary.txt new file mode 100644 index 0000000000..f140b3cbea --- /dev/null +++ b/basis/openssl/libcrypto/summary.txt @@ -0,0 +1 @@ +Low-level FFI binding to libcrypto diff --git a/basis/openssl/libssl/summary.txt b/basis/openssl/libssl/summary.txt new file mode 100644 index 0000000000..e823bb65b5 --- /dev/null +++ b/basis/openssl/libssl/summary.txt @@ -0,0 +1 @@ +Low-level FFI binding to libssl diff --git a/basis/pack/summary.txt b/basis/pack/summary.txt new file mode 100644 index 0000000000..ae884f60c5 --- /dev/null +++ b/basis/pack/summary.txt @@ -0,0 +1 @@ +Packing and unpacking binary data diff --git a/basis/peg/ebnf/summary.txt b/basis/peg/ebnf/summary.txt index 473cf4f3a2..76ad8b1b1e 100644 --- a/basis/peg/ebnf/summary.txt +++ b/basis/peg/ebnf/summary.txt @@ -1 +1 @@ -Grammar for parsing EBNF +Declarative EBNF language for writing PEG parsers diff --git a/basis/peg/ebnf/tags.txt b/basis/peg/ebnf/tags.txt index 9da56880c0..5af5dba748 100644 --- a/basis/peg/ebnf/tags.txt +++ b/basis/peg/ebnf/tags.txt @@ -1 +1,2 @@ +text parsing diff --git a/basis/peg/parsers/summary.txt b/basis/peg/parsers/summary.txt new file mode 100644 index 0000000000..a87ccc97b4 --- /dev/null +++ b/basis/peg/parsers/summary.txt @@ -0,0 +1 @@ +Additional PEG parsers diff --git a/basis/io/encodings/ascii/tags.txt b/basis/peg/parsers/tags.txt similarity index 100% rename from basis/io/encodings/ascii/tags.txt rename to basis/peg/parsers/tags.txt diff --git a/basis/peg/summary.txt b/basis/peg/summary.txt index 324a544036..498b4e0bb0 100644 --- a/basis/peg/summary.txt +++ b/basis/peg/summary.txt @@ -1 +1 @@ -Parsing Expression Grammar and Packrat Parser +Parsing expression grammar and packrat parser diff --git a/basis/prettyprint/custom/summary.txt b/basis/prettyprint/custom/summary.txt new file mode 100644 index 0000000000..a9cd58aaf7 --- /dev/null +++ b/basis/prettyprint/custom/summary.txt @@ -0,0 +1 @@ +Protocol for extending the prettyprinter on custom data types diff --git a/basis/random/dummy/summary.txt b/basis/random/dummy/summary.txt new file mode 100644 index 0000000000..706f2c9e7b --- /dev/null +++ b/basis/random/dummy/summary.txt @@ -0,0 +1 @@ +Dummy RNG for testing diff --git a/basis/random/unix/summary.txt b/basis/random/unix/summary.txt new file mode 100644 index 0000000000..c8762e21e5 --- /dev/null +++ b/basis/random/unix/summary.txt @@ -0,0 +1 @@ +Native Unix RNG diff --git a/basis/random/windows/summary.txt b/basis/random/windows/summary.txt new file mode 100644 index 0000000000..0554a506e0 --- /dev/null +++ b/basis/random/windows/summary.txt @@ -0,0 +1 @@ +Native Windows RNG diff --git a/basis/smtp/server/summary.txt b/basis/smtp/server/summary.txt new file mode 100644 index 0000000000..1bcabc1835 --- /dev/null +++ b/basis/smtp/server/summary.txt @@ -0,0 +1 @@ +SMTP server for testing purposes diff --git a/basis/sorting/slots/summary.txt b/basis/sorting/slots/summary.txt new file mode 100644 index 0000000000..240a4ff714 --- /dev/null +++ b/basis/sorting/slots/summary.txt @@ -0,0 +1 @@ +Sorting by tuple slots diff --git a/basis/specialized-arrays/direct/functor/summary.txt b/basis/specialized-arrays/direct/functor/summary.txt new file mode 100644 index 0000000000..79df0a577c --- /dev/null +++ b/basis/specialized-arrays/direct/functor/summary.txt @@ -0,0 +1 @@ +Code generation for direct specialized arrays diff --git a/basis/specialized-arrays/functor/summary.txt b/basis/specialized-arrays/functor/summary.txt new file mode 100644 index 0000000000..77cb2d4d89 --- /dev/null +++ b/basis/specialized-arrays/functor/summary.txt @@ -0,0 +1 @@ +Code generation for specialized arrays diff --git a/basis/specialized-vectors/functor/summary.txt b/basis/specialized-vectors/functor/summary.txt new file mode 100644 index 0000000000..dc26fa6d44 --- /dev/null +++ b/basis/specialized-vectors/functor/summary.txt @@ -0,0 +1 @@ +Code generation for specialized vectors diff --git a/basis/stack-checker/alien/summary.txt b/basis/stack-checker/alien/summary.txt new file mode 100644 index 0000000000..18cf21cd5b --- /dev/null +++ b/basis/stack-checker/alien/summary.txt @@ -0,0 +1 @@ +Stack effect inference for alien calls diff --git a/basis/stack-checker/branches/summary.txt b/basis/stack-checker/branches/summary.txt new file mode 100644 index 0000000000..c63c8d052a --- /dev/null +++ b/basis/stack-checker/branches/summary.txt @@ -0,0 +1 @@ +Stack effect inference for conditionals diff --git a/basis/stack-checker/inlining/summary.txt b/basis/stack-checker/inlining/summary.txt new file mode 100644 index 0000000000..422401d354 --- /dev/null +++ b/basis/stack-checker/inlining/summary.txt @@ -0,0 +1 @@ +Stack effect inference for inline and inline recursive words diff --git a/basis/stack-checker/recursive-state/summary.txt b/basis/stack-checker/recursive-state/summary.txt new file mode 100644 index 0000000000..52f5a14fc5 --- /dev/null +++ b/basis/stack-checker/recursive-state/summary.txt @@ -0,0 +1 @@ +Tracking word nesting during stack effect inference diff --git a/basis/stack-checker/recursive-state/tree/summary.txt b/basis/stack-checker/recursive-state/tree/summary.txt new file mode 100644 index 0000000000..ca96da119a --- /dev/null +++ b/basis/stack-checker/recursive-state/tree/summary.txt @@ -0,0 +1 @@ +Simple binary tree diff --git a/basis/stack-checker/values/summary.txt b/basis/stack-checker/values/summary.txt new file mode 100644 index 0000000000..5b57e95f5c --- /dev/null +++ b/basis/stack-checker/values/summary.txt @@ -0,0 +1 @@ +Abstract stack checker values diff --git a/basis/stack-checker/visitor/dummy/summary.txt b/basis/stack-checker/visitor/dummy/summary.txt new file mode 100644 index 0000000000..b4340ea4d2 --- /dev/null +++ b/basis/stack-checker/visitor/dummy/summary.txt @@ -0,0 +1 @@ +Dummy implementation of node visitor protocol diff --git a/basis/stack-checker/visitor/summary.txt b/basis/stack-checker/visitor/summary.txt new file mode 100644 index 0000000000..29a3c8a41f --- /dev/null +++ b/basis/stack-checker/visitor/summary.txt @@ -0,0 +1 @@ +Node visitor protocol diff --git a/basis/tools/deploy/test/11/11-tests.factor b/basis/tools/deploy/test/11/11-tests.factor new file mode 100644 index 0000000000..2eb7009bf9 --- /dev/null +++ b/basis/tools/deploy/test/11/11-tests.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test tools.deploy.test.11 ; +IN: tools.deploy.test.11.tests diff --git a/basis/tools/deploy/test/11/11.factor b/basis/tools/deploy/test/11/11.factor new file mode 100644 index 0000000000..b4f8622627 --- /dev/null +++ b/basis/tools/deploy/test/11/11.factor @@ -0,0 +1,8 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: eval ; +IN: tools.deploy.test.11 + +: foo ( -- ) "USING: math prettyprint ; 2 2 + ." eval ; + +MAIN: foo \ No newline at end of file diff --git a/basis/tools/deploy/test/11/authors.txt b/basis/tools/deploy/test/11/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/basis/tools/deploy/test/11/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/basis/tools/deploy/test/11/deploy.factor b/basis/tools/deploy/test/11/deploy.factor new file mode 100644 index 0000000000..42f707b332 --- /dev/null +++ b/basis/tools/deploy/test/11/deploy.factor @@ -0,0 +1,15 @@ +USING: tools.deploy.config ; +H{ + { deploy-reflection 5 } + { deploy-word-props? f } + { deploy-c-types? f } + { deploy-name "tools.deploy.test.11" } + { "stop-after-last-window?" t } + { deploy-word-defs? f } + { deploy-math? f } + { deploy-unicode? f } + { deploy-threads? f } + { deploy-compiler? f } + { deploy-io 2 } + { deploy-ui? f } +} diff --git a/basis/tools/files/summary.txt b/basis/tools/files/summary.txt new file mode 100644 index 0000000000..ec49d5bc30 --- /dev/null +++ b/basis/tools/files/summary.txt @@ -0,0 +1 @@ +File listing and disk usage tools diff --git a/basis/tools/scaffold/summary.txt b/basis/tools/scaffold/summary.txt new file mode 100644 index 0000000000..9355d1426e --- /dev/null +++ b/basis/tools/scaffold/summary.txt @@ -0,0 +1 @@ +Tool to create the scaffolding for new vocabularies diff --git a/basis/tools/threads/summary.txt b/basis/tools/threads/summary.txt new file mode 100644 index 0000000000..3a94df1cc9 --- /dev/null +++ b/basis/tools/threads/summary.txt @@ -0,0 +1 @@ +Listing running threads diff --git a/basis/tools/vocabs/browser/summary.txt b/basis/tools/vocabs/browser/summary.txt new file mode 100644 index 0000000000..28b4850ed8 --- /dev/null +++ b/basis/tools/vocabs/browser/summary.txt @@ -0,0 +1 @@ +Browsing vocabularies diff --git a/basis/tools/vocabs/summary.txt b/basis/tools/vocabs/summary.txt new file mode 100644 index 0000000000..1ae5f43784 --- /dev/null +++ b/basis/tools/vocabs/summary.txt @@ -0,0 +1 @@ +Reloading vocabularies and cross-referencing vocabularies diff --git a/basis/ui/gadgets/canvas/summary.txt b/basis/ui/gadgets/canvas/summary.txt new file mode 100644 index 0000000000..70b35e6eed --- /dev/null +++ b/basis/ui/gadgets/canvas/summary.txt @@ -0,0 +1 @@ +Canvas gadget for caching rendering to a display list diff --git a/basis/ui/tools/deploy/summary.txt b/basis/ui/tools/deploy/summary.txt new file mode 100644 index 0000000000..c6f49801d7 --- /dev/null +++ b/basis/ui/tools/deploy/summary.txt @@ -0,0 +1 @@ +Graphical front-end for deploy tool diff --git a/basis/ui/windows/summary.txt b/basis/ui/windows/summary.txt new file mode 100644 index 0000000000..9a0a894850 --- /dev/null +++ b/basis/ui/windows/summary.txt @@ -0,0 +1 @@ +Windows UI backend diff --git a/basis/ui/x11/summary.txt b/basis/ui/x11/summary.txt new file mode 100644 index 0000000000..046c83ad89 --- /dev/null +++ b/basis/ui/x11/summary.txt @@ -0,0 +1 @@ +X11 UI backend diff --git a/basis/unicode/breaks/summary.txt b/basis/unicode/breaks/summary.txt new file mode 100644 index 0000000000..4f73d98063 --- /dev/null +++ b/basis/unicode/breaks/summary.txt @@ -0,0 +1 @@ +Unicode grapheme and word breaking diff --git a/basis/unicode/case/summary.txt b/basis/unicode/case/summary.txt new file mode 100644 index 0000000000..a88f3d4a98 --- /dev/null +++ b/basis/unicode/case/summary.txt @@ -0,0 +1 @@ +Unicode case conversion diff --git a/basis/unicode/categories/summary.txt b/basis/unicode/categories/summary.txt new file mode 100644 index 0000000000..7efad41e84 --- /dev/null +++ b/basis/unicode/categories/summary.txt @@ -0,0 +1 @@ +Unicode character categories diff --git a/basis/unicode/collation/summary.txt b/basis/unicode/collation/summary.txt new file mode 100644 index 0000000000..0b855e1fc8 --- /dev/null +++ b/basis/unicode/collation/summary.txt @@ -0,0 +1 @@ +Unicode string comparison and sorting (collation) diff --git a/basis/io/encodings/binary/tags.txt b/basis/unicode/collation/tags.txt similarity index 100% rename from basis/io/encodings/binary/tags.txt rename to basis/unicode/collation/tags.txt diff --git a/basis/unicode/data/summary.txt b/basis/unicode/data/summary.txt new file mode 100644 index 0000000000..c956b233f0 --- /dev/null +++ b/basis/unicode/data/summary.txt @@ -0,0 +1 @@ +Parsing Unicode data files diff --git a/basis/unicode/normalize/summary.txt b/basis/unicode/normalize/summary.txt new file mode 100644 index 0000000000..bd8b1669c4 --- /dev/null +++ b/basis/unicode/normalize/summary.txt @@ -0,0 +1 @@ +Unicode string normalization diff --git a/basis/io/encodings/japanese/tags.txt b/basis/unicode/script/tags.txt similarity index 100% rename from basis/io/encodings/japanese/tags.txt rename to basis/unicode/script/tags.txt diff --git a/basis/unicode/summary.txt b/basis/unicode/summary.txt index ece1e61b5f..8bd1149524 100644 --- a/basis/unicode/summary.txt +++ b/basis/unicode/summary.txt @@ -1 +1 @@ -Unicode 5.0 support +Unicode 5.1 support diff --git a/basis/unicode/syntax/summary.txt b/basis/unicode/syntax/summary.txt new file mode 100644 index 0000000000..651d51c34c --- /dev/null +++ b/basis/unicode/syntax/summary.txt @@ -0,0 +1 @@ +Parsing words used by Unicode implementation diff --git a/basis/unix/groups/summary.txt b/basis/unix/groups/summary.txt new file mode 100644 index 0000000000..f782bdd791 --- /dev/null +++ b/basis/unix/groups/summary.txt @@ -0,0 +1 @@ +Working with Unix user groups diff --git a/basis/unix/users/summary.txt b/basis/unix/users/summary.txt new file mode 100644 index 0000000000..8c1aa0dd8f --- /dev/null +++ b/basis/unix/users/summary.txt @@ -0,0 +1 @@ +Working with Unix users diff --git a/basis/unrolled-lists/summary.txt b/basis/unrolled-lists/summary.txt new file mode 100644 index 0000000000..c9014d1ba2 --- /dev/null +++ b/basis/unrolled-lists/summary.txt @@ -0,0 +1 @@ +Deque implementation with constant-time insertion and removal at either end, and better space efficiency than a double-linked list diff --git a/basis/urls/secure/summary.txt b/basis/urls/secure/summary.txt new file mode 100644 index 0000000000..31692c0596 --- /dev/null +++ b/basis/urls/secure/summary.txt @@ -0,0 +1 @@ +Support for https:// URLs diff --git a/basis/vlists/summary.txt b/basis/vlists/summary.txt new file mode 100644 index 0000000000..4d6e6b2d3b --- /dev/null +++ b/basis/vlists/summary.txt @@ -0,0 +1 @@ +Persistent sequence implementation optimizing the case where there is no sharing diff --git a/basis/wrap/strings/summary.txt b/basis/wrap/strings/summary.txt new file mode 100644 index 0000000000..26c35094e5 --- /dev/null +++ b/basis/wrap/strings/summary.txt @@ -0,0 +1 @@ +Word-wrapping strings diff --git a/basis/wrap/words/summary.txt b/basis/wrap/words/summary.txt new file mode 100644 index 0000000000..901379e5c8 --- /dev/null +++ b/basis/wrap/words/summary.txt @@ -0,0 +1 @@ +Word-wrapping words diff --git a/basis/xml/entities/html/summary.txt b/basis/xml/entities/html/summary.txt new file mode 100644 index 0000000000..16ea3a8bf6 --- /dev/null +++ b/basis/xml/entities/html/summary.txt @@ -0,0 +1 @@ +Standard HTML entities diff --git a/basis/xmode/code2html/summary.txt b/basis/xmode/code2html/summary.txt new file mode 100644 index 0000000000..f5e88d0aa6 --- /dev/null +++ b/basis/xmode/code2html/summary.txt @@ -0,0 +1 @@ +Syntax highlighting code as HTML diff --git a/basis/xmode/marker/summary.txt b/basis/xmode/marker/summary.txt new file mode 100644 index 0000000000..379906c885 --- /dev/null +++ b/basis/xmode/marker/summary.txt @@ -0,0 +1 @@ +Tokenizing lines of text with a syntax mode diff --git a/core/classes/algebra/summary.txt b/core/classes/algebra/summary.txt new file mode 100644 index 0000000000..d33d3b9504 --- /dev/null +++ b/core/classes/algebra/summary.txt @@ -0,0 +1 @@ +Set-theoretic operations on classes diff --git a/core/classes/builtin/summary.txt b/core/classes/builtin/summary.txt new file mode 100644 index 0000000000..cb77cbf377 --- /dev/null +++ b/core/classes/builtin/summary.txt @@ -0,0 +1 @@ +Built-in classes diff --git a/core/classes/intersection/summary.txt b/core/classes/intersection/summary.txt new file mode 100644 index 0000000000..a2ecf2ced6 --- /dev/null +++ b/core/classes/intersection/summary.txt @@ -0,0 +1 @@ +Intersection classes diff --git a/core/classes/parser/summary.txt b/core/classes/parser/summary.txt new file mode 100644 index 0000000000..cd3685599c --- /dev/null +++ b/core/classes/parser/summary.txt @@ -0,0 +1 @@ +Utilities for class-defining parsing words diff --git a/core/classes/singleton/summary.txt b/core/classes/singleton/summary.txt new file mode 100644 index 0000000000..273fbcbc1c --- /dev/null +++ b/core/classes/singleton/summary.txt @@ -0,0 +1 @@ +Singleton classes diff --git a/core/classes/tuple/parser/summary.txt b/core/classes/tuple/parser/summary.txt new file mode 100644 index 0000000000..765ccecaf1 --- /dev/null +++ b/core/classes/tuple/parser/summary.txt @@ -0,0 +1 @@ +Utilities for tuple-defining parsing words diff --git a/core/classes/tuple/summary.txt b/core/classes/tuple/summary.txt index 4dbb64316b..7ef244eefc 100644 --- a/core/classes/tuple/summary.txt +++ b/core/classes/tuple/summary.txt @@ -1 +1 @@ -Object system implementation +Tuple classes diff --git a/core/combinators/summary.txt b/core/combinators/summary.txt index 9346bba6b9..2a995e8a69 100644 --- a/core/combinators/summary.txt +++ b/core/combinators/summary.txt @@ -1 +1 @@ -Complex conditionals (cond, case) and support words for quotation construction +Complex conditionals (cond, case) and generalized dataflow combinators (cleave, spread) diff --git a/core/effects/parser/summary.txt b/core/effects/parser/summary.txt new file mode 100644 index 0000000000..c0e236c3ee --- /dev/null +++ b/core/effects/parser/summary.txt @@ -0,0 +1 @@ +Parsing stack effect declarations diff --git a/core/generic/parser/summary.txt b/core/generic/parser/summary.txt new file mode 100644 index 0000000000..7b7b51cf54 --- /dev/null +++ b/core/generic/parser/summary.txt @@ -0,0 +1 @@ +Utilities for generic word and method defining parsing words diff --git a/core/generic/standard/engines/predicate/summary.txt b/core/generic/standard/engines/predicate/summary.txt new file mode 100644 index 0000000000..47fee09ee5 --- /dev/null +++ b/core/generic/standard/engines/predicate/summary.txt @@ -0,0 +1 @@ +Chained-conditional dispatch strategy diff --git a/core/generic/standard/engines/summary.txt b/core/generic/standard/engines/summary.txt new file mode 100644 index 0000000000..209190799b --- /dev/null +++ b/core/generic/standard/engines/summary.txt @@ -0,0 +1 @@ +Generic word dispatch strategy implementation diff --git a/core/generic/standard/engines/tag/summary.txt b/core/generic/standard/engines/tag/summary.txt new file mode 100644 index 0000000000..3eea4b11cf --- /dev/null +++ b/core/generic/standard/engines/tag/summary.txt @@ -0,0 +1 @@ +Jump table keyed by pointer tag dispatch strategy diff --git a/core/generic/standard/engines/tuple/summary.txt b/core/generic/standard/engines/tuple/summary.txt new file mode 100644 index 0000000000..cb18ac5c78 --- /dev/null +++ b/core/generic/standard/engines/tuple/summary.txt @@ -0,0 +1 @@ +Tuple class dispatch strategy diff --git a/core/io/encodings/utf8/tags.txt b/core/io/encodings/utf8/tags.txt deleted file mode 100644 index 8e27be7d61..0000000000 --- a/core/io/encodings/utf8/tags.txt +++ /dev/null @@ -1 +0,0 @@ -text diff --git a/core/io/streams/null/summary.txt b/core/io/streams/null/summary.txt new file mode 100644 index 0000000000..68a403bf33 --- /dev/null +++ b/core/io/streams/null/summary.txt @@ -0,0 +1 @@ +Dummy implementation of stream protocol diff --git a/core/math/order/summary.txt b/core/math/order/summary.txt new file mode 100644 index 0000000000..3781910360 --- /dev/null +++ b/core/math/order/summary.txt @@ -0,0 +1 @@ +Generic protocol for totally-ordered objects diff --git a/core/splitting/tags.txt b/core/splitting/tags.txt index 42d711b32b..3ab2d731fe 100644 --- a/core/splitting/tags.txt +++ b/core/splitting/tags.txt @@ -1 +1,2 @@ collections +text diff --git a/core/strings/parser/summary.txt b/core/strings/parser/summary.txt new file mode 100644 index 0000000000..b47975868a --- /dev/null +++ b/core/strings/parser/summary.txt @@ -0,0 +1 @@ +Parsing strings diff --git a/core/system/summary.txt b/core/system/summary.txt index 414f0cac74..58bf255369 100644 --- a/core/system/summary.txt +++ b/core/system/summary.txt @@ -1 +1 @@ -OS and CPU queries, environment variables, paths +OS and CPU queries and other system-level tasks diff --git a/core/vocabs/parser/summary.txt b/core/vocabs/parser/summary.txt new file mode 100644 index 0000000000..2741539742 --- /dev/null +++ b/core/vocabs/parser/summary.txt @@ -0,0 +1 @@ +Utilities for parsing and defining words diff --git a/core/words/constant/summary.txt b/core/words/constant/summary.txt new file mode 100644 index 0000000000..42aa832d58 --- /dev/null +++ b/core/words/constant/summary.txt @@ -0,0 +1 @@ +Implementation of constant words diff --git a/core/words/symbol/summary.txt b/core/words/symbol/summary.txt new file mode 100644 index 0000000000..890cbde7ad --- /dev/null +++ b/core/words/symbol/summary.txt @@ -0,0 +1 @@ +Implementation of symbol words diff --git a/extra/peg/javascript/ast/tags.txt b/extra/peg/javascript/ast/tags.txt index a38bf33c3c..643ffaa321 100755 --- a/extra/peg/javascript/ast/tags.txt +++ b/extra/peg/javascript/ast/tags.txt @@ -1,4 +1,3 @@ -text javascript parsing languages diff --git a/extra/peg/javascript/parser/tags.txt b/extra/peg/javascript/parser/tags.txt index a38bf33c3c..643ffaa321 100755 --- a/extra/peg/javascript/parser/tags.txt +++ b/extra/peg/javascript/parser/tags.txt @@ -1,4 +1,3 @@ -text javascript parsing languages diff --git a/extra/peg/javascript/tags.txt b/extra/peg/javascript/tags.txt index a38bf33c3c..643ffaa321 100755 --- a/extra/peg/javascript/tags.txt +++ b/extra/peg/javascript/tags.txt @@ -1,4 +1,3 @@ -text javascript parsing languages diff --git a/extra/peg/javascript/tokenizer/tags.txt b/extra/peg/javascript/tokenizer/tags.txt index a38bf33c3c..643ffaa321 100755 --- a/extra/peg/javascript/tokenizer/tags.txt +++ b/extra/peg/javascript/tokenizer/tags.txt @@ -1,4 +1,3 @@ -text javascript parsing languages From 6a89e4ee3bbc440300e8b6b4000486fc9bf172da Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 16 Feb 2009 21:06:28 -0600 Subject: [PATCH 014/119] Updating sequence and hashtable documentation to point more clearly at the relevant generic operations defined on these types --- basis/byte-vectors/byte-vectors-docs.factor | 5 ++--- core/arrays/arrays-docs.factor | 20 +++++++++++++------- core/hashtables/hashtables-docs.factor | 4 +--- core/sbufs/sbufs-docs.factor | 6 ++---- core/sequences/sequences-docs.factor | 4 ++-- core/strings/strings-docs.factor | 19 ++++++------------- core/vectors/vectors-docs.factor | 14 ++++++++++---- 7 files changed, 36 insertions(+), 36 deletions(-) diff --git a/basis/byte-vectors/byte-vectors-docs.factor b/basis/byte-vectors/byte-vectors-docs.factor index 3873f73bfe..f304dca488 100644 --- a/basis/byte-vectors/byte-vectors-docs.factor +++ b/basis/byte-vectors/byte-vectors-docs.factor @@ -1,9 +1,8 @@ -USING: arrays byte-arrays help.markup help.syntax kernel -byte-vectors.private combinators ; +USING: arrays byte-arrays help.markup help.syntax kernel combinators ; IN: byte-vectors ARTICLE: "byte-vectors" "Byte vectors" -"A byte vector is a resizable mutable sequence of unsigned bytes. Byte vector words are found in the " { $vocab-link "byte-vectors" } " vocabulary." +"The " { $vocab-link "byte-vectors" } " vocabulary implements resizable mutable sequence of unsigned bytes. Byte vectors implement the " { $link "sequence-protocol" } " and thus all " { $link "sequences" } " can be used with them." $nl "Byte vectors form a class:" { $subsection byte-vector } diff --git a/core/arrays/arrays-docs.factor b/core/arrays/arrays-docs.factor index 39fed147cf..f5dc62a67d 100644 --- a/core/arrays/arrays-docs.factor +++ b/core/arrays/arrays-docs.factor @@ -1,11 +1,18 @@ USING: help.markup help.syntax -kernel kernel.private prettyprint sequences.private ; +kernel kernel.private prettyprint sequences.private sequences ; IN: arrays +ARTICLE: "arrays-unsafe" "Unsafe array operations" +"These two words are used internally by the Factor implementation. User code should never need to call them; instead use " { $link nth } " and " { $link set-nth } "." +{ $subsection array-nth } +{ $subsection set-array-nth } ; + ARTICLE: "arrays" "Arrays" -"Arrays are fixed-size mutable sequences (" { $link "sequence-protocol" } "). The literal syntax is covered in " { $link "syntax-arrays" } ". Resizable arrays also exist and are called vectors; see " { $link "vectors" } "." +"The " { $vocab-link "arrays" } " vocabulary implements fixed-size mutable sequences which support the " { $link "sequence-protocol" } "." $nl -"Array words are in the " { $vocab-link "arrays" } " vocabulary. Unsafe implementation words are in the " { $vocab-link "sequences.private" } " vocabulary." +"The " { $vocab-link "arrays" } " vocabulary only includes words for creating new arrays. To access and modify array elements, use " { $link "sequences" } " in the " { $vocab-link "sequences" } " vocabulary." +$nl +"Array literal syntax is documented in " { $link "syntax-arrays" } ". Resizable arrays also exist and are known as " { $link "vectors" } "." $nl "Arrays form a class of objects:" { $subsection array } @@ -18,11 +25,10 @@ $nl { $subsection 2array } { $subsection 3array } { $subsection 4array } -"Arrays can be accessed without bounds checks in a pointer unsafe way." -{ $subsection array-nth } -{ $subsection set-array-nth } "The class of two-element arrays:" -{ $subsection pair } ; +{ $subsection pair } +"Arrays can be accessed without bounds checks in a pointer unsafe way." +{ $subsection "arrays-unsafe" } ; ABOUT: "arrays" diff --git a/core/hashtables/hashtables-docs.factor b/core/hashtables/hashtables-docs.factor index 7cc8333c12..5a19cce351 100644 --- a/core/hashtables/hashtables-docs.factor +++ b/core/hashtables/hashtables-docs.factor @@ -17,9 +17,7 @@ $nl ARTICLE: "hashtables" "Hashtables" "A hashtable provides efficient (expected constant time) lookup and storage of key/value pairs. Keys are compared for equality, and a hashing function is used to reduce the number of comparisons made. The literal syntax is covered in " { $link "syntax-hashtables" } "." $nl -"Hashtable words are in the " { $vocab-link "hashtables" } " vocabulary. Unsafe implementation words are in the " { $vocab-link "hashtables.private" } " vocabulary." -$nl -"Hashtables implement the " { $link "assocs-protocol" } "." +"Words for constructing hashtables are in the " { $vocab-link "hashtables" } " vocabulary. Hashtables implement the " { $link "assocs-protocol" } ", and all " { $link "assocs" } " can be used on them; there are no hashtable-specific words to access and modify keys, because associative mapping operations are generic and work with all associative mappings." $nl "Hashtables are a class of objects." { $subsection hashtable } diff --git a/core/sbufs/sbufs-docs.factor b/core/sbufs/sbufs-docs.factor index f5a06b8beb..43168f47a8 100644 --- a/core/sbufs/sbufs-docs.factor +++ b/core/sbufs/sbufs-docs.factor @@ -3,11 +3,9 @@ help.syntax kernel vectors ; IN: sbufs ARTICLE: "sbufs" "String buffers" -"A string buffer is a resizable mutable sequence of characters. The literal syntax is covered in " { $link "syntax-sbufs" } "." +"The " { $vocab-link "sbufs" } " vocabulary implements resizable mutable sequence of characters. The literal syntax is covered in " { $link "syntax-sbufs" } "." $nl -"String buffers can be used to construct new strings by accumilating substrings and characters, however usually they are only used indirectly, since the sequence construction words are more convenient to use in most cases (see " { $link "namespaces-make" } ")." -$nl -"String buffer words are found in the " { $vocab-link "sbufs" } " vocabulary." +"String buffers implement the " { $link "sequence-protocol" } " and thus all " { $link "sequences" } " can be used with them. String buffers can be used to construct new strings by accumilating substrings and characters, however usually they are only used indirectly, since the sequence construction words are more convenient to use in most cases (see " { $link "namespaces-make" } ")." $nl "String buffers form a class of objects:" { $subsection sbuf } diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 6ca782a202..c12761ab38 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -247,12 +247,12 @@ HELP: array-capacity HELP: array-nth { $values { "n" "a non-negative fixnum" } { "array" "an array" } { "elt" object } } { $description "Low-level array element accessor." } -{ $warning "This word is in the " { $vocab-link "sequences.private" } " vocabulary because it is unsafe. It does not check types or array bounds, and improper use can corrupt memory." } ; +{ $warning "This word is in the " { $vocab-link "sequences.private" } " vocabulary because it is unsafe. It does not check types or array bounds, and improper use can corrupt memory. User code must use " { $link nth } " instead." } ; HELP: set-array-nth { $values { "elt" object } { "n" "a non-negative fixnum" } { "array" "an array" } } { $description "Low-level array element mutator." } -{ $warning "This word is in the " { $vocab-link "sequences.private" } " vocabulary because it is unsafe. It does not check types or array bounds, and improper use can corrupt memory." } ; +{ $warning "This word is in the " { $vocab-link "sequences.private" } " vocabulary because it is unsafe. It does not check types or array bounds, and improper use can corrupt memory. User code must use " { $link set-nth } " instead." } ; HELP: collect { $values { "n" "a non-negative integer" } { "quot" { $quotation "( n -- value )" } } { "into" "a sequence of length at least " { $snippet "n" } } } diff --git a/core/strings/strings-docs.factor b/core/strings/strings-docs.factor index 9a1671b126..c5ca2b129f 100644 --- a/core/strings/strings-docs.factor +++ b/core/strings/strings-docs.factor @@ -1,32 +1,25 @@ USING: arrays byte-arrays help.markup help.syntax kernel kernel.private strings.private sequences vectors -sbufs math ; +sbufs math tools.vocabs.browser ; IN: strings ARTICLE: "strings" "Strings" -"A string is a fixed-size mutable sequence of Unicode 5.1 code points." +"The " { $vocab-link "strings" } " vocabulary implements fixed-size mutable sequences of of Unicode 5.1 code points." $nl -"Characters are not a first-class type; they are simply represented as integers between 0 and 16777216 (2^24). Only characters up to 2097152 (2^21) have a defined meaning in Unicode." +"Code points, or characters as they're informally known, are not a first-class type; they are simply represented as integers in the range 0 and 16,777,216 (2^24), inclusive. Only characters up to 2,097,152 (2^21) have a defined meaning in Unicode." $nl "String literal syntax is covered in " { $link "syntax-strings" } "." $nl -"String words are found in the " { $vocab-link "strings" } " vocabulary." +"Since strings implement the " { $link "sequence-protocol" } ", basic string manipulation can be performed with " { $link "sequences" } " in the " { $vocab-link "sequences" } " vocabulary. More text processing functionality can be found in vocabularies carrying the " { $link T{ vocab-tag { name "text" } } } " tag." $nl "Strings form a class:" { $subsection string } { $subsection string? } -"Creating strings:" +"Creating new strings:" { $subsection >string } { $subsection } "Creating a string from a single character:" -{ $subsection 1string } -"Since strings are sequences, basic string manipulation can be performed using sequence operations (" { $link "sequences" } "). More advanced functionality can be found in other vocabularies, including but not limited to:" -{ $list - { { $link "ascii" } " - ASCII algorithms for interoperability with legacy applications" } - { { $link "unicode" } " - Unicode algorithms for modern multilingual applications" } - { { $vocab-link "regexp" } " - regular expressions" } - { { $vocab-link "peg" } " - parser expression grammars" } -} ; +{ $subsection 1string } ; ABOUT: "strings" diff --git a/core/vectors/vectors-docs.factor b/core/vectors/vectors-docs.factor index 2af1300498..fe40a27182 100644 --- a/core/vectors/vectors-docs.factor +++ b/core/vectors/vectors-docs.factor @@ -4,17 +4,23 @@ vectors.private combinators ; IN: vectors ARTICLE: "vectors" "Vectors" -"A vector is a resizable mutable sequence of objects. The literal syntax is covered in " { $link "syntax-vectors" } ". Vector words are found in the " { $vocab-link "vectors" } " vocabulary." +"The " { $vocab-link "vectors" } " vocabulary implements resizable mutable sequence which support the " { $link "sequence-protocol" } "." $nl -"Vectors form a class:" +"The " { $vocab-link "vectors" } " vocabulary only includes words for creating new vectors. To access and modify vector elements, use " { $link "sequences" } " in the " { $vocab-link "sequences" } " vocabulary." +$nl +"Vector literal syntax is documented in " { $link "syntax-vectors" } "." +$nl +"Vectors are intended to be used with " { $link "sequences-destructive" } ". Code that does not modify sequences in-place can use fixed-size arrays without loss of generality; see " { $link "arrays" } "." +$nl +"Vectors form a class of objects:" { $subsection vector } { $subsection vector? } -"Creating vectors:" +"Creating new vectors:" { $subsection >vector } { $subsection } "Creating a vector from a single element:" { $subsection 1vector } -"If you don't care about initial capacity, a more elegant way to create a new vector is to write:" +"If you don't care about initial capacity, an elegant way to create a new vector is to write:" { $code "V{ } clone" } ; ABOUT: "vectors" From 60d96b56cec0ed84364b840cb489c4dad7a47190 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 16 Feb 2009 21:13:49 -0600 Subject: [PATCH 015/119] Remove a rot usage --- basis/windows/shell32/shell32.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/windows/shell32/shell32.factor b/basis/windows/shell32/shell32.factor index 6d1c7b1a36..c8dbe4b91c 100644 --- a/basis/windows/shell32/shell32.factor +++ b/basis/windows/shell32/shell32.factor @@ -86,7 +86,7 @@ FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFi ALIAS: ShellExecute ShellExecuteW : open-in-explorer ( dir -- ) - f "open" rot (normalize-path) f f SW_SHOWNORMAL ShellExecute drop ; + [ f "open" ] dip (normalize-path) f f SW_SHOWNORMAL ShellExecute drop ; : shell32-directory ( n -- str ) f swap f SHGFP_TYPE_DEFAULT From 4944bc29f2a7445c987a118f267d1dcbf9dd7d61 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 16 Feb 2009 21:23:10 -0600 Subject: [PATCH 016/119] use CONSTANT: --- basis/nibble-arrays/nibble-arrays.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/nibble-arrays/nibble-arrays.factor b/basis/nibble-arrays/nibble-arrays.factor index d1ab0a34c1..22a1515908 100644 --- a/basis/nibble-arrays/nibble-arrays.factor +++ b/basis/nibble-arrays/nibble-arrays.factor @@ -10,7 +10,7 @@ TUPLE: nibble-array bytes ( m -- n ) 1 + 2/ ; inline From bff66cd47b77c27a1843ce8dda864e7eea05dbaa Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 16 Feb 2009 21:27:32 -0600 Subject: [PATCH 017/119] remove empty file --- basis/math/rectangles/positioning/positioning-docs.factor | 0 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 basis/math/rectangles/positioning/positioning-docs.factor diff --git a/basis/math/rectangles/positioning/positioning-docs.factor b/basis/math/rectangles/positioning/positioning-docs.factor deleted file mode 100644 index e69de29bb2..0000000000 From 53224ebce09920e6d7a1523634a61dabb87a978a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 16 Feb 2009 21:29:13 -0600 Subject: [PATCH 018/119] remove empty file --- core/io/streams/null/null-tests.factor | 0 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 core/io/streams/null/null-tests.factor diff --git a/core/io/streams/null/null-tests.factor b/core/io/streams/null/null-tests.factor deleted file mode 100644 index e69de29bb2..0000000000 From f1cc9e7ebbaf1452f1a97dcbf6cf7f1514bcb2ff Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 16 Feb 2009 21:29:28 -0600 Subject: [PATCH 019/119] add author --- extra/serial/windows/authors.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/extra/serial/windows/authors.txt b/extra/serial/windows/authors.txt index e69de29bb2..7c1b2f2279 100755 --- a/extra/serial/windows/authors.txt +++ b/extra/serial/windows/authors.txt @@ -0,0 +1 @@ +Doug Coleman From f79f49a349a002bfe429c0d5c6397d6c8152701b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 16 Feb 2009 21:30:22 -0600 Subject: [PATCH 020/119] remove empty file --- basis/io/encodings/korean/korean-docs.factor | 0 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 basis/io/encodings/korean/korean-docs.factor diff --git a/basis/io/encodings/korean/korean-docs.factor b/basis/io/encodings/korean/korean-docs.factor deleted file mode 100644 index e69de29bb2..0000000000 From 13d96df8b65a1863f149dcc578fdf4d2588a06ad Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 16 Feb 2009 21:42:09 -0600 Subject: [PATCH 021/119] Add unit test for >alist on linked-assocs --- basis/linked-assocs/linked-assocs-tests.factor | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/basis/linked-assocs/linked-assocs-tests.factor b/basis/linked-assocs/linked-assocs-tests.factor index 7a259ee59a..5030e93abc 100644 --- a/basis/linked-assocs/linked-assocs-tests.factor +++ b/basis/linked-assocs/linked-assocs-tests.factor @@ -54,4 +54,12 @@ IN: linked-assocs.test { [ [ 1- ] bi@ ] [ 2 / ] } "second" pick set-at 4 6 pick values [ first call ] each + swap values [ second call ] each +] unit-test + +{ V{ { "az" 1 } { "by" 2 } { "cx" 3 } } } [ + + 1 "az" pick set-at + 2 "by" pick set-at + 3 "cx" pick set-at + >alist ] unit-test \ No newline at end of file From be46168a24c0665d2f3e46821624b8636010723d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 16 Feb 2009 21:42:47 -0600 Subject: [PATCH 022/119] define-operation doesn't add duplicate operations anymore; ui.operations initializes operations global variable automatically --- basis/ui/operations/operations.factor | 15 +++++++++++---- basis/ui/tools/operations/operations.factor | 2 -- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/basis/ui/operations/operations.factor b/basis/ui/operations/operations.factor index bcfca946dd..8ba0e5dac7 100644 --- a/basis/ui/operations/operations.factor +++ b/basis/ui/operations/operations.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2006, 2008 Slava Pestov. +! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays definitions kernel ui.commands ui.gestures sequences strings math words generic namespaces make -hashtables help.markup quotations assocs fry ; +hashtables help.markup quotations assocs fry linked-assocs ; IN: ui.operations SYMBOL: +keyboard+ @@ -34,8 +34,11 @@ M: operation command-word command>> command-word ; SYMBOL: operations +operations [ ] initialize + : object-operations ( obj -- operations ) - operations get [ predicate>> call ] with filter ; + operations get values + [ predicate>> call ] with filter ; : find-operation ( obj quot -- command ) [ object-operations ] dip find-last nip ; inline @@ -51,10 +54,14 @@ SYMBOL: operations : default-flags ( -- assoc ) H{ { +keyboard+ f } { +primary+ f } { +secondary+ f } } ; +: (define-operation) ( operation -- ) + dup [ command>> ] [ predicate>> ] bi + 2array operations get set-at ; + : define-operation ( pred command flags -- ) default-flags swap assoc-union dupd define-command - operations get push ; + (define-operation) ; : modify-operation ( hook translator operation -- operation ) clone diff --git a/basis/ui/tools/operations/operations.factor b/basis/ui/tools/operations/operations.factor index a9405424dc..d8802d66c9 100644 --- a/basis/ui/tools/operations/operations.factor +++ b/basis/ui/tools/operations/operations.factor @@ -12,8 +12,6 @@ sequences tools.vocabs classes compiler.units accessors vocabs.parser ; IN: ui.tools.operations -V{ } clone operations set-global - ! Objects [ drop t ] \ inspect H{ { +primary+ t } From 8169c35b9ef5b2e25d7a439dcd2c80f712ed73b0 Mon Sep 17 00:00:00 2001 From: "Yun, Jonghyouk" Date: Tue, 17 Feb 2009 16:40:01 +0900 Subject: [PATCH 023/119] io.encodings.korean TODOs --- basis/io/encodings/korean/korean.factor | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/basis/io/encodings/korean/korean.factor b/basis/io/encodings/korean/korean.factor index cd98bb1eb0..8771c1d928 100644 --- a/basis/io/encodings/korean/korean.factor +++ b/basis/io/encodings/korean/korean.factor @@ -6,6 +6,11 @@ math.order math.parser memoize multiline sequences splitting values hashtables io.binary ; IN: io.encodings.korean +! TODO: write-docs +! TODO: euckr, cp949 seperate (euckr: backslash = Won, cp949: bs <> Won) +! TODO: no byte manip. only code-tables. +! TODO: migrate to common code-table parser (by Dan). + SINGLETON: cp949 cp949 "EUC-KR" register-encoding From da9ae85637008259c5da1e21b5c070c672fce651 Mon Sep 17 00:00:00 2001 From: "Yun, Jonghyouk" Date: Tue, 17 Feb 2009 21:46:57 +0900 Subject: [PATCH 024/119] io.encodings.korean some docs. --- basis/io/encodings/korean/korean-docs.factor | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 basis/io/encodings/korean/korean-docs.factor diff --git a/basis/io/encodings/korean/korean-docs.factor b/basis/io/encodings/korean/korean-docs.factor new file mode 100644 index 0000000000..2500e794a7 --- /dev/null +++ b/basis/io/encodings/korean/korean-docs.factor @@ -0,0 +1,14 @@ +! Copyright (C) 2009 Yun, Jonghyouk. +! See http://factorcode.org/license.txt for BSD license. +USING: help.syntax help.markup ; +IN: io.encodings.korean + +ARTICLE: "io.encodings.korean" "Korean text encodings" +"The " { $vocab-link "io.encodings.korean" } " vocabulary implements encodings used for Korean text besides the standard UTF encodings for Unicode strings." +{ $subsection cp949 } ; + +ABOUT: "io.encodings.korean" + +HELP: cp949 +{ $class-description "This encoding class implements Microsoft's code page #949 encoding, also called Unified Hangul Code or ks_c_5601-1987, UHC. CP949 is extended version of EUC-KR and downward-compatibility to EUC-KR. " } +{ $see-also "encodings-introduction" } ; From 89a3e45a3abe17c8a3199391213d0db00502a570 Mon Sep 17 00:00:00 2001 From: "Yun, Jonghyouk" Date: Tue, 17 Feb 2009 21:47:45 +0900 Subject: [PATCH 025/119] io.encodings.korean TODOs comment --- basis/io/encodings/korean/korean.factor | 1 - 1 file changed, 1 deletion(-) diff --git a/basis/io/encodings/korean/korean.factor b/basis/io/encodings/korean/korean.factor index 8771c1d928..c1fed1d57c 100644 --- a/basis/io/encodings/korean/korean.factor +++ b/basis/io/encodings/korean/korean.factor @@ -6,7 +6,6 @@ math.order math.parser memoize multiline sequences splitting values hashtables io.binary ; IN: io.encodings.korean -! TODO: write-docs ! TODO: euckr, cp949 seperate (euckr: backslash = Won, cp949: bs <> Won) ! TODO: no byte manip. only code-tables. ! TODO: migrate to common code-table parser (by Dan). From 4440a210b101b3cbde5ca545f4c2d3d4a104973a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 17 Feb 2009 11:28:43 -0600 Subject: [PATCH 026/119] make io.servers.packet load again --- basis/io/servers/packet/{datagram.factor => packet.factor} | 3 +++ 1 file changed, 3 insertions(+) rename basis/io/servers/packet/{datagram.factor => packet.factor} (80%) diff --git a/basis/io/servers/packet/datagram.factor b/basis/io/servers/packet/packet.factor similarity index 80% rename from basis/io/servers/packet/datagram.factor rename to basis/io/servers/packet/packet.factor index c081dfb0fa..3f092ab9f1 100644 --- a/basis/io/servers/packet/datagram.factor +++ b/basis/io/servers/packet/packet.factor @@ -1,3 +1,5 @@ +USING: concurrency.combinators destructors fry +io.servers.datagram.private io.sockets kernel logging ; IN: io.servers.datagram : with-datagrams ( seq service quot -- ) + [ DEBUG ] dip '[ [ [ _ ] dip spawn-datagrams ] parallel-each ] with-logging ; inline From d92b02b0c29414e6b8ddf5242451024d8a8fedc8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 17 Feb 2009 11:30:06 -0600 Subject: [PATCH 027/119] use the new with-logging --- basis/io/servers/connection/connection.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor index bc90915213..91fb3bfb37 100644 --- a/basis/io/servers/connection/connection.factor +++ b/basis/io/servers/connection/connection.factor @@ -12,6 +12,7 @@ IN: io.servers.connection TUPLE: threaded-server name +log-level secure insecure secure-config sockets @@ -29,6 +30,7 @@ ready ; : new-threaded-server ( class -- threaded-server ) new "server" >>name + DEBUG >>log-level ascii >>encoding 1 minutes >>timeout V{ } clone >>sockets @@ -115,7 +117,7 @@ M: threaded-server handle-client* handler>> call ; : (start-server) ( threaded-server -- ) init-server dup threaded-server [ - dup name>> [ + [ ] [ name>> ] [ log-level>> ] tri [ [ listen-on [ start-accept-loop ] parallel-each ] [ ready>> raise-flag ] bi From e55425a65e20565879fb728ebe22e3a18aa892e8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 17 Feb 2009 11:30:28 -0600 Subject: [PATCH 028/119] with-logging takes a log-level, more docs --- basis/logging/insomniac/insomniac.factor | 2 +- basis/logging/logging-docs.factor | 11 +++++---- basis/logging/logging.factor | 30 ++++++++++++++++++++---- basis/logging/parser/parser.factor | 4 ++-- 4 files changed, 35 insertions(+), 12 deletions(-) diff --git a/basis/logging/insomniac/insomniac.factor b/basis/logging/insomniac/insomniac.factor index 91baae631f..935326da2d 100644 --- a/basis/logging/insomniac/insomniac.factor +++ b/basis/logging/insomniac/insomniac.factor @@ -30,7 +30,7 @@ SYMBOL: insomniac-recipients \ (email-log-report) NOTICE add-error-logging : email-log-report ( service word-names -- ) - "logging.insomniac" [ (email-log-report) ] with-logging ; + "logging.insomniac" DEBUG [ (email-log-report) ] with-logging ; : schedule-insomniac ( service word-names -- ) [ [ email-log-report ] assoc-each rotate-logs ] 2curry diff --git a/basis/logging/logging-docs.factor b/basis/logging/logging-docs.factor index 275d900f3d..64956493c6 100644 --- a/basis/logging/logging-docs.factor +++ b/basis/logging/logging-docs.factor @@ -8,6 +8,9 @@ HELP: DEBUG HELP: NOTICE { $description "Log level for ordinary messages." } ; +HELP: WARNING +{ $description "Log level for warnings." } ; + HELP: ERROR { $description "Log level for error messages." } ; @@ -18,6 +21,7 @@ ARTICLE: "logging.levels" "Log levels" "Several log levels are supported, from lowest to highest:" { $subsection DEBUG } { $subsection NOTICE } +{ $subsection WARNING } { $subsection ERROR } { $subsection CRITICAL } ; @@ -36,7 +40,7 @@ ARTICLE: "logging.files" "Log files" HELP: log-message { $values { "msg" string } { "word" word } { "level" "a log level" } } -{ $description "Sends a message to the current log. Does nothing if not executing in a dynamic scope established by " { $link with-logging } "." } ; +{ $description "Sends a message to the current log if the level is more urgent than " { $link log-level } ". Does nothing if not executing in a dynamic scope established by " { $link with-logging } "." } ; HELP: add-logging { $values { "level" "a log level" } { "word" word } } @@ -90,8 +94,8 @@ HELP: close-logs { $description "Closes all open log streams. Subsequent logging will re-open the streams. This should be used before moving or deleting log files." } ; HELP: with-logging -{ $values { "service" "a log service name" } { "quot" quotation } } -{ $description "Calls the quotation a new dynamic scope where all logging calls are sent to the log file for " { $snippet "service" } "." } ; +{ $values { "service" "a log service name" } { "level" "a log level" } { "quot" quotation } } +{ $description "Calls the quotation a new dynamic scope where all logging calls more urgent than " { $link log-level } " are sent to the log file for " { $snippet "service" } "." } ; ARTICLE: "logging.rotation" "Log rotation" "Log files should be rotated periodically to prevent unbounded growth." @@ -120,4 +124,3 @@ ARTICLE: "logging" "Logging framework" { $subsection "logging.server" } ; ABOUT: "logging" - diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor index 6769932c88..2389389074 100644 --- a/basis/logging/logging.factor +++ b/basis/logging/logging.factor @@ -4,12 +4,29 @@ USING: logging.server sequences namespaces concurrency.messaging words kernel arrays shuffle tools.annotations prettyprint.config prettyprint debugger io.streams.string splitting continuations effects generalizations parser strings -quotations fry accessors ; +quotations fry accessors math assocs math.order ; IN: logging SYMBOLS: DEBUG NOTICE WARNING ERROR CRITICAL ; -: log-levels { DEBUG NOTICE NOTICE WARNING ERROR CRITICAL } ; +SYMBOL: log-level + +: log-levels ( -- assoc ) + H{ + { DEBUG 0 } + { NOTICE 10 } + { WARNING 20 } + { ERROR 30 } + { CRITICAL 40 } + } ; + +ERROR: undefined-log-level ; + +: log-level<=> ( log-level log-level -- ? ) + [ log-levels at* [ undefined-log-level ] unless ] bi@ <=> ; + +: log? ( log-level -- ? ) + log-level get log-level<=> +lt+ = not ; : send-to-log-server ( array string -- ) prefix "log-server" get send ; @@ -22,7 +39,8 @@ SYMBOL: log-service : log-message ( msg word level -- ) check-log-message - log-service get dup [ + dup log? + log-service get dup and [ [ [ string-lines ] [ name>> ] [ name>> ] tri* ] dip 4array "log-message" send-to-log-server ] [ @@ -35,8 +53,10 @@ SYMBOL: log-service : close-logs ( -- ) { } "close-logs" send-to-log-server ; -: with-logging ( service quot -- ) - log-service swap with-variable ; inline +: with-logging ( service level quot -- ) + '[ + _ log-service [ _ log-level _ with-variable ] with-variable + ] call ; inline ! Aspect-oriented programming idioms diff --git a/basis/logging/parser/parser.factor b/basis/logging/parser/parser.factor index 07a84ec5c6..5406d8fcd0 100644 --- a/basis/logging/parser/parser.factor +++ b/basis/logging/parser/parser.factor @@ -3,7 +3,7 @@ USING: accessors peg peg.parsers memoize kernel sequences logging arrays words strings vectors io io.files io.encodings.utf8 namespaces make combinators logging.server -calendar calendar.format ; +calendar calendar.format assocs ; IN: logging.parser TUPLE: log-entry date level word-name message ; @@ -21,7 +21,7 @@ SYMBOL: multiline "[" "]" surrounded-by ; : 'log-level' ( -- parser ) - log-levels [ + log-levels keys [ [ name>> token ] keep [ nip ] curry action ] map choice ; From bf3ef49dd0492f2b2a93d1dcfd002cb753bb67d6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 17 Feb 2009 11:31:01 -0600 Subject: [PATCH 029/119] with-logging change --- extra/spider/spider.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/spider/spider.factor b/extra/spider/spider.factor index bd5b2668be..0f702d7d22 100644 --- a/extra/spider/spider.factor +++ b/extra/spider/spider.factor @@ -88,7 +88,7 @@ links processing-time timestamp ; PRIVATE> : run-spider ( spider -- spider ) - "spider" [ + "spider" DEBUG [ dup spider [ queue-initial-links [ todo>> ] [ max-depth>> ] bi From b3e3c74561d6b23c875e2d2cc2c06581a7b11839 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 17 Feb 2009 11:40:50 -0600 Subject: [PATCH 030/119] add ; to word definition in stack-checker docs --- basis/stack-checker/stack-checker-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/stack-checker/stack-checker-docs.factor b/basis/stack-checker/stack-checker-docs.factor index 5926f08d8c..db8abac441 100644 --- a/basis/stack-checker/stack-checker-docs.factor +++ b/basis/stack-checker/stack-checker-docs.factor @@ -56,7 +56,7 @@ ARTICLE: "inference-recursive" "Stack effects of recursive words" "When a recursive call is encountered, the declared stack effect is substituted in. When inference is complete, the inferred stack effect is compared with the declared stack effect." $nl "Attempting to infer the stack effect of a recursive word which outputs a variable number of objects on the stack will fail. For example, the following will throw an " { $link unbalanced-branches-error } ":" -{ $code ": foo ( seq -- ) dup empty? [ drop ] [ dup pop foo ] if" "[ foo ] infer." } +{ $code ": foo ( seq -- ) dup empty? [ drop ] [ dup pop foo ] if ;" "[ foo ] infer." } "If you declare an incorrect stack effect, inference will fail also. Badly defined recursive words cannot confuse the inferencer." ; ARTICLE: "inference-recursive-combinators" "Recursive combinator inference" From cbe99c4bedbda5520c1ae7aa7e6804277c5a914e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 17 Feb 2009 12:36:27 -0600 Subject: [PATCH 031/119] use +foo+ as symbol names --- basis/tools/files/files.factor | 49 ++++++++++++------------ basis/tools/files/unix/unix.factor | 19 +++++---- basis/tools/files/windows/windows.factor | 2 +- 3 files changed, 37 insertions(+), 33 deletions(-) diff --git a/basis/tools/files/files.factor b/basis/tools/files/files.factor index 7508c37cac..8d882099de 100755 --- a/basis/tools/files/files.factor +++ b/basis/tools/files/files.factor @@ -35,9 +35,10 @@ IN: tools.files PRIVATE> -SYMBOLS: file-name file-name/type permissions file-type nlinks file-size -file-date file-time file-datetime uid gid user group link-target unix-datetime -directory-or-size ; +SYMBOLS: +file-name+ +file-name/type+ +permissions+ +file-type+ ++nlinks+ +file-size+ +file-date+ +file-time+ +file-datetime+ ++uid+ +gid+ +user+ +group+ +link-target+ +unix-datetime+ ++directory-or-size+ ; TUPLE: listing-tool path specs sort ; @@ -48,10 +49,10 @@ C: file-listing : ( path -- listing-tool ) listing-tool new swap >>path - { file-name } >>specs ; + { +file-name+ } >>specs ; : list-slow? ( listing-tool -- ? ) - specs>> { file-name } sequence= not ; + specs>> { +file-name+ } sequence= not ; ERROR: unknown-file-spec symbol ; @@ -59,12 +60,12 @@ HOOK: file-spec>string os ( file-listing spec -- string ) M: object file-spec>string ( file-listing spec -- string ) { - { file-name [ directory-entry>> name>> ] } - { directory-or-size [ file-info>> dir-or-size ] } - { file-size [ file-info>> size>> number>string ] } - { file-date [ file-info>> modified>> listing-date ] } - { file-time [ file-info>> modified>> listing-time ] } - { file-datetime [ file-info>> modified>> timestamp>ymdhms ] } + { +file-name+ [ directory-entry>> name>> ] } + { +directory-or-size+ [ file-info>> dir-or-size ] } + { +file-size+ [ file-info>> size>> number>string ] } + { +file-date+ [ file-info>> modified>> listing-date ] } + { +file-time+ [ file-info>> modified>> listing-time ] } + { +file-datetime+ [ file-info>> modified>> timestamp>ymdhms ] } [ unknown-file-spec ] } case ; @@ -85,22 +86,22 @@ HOOK: (directory.) os ( path -- lines ) : directory. ( path -- ) (directory.) simple-table. ; -SYMBOLS: device-name mount-point type -available-space free-space used-space total-space -percent-used percent-free ; +SYMBOLS: +device-name+ +mount-point+ +type+ ++available-space+ +free-space+ +used-space+ +total-space+ ++percent-used+ +percent-free+ ; : percent ( real -- integer ) 100 * >integer ; inline : file-system-spec ( file-system-info obj -- str ) { - { device-name [ device-name>> "" or ] } - { mount-point [ mount-point>> "" or ] } - { type [ type>> "" or ] } - { available-space [ available-space>> 0 or ] } - { free-space [ free-space>> 0 or ] } - { used-space [ used-space>> 0 or ] } - { total-space [ total-space>> 0 or ] } - { percent-used [ + { +device-name+ [ device-name>> "" or ] } + { +mount-point+ [ mount-point>> "" or ] } + { +type+ [ type>> "" or ] } + { +available-space+ [ available-space>> 0 or ] } + { +free-space+ [ free-space>> 0 or ] } + { +used-space+ [ used-space>> 0 or ] } + { +total-space+ [ total-space>> 0 or ] } + { +percent-used+ [ [ used-space>> ] [ total-space>> ] bi [ 0 or ] bi@ dup 0 = [ 2drop 0 ] [ / percent ] if @@ -116,8 +117,8 @@ percent-used percent-free ; : file-systems. ( -- ) { - device-name available-space free-space used-space - total-space percent-used mount-point + +device-name+ +available-space+ +free-space+ +used-space+ + +total-space+ +percent-used+ +mount-point+ } print-file-systems ; { diff --git a/basis/tools/files/unix/unix.factor b/basis/tools/files/unix/unix.factor index e63ab09076..90e91529a1 100755 --- a/basis/tools/files/unix/unix.factor +++ b/basis/tools/files/unix/unix.factor @@ -47,21 +47,24 @@ IN: tools.files.unix M: unix (directory.) ( path -- lines ) - { permissions nlinks user group file-size file-date file-name } >>specs + { + +permissions+ +nlinks+ +user+ +group+ + +file-size+ +file-date+ +file-name+ + } >>specs { { directory-entry>> name>> <=> } } >>sort [ [ list-files ] with-group-cache ] with-user-cache ; M: unix file-spec>string ( file-listing spec -- string ) { - { file-name/type [ + { +file-name/type+ [ directory-entry>> [ name>> ] [ file-type>trailing ] bi append ] } - { permissions [ file-info>> permissions-string ] } - { nlinks [ file-info>> nlink>> number>string ] } - { user [ file-info>> uid>> user-name ] } - { group [ file-info>> gid>> group-name ] } - { uid [ file-info>> uid>> number>string ] } - { gid [ file-info>> gid>> number>string ] } + { +permissions+ [ file-info>> permissions-string ] } + { +nlinks+ [ file-info>> nlink>> number>string ] } + { +user+ [ file-info>> uid>> user-name ] } + { +group+ [ file-info>> gid>> group-name ] } + { +uid+ [ file-info>> uid>> number>string ] } + { +gid+ [ file-info>> gid>> number>string ] } [ call-next-method ] } case ; diff --git a/basis/tools/files/windows/windows.factor b/basis/tools/files/windows/windows.factor index f321c2fc7f..874b2ef5c1 100755 --- a/basis/tools/files/windows/windows.factor +++ b/basis/tools/files/windows/windows.factor @@ -9,7 +9,7 @@ IN: tools.files.windows M: windows (directory.) ( entries -- lines ) - { file-datetime directory-or-size file-name } >>specs + { +file-datetime+ +directory-or-size+ +file-name+ } >>specs { { directory-entry>> name>> <=> } } >>sort list-files ; From 894ba6182ec2cd9fa3e19df0db1bfd389f2c19d8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 17 Feb 2009 17:09:27 -0600 Subject: [PATCH 032/119] add timestamp>mdtm to calendar.format --- basis/calendar/format/format-tests.factor | 7 +++++++ basis/calendar/format/format.factor | 3 +++ 2 files changed, 10 insertions(+) diff --git a/basis/calendar/format/format-tests.factor b/basis/calendar/format/format-tests.factor index 81930cdf49..f8864351a4 100644 --- a/basis/calendar/format/format-tests.factor +++ b/basis/calendar/format/format-tests.factor @@ -51,6 +51,11 @@ IN: calendar.format.tests timestamp>string ] unit-test +[ "20080504070000" ] [ + "Sun May 04 07:00:00 2008 GMT" cookie-string>timestamp + timestamp>mdtm +] unit-test + [ T{ timestamp f 2008 @@ -74,3 +79,5 @@ IN: calendar.format.tests { gmt-offset T{ duration f 0 0 0 0 0 0 } } } ] [ "Thursday, 02-Oct-2008 23:59:59 GMT" cookie-string>timestamp ] unit-test + + diff --git a/basis/calendar/format/format.factor b/basis/calendar/format/format.factor index 15a4cb8266..916d3499fe 100644 --- a/basis/calendar/format/format.factor +++ b/basis/calendar/format/format.factor @@ -78,6 +78,9 @@ M: integer year. ( n -- ) M: timestamp year. ( timestamp -- ) year>> year. ; +: timestamp>mdtm ( timestamp -- str ) + [ { YYYY MM DD hh mm ss } formatted ] with-string-writer ; + : (timestamp>string) ( timestamp -- ) { DAY ", " D " " MONTH " " YYYY " " hh ":" mm ":" ss } formatted ; From fdad5d4d979cd004dd11ab0cb7b419589a4d4932 Mon Sep 17 00:00:00 2001 From: "Yun, Jonghyouk" Date: Wed, 18 Feb 2009 19:19:18 +0900 Subject: [PATCH 033/119] io.encodings.korean TODO removes --- basis/io/encodings/korean/korean.factor | 2 -- 1 file changed, 2 deletions(-) diff --git a/basis/io/encodings/korean/korean.factor b/basis/io/encodings/korean/korean.factor index c1fed1d57c..a021cfce33 100644 --- a/basis/io/encodings/korean/korean.factor +++ b/basis/io/encodings/korean/korean.factor @@ -6,8 +6,6 @@ math.order math.parser memoize multiline sequences splitting values hashtables io.binary ; IN: io.encodings.korean -! TODO: euckr, cp949 seperate (euckr: backslash = Won, cp949: bs <> Won) -! TODO: no byte manip. only code-tables. ! TODO: migrate to common code-table parser (by Dan). SINGLETON: cp949 From 2af9d5a6df34a3a6f1473aa959cc2e68902ead1f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 18 Feb 2009 13:33:55 -0600 Subject: [PATCH 034/119] add canonicalize-path, fix a bug in file-extension --- core/io/pathnames/pathnames-docs.factor | 14 +++++++++++++- core/io/pathnames/pathnames-tests.factor | 4 ++++ core/io/pathnames/pathnames.factor | 9 ++++++++- 3 files changed, 25 insertions(+), 2 deletions(-) diff --git a/core/io/pathnames/pathnames-docs.factor b/core/io/pathnames/pathnames-docs.factor index a4f261391a..f5ad6e533b 100644 --- a/core/io/pathnames/pathnames-docs.factor +++ b/core/io/pathnames/pathnames-docs.factor @@ -1,4 +1,5 @@ -USING: help.markup help.syntax io.backend io.files strings ; +USING: help.markup help.syntax io.backend io.files strings +sequences ; IN: io.pathnames HELP: path-separator? @@ -22,6 +23,10 @@ HELP: file-name { $example "USING: io.pathnames prettyprint ;" "\"/usr/libexec/awk/\" file-name ." "\"awk\"" } } ; +HELP: path-components +{ $values { "path" "a pathnames string" } { "seq" sequence } } +{ $description "Splits a pathname on the " { $link path-separator } " into its its component strings." } ; + HELP: append-path { $values { "str1" "a string" } { "str2" "a string" } { "str" "a string" } } { $description "Appends " { $snippet "str1" } " and " { $snippet "str2" } " to form a pathname." } ; @@ -57,6 +62,10 @@ HELP: normalize-path { $values { "str" "a pathname string" } { "newstr" "a new pathname string" } } { $description "Called by words such as " { $link } " and " { $link } " to prepare a pathname before passing it to underlying code." } ; +HELP: canonicalize-path +{ $values { "path" "a pathname string" } { "path'" "a new pathname string" } } +{ $description "Returns an canonical name for a path. The canonical name is an absolute path containing no symlinks." } ; + HELP: { $values { "string" "a pathname string" } { "pathname" pathname } } { $description "Creates a new " { $link pathname } "." } ; @@ -74,9 +83,12 @@ ARTICLE: "io.pathnames" "Pathname manipulation" { $subsection POSTPONE: P" } "Pathname manipulation:" { $subsection normalize-path } +{ $subsection canonicalize-path } { $subsection parent-directory } { $subsection file-name } { $subsection last-path-separator } +{ $subsection path-components } +{ $subsection prepend-path } { $subsection append-path } "Pathname presentations:" { $subsection pathname } diff --git a/core/io/pathnames/pathnames-tests.factor b/core/io/pathnames/pathnames-tests.factor index 41498fa15a..c3e419e60d 100644 --- a/core/io/pathnames/pathnames-tests.factor +++ b/core/io/pathnames/pathnames-tests.factor @@ -66,3 +66,7 @@ IN: io.pathnames.tests ] with-scope [ t ] [ cwd "misc" resource-path [ ] with-directory cwd = ] unit-test + +! Regression test for bug in file-extension +[ f ] [ "/funny.directory/file-with-no-extension" file-extension ] unit-test +[ "" ] [ "/funny.directory/file-with-no-extension." file-extension ] unit-test diff --git a/core/io/pathnames/pathnames.factor b/core/io/pathnames/pathnames.factor index 96ac872826..eba3e6a19f 100644 --- a/core/io/pathnames/pathnames.factor +++ b/core/io/pathnames/pathnames.factor @@ -119,7 +119,14 @@ PRIVATE> ] unless ; : file-extension ( filename -- extension ) - "." split1-last nip ; + file-name "." split1-last nip ; + +: path-components ( path -- seq ) + normalize-path path-separator split harvest ; + +HOOK: canonicalize-path os ( path -- path' ) + +M: object canonicalize-path normalize-path ; : resource-path ( path -- newpath ) "resource-path" get prepend-path ; From 6324fb6c13c3d74b6cf7e2d8b272163ba39f71af Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 18 Feb 2009 13:34:45 -0600 Subject: [PATCH 035/119] add unix canonicalize-path --- basis/io/files/info/unix/linux/linux.factor | 3 ++- basis/io/files/links/unix/unix.factor | 7 ++++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/basis/io/files/info/unix/linux/linux.factor b/basis/io/files/info/unix/linux/linux.factor index 5dddca4f9d..72401004ae 100644 --- a/basis/io/files/info/unix/linux/linux.factor +++ b/basis/io/files/info/unix/linux/linux.factor @@ -72,13 +72,14 @@ M: linux file-systems ] map ; : (find-mount-point) ( path mtab-paths -- mtab-entry ) - [ follow-links ] dip 2dup at* [ + 2dup at* [ 2nip ] [ drop [ parent-directory ] dip (find-mount-point) ] if ; : find-mount-point ( path -- mtab-entry ) + canonicalize-path parse-mtab [ [ mount-point>> ] keep ] H{ } map>assoc (find-mount-point) ; ERROR: file-system-not-found ; diff --git a/basis/io/files/links/unix/unix.factor b/basis/io/files/links/unix/unix.factor index 2f38c39e02..7d2a6ee4f3 100644 --- a/basis/io/files/links/unix/unix.factor +++ b/basis/io/files/links/unix/unix.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: io.backend io.files.links system unix ; +USING: io.backend io.files.links system unix io.pathnames kernel +io.files sequences ; IN: io.files.links.unix M: unix make-link ( path1 path2 -- ) @@ -8,3 +9,7 @@ M: unix make-link ( path1 path2 -- ) M: unix read-link ( path -- path' ) normalize-path read-symbolic-link ; + +M: unix canonicalize-path ( path -- path' ) + path-components "/" + [ append-path dup exists? [ follow-links ] when ] reduce ; From 1045b904be7c85521cea91992a6263f38cb07013 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 18 Feb 2009 13:35:55 -0600 Subject: [PATCH 036/119] fix logging check, unit tests --- basis/logging/logging-tests.factor | 2 +- basis/logging/logging.factor | 8 +++++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/basis/logging/logging-tests.factor b/basis/logging/logging-tests.factor index 796c8769fc..63eecc7319 100644 --- a/basis/logging/logging-tests.factor +++ b/basis/logging/logging-tests.factor @@ -13,7 +13,7 @@ USING: tools.test logging math ; \ error-logging-test ERROR add-error-logging -"logging-test" [ +"logging-test" DEBUG [ [ 4 ] [ 1 3 input-logging-test ] unit-test [ 4 ] [ 1 3 output-logging-test ] unit-test diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor index 2389389074..496dae2c61 100644 --- a/basis/logging/logging.factor +++ b/basis/logging/logging.factor @@ -33,14 +33,16 @@ ERROR: undefined-log-level ; SYMBOL: log-service +ERROR: bad-log-message-parameters msg word level ; + : check-log-message ( msg word level -- msg word level ) 3dup [ string? ] [ word? ] [ word? ] tri* and and - [ "Bad parameters to log-message" throw ] unless ; inline + [ bad-log-message-parameters ] unless ; inline : log-message ( msg word level -- ) check-log-message - dup log? - log-service get dup and [ + log-service get + 2dup [ log? ] [ ] bi* and [ [ [ string-lines ] [ name>> ] [ name>> ] tri* ] dip 4array "log-message" send-to-log-server ] [ From 966627a1e2b1168d7d34dbd50cabc0961641abe9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 18 Feb 2009 13:36:23 -0600 Subject: [PATCH 037/119] make ftp server work with firefox, simplify some code --- basis/ftp/ftp.factor | 9 +- basis/ftp/server/server.factor | 406 +++++++++++++++++---------------- 2 files changed, 212 insertions(+), 203 deletions(-) diff --git a/basis/ftp/ftp.factor b/basis/ftp/ftp.factor index adf7d5b41b..27eebc5946 100644 --- a/basis/ftp/ftp.factor +++ b/basis/ftp/ftp.factor @@ -4,8 +4,7 @@ USING: accessors arrays assocs combinators io io.files kernel math.parser sequences strings ; IN: ftp -SINGLETON: active -SINGLETON: passive +SYMBOLS: +active+ +passive+ ; TUPLE: ftp-response n strings parsed ; @@ -17,5 +16,7 @@ TUPLE: ftp-response n strings parsed ; over strings>> push ; : ftp-send ( string -- ) write "\r\n" write flush ; -: ftp-ipv4 1 ; inline -: ftp-ipv6 2 ; inline + +CONSTANT: ftp-ipv4 1 + +CONSTANT: ftp-ipv6 2 diff --git a/basis/ftp/server/server.factor b/basis/ftp/server/server.factor index 20a753785c..ffe16b2f4c 100644 --- a/basis/ftp/server/server.factor +++ b/basis/ftp/server/server.factor @@ -1,52 +1,46 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: combinators.short-circuit accessors combinators io -io.encodings.8-bit io.encodings io.encodings.binary -io.encodings.utf8 io.files io.files.info io.directories -io.sockets kernel math.parser namespaces make sequences -ftp io.launcher.unix.parser unicode.case splitting -assocs classes io.servers.connection destructors calendar -io.timeouts io.streams.duplex threads continuations math -concurrency.promises byte-arrays io.backend tools.hexdump -io.streams.string math.bitwise tools.files io.pathnames ; +USING: accessors assocs byte-arrays calendar classes +combinators combinators.short-circuit concurrency.promises +continuations destructors ftp io io.backend io.directories +io.encodings io.encodings.8-bit io.encodings.binary +tools.files io.encodings.utf8 io.files io.files.info +io.pathnames io.launcher.unix.parser io.servers.connection +io.sockets io.streams.duplex io.streams.string io.timeouts +kernel make math math.bitwise math.parser namespaces sequences +splitting threads unicode.case logging calendar.format +strings io.files.links io.files.types ; IN: ftp.server -TUPLE: ftp-client url mode state command-promise user password ; - -: ( url -- ftp-client ) - ftp-client new - swap >>url ; - +SYMBOL: server SYMBOL: client -: ftp-server-directory ( -- str ) - \ ftp-server-directory get-global "resource:temp" or - normalize-path ; +TUPLE: ftp-server < threaded-server { serving-directory string } ; + +TUPLE: ftp-client user password extra-connection ; TUPLE: ftp-command raw tokenized ; - -: ( -- obj ) - ftp-command new ; +: ( str -- obj ) + dup \ DEBUG log-message + ftp-command new + over >>raw + swap tokenize-command >>tokenized ; TUPLE: ftp-get path ; - : ( path -- obj ) ftp-get new swap >>path ; TUPLE: ftp-put path ; - : ( path -- obj ) ftp-put new swap >>path ; TUPLE: ftp-list ; - C: ftp-list -: read-command ( -- ftp-command ) - readln - [ >>raw ] [ tokenize-command >>tokenized ] bi ; +TUPLE: ftp-disconnect ; +C: ftp-disconnect : (send-response) ( n string separator -- ) [ number>string write ] 2dip write ftp-send ; @@ -56,28 +50,50 @@ C: ftp-list [ but-last-slice [ "-" (send-response) ] with each ] [ first " " (send-response) ] 2bi ; -: server-response ( n string -- ) +: server-response ( string n -- ) + 2dup number>string swap ":" glue \ server-response DEBUG log-message - swap add-response-line swap >>n + swap add-response-line send-response ; -: ftp-error ( string -- ) - 500 "Unrecognized command: " rot append server-response ; +: serving? ( path -- ? ) + normalize-path server get serving-directory>> head? ; + +: can-serve-directory? ( path -- ? ) + canonicalize-path + { [ exists? ] [ file-info directory? ] [ serving? ] } 1&& ; + +: can-serve-file? ( path -- ? ) + canonicalize-path + { + [ exists? ] + [ file-info type>> +regular-file+ = ] + [ serving? ] + } 1&& ; + +: can-serve? ( path -- ? ) + [ can-serve-file? ] [ can-serve-directory? ] bi or ; + +: ftp-error ( string -- ) 500 server-response ; +: ftp-syntax-error ( string -- ) 501 server-response ; +: ftp-unimplemented ( string -- ) 502 server-response ; +: ftp-file-not-available ( string -- ) 550 server-response ; +: ftp-illegal-file-name ( string -- ) 553 server-response ; : send-banner ( -- ) - 220 "Welcome to " host-name append server-response ; + "Welcome to " host-name append 220 server-response ; : anonymous-only ( -- ) - 530 "This FTP server is anonymous only." server-response ; + "This FTP server is anonymous only." 530 server-response ; : handle-QUIT ( obj -- ) - drop 221 "Goodbye." server-response ; + drop "Goodbye." 221 server-response ; : handle-USER ( ftp-command -- ) [ tokenized>> second client get (>>user) - 331 "Please specify the password." server-response + "Please specify the password." 331 server-response ] [ 2drop "bad USER" ftp-error ] recover ; @@ -85,7 +101,7 @@ C: ftp-list : handle-PASS ( ftp-command -- ) [ tokenized>> second client get (>>password) - 230 "Login successful" server-response + "Login successful" 230 server-response ] [ 2drop "PASS error" ftp-error ] recover ; @@ -102,7 +118,7 @@ ERROR: type-error type ; : handle-TYPE ( obj -- ) [ tokenized>> second parse-type - [ 200 ] dip "Switching to " " mode" surround server-response + "Switching to " " mode" surround 200 server-response ] [ 2drop "TYPE is binary only" ftp-error ] recover ; @@ -115,65 +131,57 @@ ERROR: type-error type ; : handle-PWD ( obj -- ) drop - 257 current-directory get "\"" dup surround server-response ; + current-directory get "\"" dup surround 257 server-response ; : handle-SYST ( obj -- ) drop - 215 "UNIX Type: L8" server-response ; - -: if-command-promise ( quot -- ) - [ client get command-promise>> ] dip - [ "Establish an active or passive connection first" ftp-error ] if* ; - -: handle-STOR ( obj -- ) - [ - tokenized>> second - [ [ ] dip fulfill ] if-command-promise - ] [ - 2drop - ] recover ; - -! EPRT |2|::1|62138| -! : handle-EPRT ( obj -- ) - ! tokenized>> second "|" split harvest ; + "UNIX Type: L8" 215 server-response ; : start-directory ( -- ) - 150 "Here comes the directory listing." server-response ; + "Here comes the directory listing." 150 server-response ; + +: transfer-outgoing-file ( path -- ) + [ "Opening BINARY mode data connection for " ] dip + [ file-name ] [ + file-info size>> number>string + "(" " bytes)." surround + ] bi " " glue append 150 server-response ; + +: transfer-incoming-file ( path -- ) + "Opening BINARY mode data connection for " prepend + 150 server-response ; + +: finish-file-transfer ( -- ) + "File send OK." 226 server-response ; + +GENERIC: handle-passive-command ( stream obj -- ) + +: passive-loop ( server -- ) + [ + [ + |dispose + 30 seconds over set-timeout + accept drop &dispose + client get extra-connection>> + 30 seconds ?promise-timeout + handle-passive-command + ] + [ client get f >>extra-connection drop ] + [ drop ] cleanup + ] with-destructors ; : finish-directory ( -- ) - 226 "Directory send OK." server-response ; + "Directory send OK." 226 server-response ; -GENERIC: service-command ( stream obj -- ) - -M: ftp-list service-command ( stream obj -- ) +M: ftp-list handle-passive-command ( stream obj -- ) drop start-directory [ utf8 encode-output [ current-directory get directory. ] with-string-writer string-lines harvest [ ftp-send ] each - ] with-output-stream - finish-directory ; + ] with-output-stream finish-directory ; -: transfer-outgoing-file ( path -- ) - [ - 150 - "Opening BINARY mode data connection for " - ] dip - [ - file-name - ] [ - file-info size>> number>string - "(" " bytes)." surround - ] bi " " glue append server-response ; - -: transfer-incoming-file ( path -- ) - [ 150 ] dip "Opening BINARY mode data connection for " prepend - server-response ; - -: finish-file-transfer ( -- ) - 226 "File send OK." server-response ; - -M: ftp-get service-command ( stream obj -- ) +M: ftp-get handle-passive-command ( stream obj -- ) [ path>> [ transfer-outgoing-file ] @@ -183,7 +191,7 @@ M: ftp-get service-command ( stream obj -- ) 3drop "File transfer failed" ftp-error ] recover ; -M: ftp-put service-command ( stream obj -- ) +M: ftp-put handle-passive-command ( stream obj -- ) [ path>> [ transfer-incoming-file ] @@ -193,165 +201,165 @@ M: ftp-put service-command ( stream obj -- ) 3drop "File transfer failed" ftp-error ] recover ; -: passive-loop ( server -- ) - [ - [ - |dispose - 30 seconds over set-timeout - accept drop &dispose - client get command-promise>> - 30 seconds ?promise-timeout - service-command - ] - [ client get f >>command-promise drop ] - [ drop ] cleanup - ] with-destructors ; +M: ftp-disconnect handle-passive-command ( stream obj -- ) + drop dispose ; + +: fulfill-client ( obj -- ) + client get extra-connection>> [ + fulfill + ] [ + drop + "Establish an active or passive connection first" ftp-error + ] if* ; + +: handle-STOR ( obj -- ) + tokenized>> second + dup can-serve-file? [ + fulfill-client + ] [ + drop + fulfill-client + ] if ; : handle-LIST ( obj -- ) - drop - [ [ ] dip fulfill ] if-command-promise ; - -: handle-SIZE ( obj -- ) - [ - [ 213 ] dip - tokenized>> second file-info size>> - number>string server-response + drop current-directory get + can-serve-directory? [ + fulfill-client ] [ - 2drop - 550 "Could not get file size" server-response - ] recover ; + fulfill-client + ] if ; + +: not-a-plain-file ( path -- ) + ": not a plain file." append ftp-error ; : handle-RETR ( obj -- ) - [ tokenized>> second swap fulfill ] - curry if-command-promise ; + tokenized>> second + dup can-serve-file? [ + fulfill-client + ] [ + not-a-plain-file + fulfill-client + ] if ; + +: handle-SIZE ( obj -- ) + tokenized>> second + dup can-serve-file? [ + file-info size>> number>string 213 server-response + ] [ + not-a-plain-file + ] if ; : expect-connection ( -- port ) + client get (>>extra-connection) random-local-server - client get >>command-promise drop [ [ passive-loop ] curry in-thread ] [ addr>> port>> ] bi ; : handle-PASV ( obj -- ) - drop client get passive >>mode drop - 221 + drop expect-connection port>bytes [ number>string ] bi@ "," glue "Entering Passive Mode (127,0,0,1," ")" surround - server-response ; + 221 server-response ; : handle-EPSV ( obj -- ) drop - client get command-promise>> [ - "You already have a passive stream" ftp-error - ] [ - 229 - expect-connection number>string - "Entering Extended Passive Mode (|||" "|)" surround - server-response - ] if ; + client get f >>extra-connection drop + expect-connection number>string + "Entering Extended Passive Mode (|||" "|)" surround + 229 server-response ; -! LPRT 6,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,242,186 -! : handle-LPRT ( obj -- ) tokenized>> "," split ; - -ERROR: not-a-directory ; -ERROR: no-permissions ; - -: handle-CWD ( obj -- ) - [ - tokenized>> second dup normalize-path - dup ftp-server-directory head? [ - no-permissions - ] unless - - file-info directory? [ - set-current-directory - 250 "Directory successully changed." server-response +: handle-MDTM ( obj -- ) + tokenized>> 1 swap ?nth [ + dup file-info dup directory? [ + drop not-a-plain-file ] [ - not-a-directory + nip + modified>> timestamp>mdtm + 213 server-response ] if ] [ - 2drop - 550 "Failed to change directory." server-response - ] recover ; + "" not-a-plain-file + ] if* ; -: unrecognized-command ( obj -- ) raw>> ftp-error ; +ERROR: not-a-directory ; +ERROR: no-directory-permissions ; -: handle-client-loop ( -- ) - readln - USE: prettyprint global [ dup . flush ] bind - [ >>raw ] - [ tokenize-command >>tokenized ] bi +: directory-change-success ( -- ) + "Directory successully changed." 250 server-response ; + +: directory-change-failed ( -- ) + "Failed to change directory." 553 server-response ; + +: handle-CWD ( obj -- ) + tokenized>> 1 swap ?nth [ + dup can-serve-directory? [ + set-current-directory + directory-change-success + ] [ + drop + directory-change-failed + ] if + ] [ + directory-change-success + ] if* ; + +: unrecognized-command ( obj -- ) + raw>> "Unrecognized command: " prepend ftp-error ; + +: client-loop-dispatch ( str/f -- ? ) dup tokenized>> first >upper { + { "QUIT" [ handle-QUIT f ] } { "USER" [ handle-USER t ] } { "PASS" [ handle-PASS t ] } - { "ACCT" [ drop "ACCT unimplemented" ftp-error t ] } - { "CWD" [ handle-CWD t ] } - ! { "XCWD" [ ] } - ! { "CDUP" [ ] } - ! { "SMNT" [ ] } - - ! { "REIN" [ drop client get reset-ftp-client t ] } - { "QUIT" [ handle-QUIT f ] } - - ! { "PORT" [ ] } ! TODO - { "PASV" [ handle-PASV t ] } - ! { "MODE" [ ] } - { "TYPE" [ handle-TYPE t ] } - ! { "STRU" [ ] } - - ! { "ALLO" [ ] } - ! { "REST" [ ] } - { "STOR" [ handle-STOR t ] } - ! { "STOU" [ ] } - { "RETR" [ handle-RETR t ] } - { "LIST" [ handle-LIST t ] } - { "SIZE" [ handle-SIZE t ] } - ! { "NLST" [ ] } - ! { "APPE" [ ] } - ! { "RNFR" [ ] } - ! { "RNTO" [ ] } - ! { "DELE" [ handle-DELE t ] } - ! { "RMD" [ handle-RMD t ] } - ! ! { "XRMD" [ handle-XRMD t ] } - ! { "MKD" [ handle-MKD t ] } - { "PWD" [ handle-PWD t ] } - ! { "ABOR" [ ] } - { "SYST" [ handle-SYST t ] } - ! { "STAT" [ ] } - ! { "HELP" [ ] } - - ! { "SITE" [ ] } - ! { "NOOP" [ ] } - - ! { "EPRT" [ handle-EPRT ] } - ! { "LPRT" [ handle-LPRT ] } + { "ACCT" [ drop "ACCT unimplemented" ftp-unimplemented t ] } + { "PWD" [ handle-PWD t ] } + { "TYPE" [ handle-TYPE t ] } + { "CWD" [ handle-CWD t ] } + { "PASV" [ handle-PASV t ] } { "EPSV" [ handle-EPSV t ] } - ! { "LPSV" [ drop handle-LPSV t ] } + { "LIST" [ handle-LIST t ] } + { "STOR" [ handle-STOR t ] } + { "RETR" [ handle-RETR t ] } + { "SIZE" [ handle-SIZE t ] } + { "MDTM" [ handle-MDTM t ] } [ drop unrecognized-command t ] - } case [ handle-client-loop ] when ; + } case ; -TUPLE: ftp-server < threaded-server ; +: read-command ( -- ftp-command/f ) + readln [ f ] [ ] if-empty ; + +: handle-client-loop ( -- ) + read-command [ + client-loop-dispatch + [ handle-client-loop ] when + ] when* ; + +: serve-directory ( server -- ) + serving-directory>> [ + send-banner + handle-client-loop + ] with-directory ; M: ftp-server handle-client* ( server -- ) - drop [ - ftp-server-directory [ - host-name client set - send-banner handle-client-loop - ] with-directory + "New client" \ handle-client* DEBUG log-message + ftp-client new client set + [ server set ] [ serve-directory ] bi ] with-destructors ; -: ( port -- server ) +: ( directory port -- server ) ftp-server new-threaded-server swap >>insecure + swap >>serving-directory "ftp.server" >>name 5 minutes >>timeout latin1 >>encoding ; -: ftpd ( port -- ) +: ftpd ( directory port -- ) start-server ; -: ftpd-main ( -- ) 2100 ftpd ; +: ftpd-main ( path -- ) 2100 ftpd ; MAIN: ftpd-main From 30e639ae39266a897fa28dcfcdf98cf746120889 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 18 Feb 2009 15:29:06 -0600 Subject: [PATCH 038/119] add a couple unit tests to ftp --- basis/ftp/client/client.factor | 2 +- basis/ftp/ftp.factor | 4 --- basis/ftp/server/server-tests.factor | 50 ++++++++++++++++++++++++++++ basis/ftp/server/server.factor | 4 +-- 4 files changed, 52 insertions(+), 8 deletions(-) create mode 100644 basis/ftp/server/server-tests.factor diff --git a/basis/ftp/client/client.factor b/basis/ftp/client/client.factor index ac21bb8f78..14877110d3 100644 --- a/basis/ftp/client/client.factor +++ b/basis/ftp/client/client.factor @@ -93,7 +93,7 @@ ERROR: ftp-error got expected ; : ensure-login ( url -- url ) dup username>> [ "anonymous" >>username - "ftp-client" >>password + "ftp-client@factorcode.org" >>password ] unless ; : >ftp-url ( url -- url' ) >url ensure-port ensure-login ; diff --git a/basis/ftp/ftp.factor b/basis/ftp/ftp.factor index 27eebc5946..eea98c0172 100644 --- a/basis/ftp/ftp.factor +++ b/basis/ftp/ftp.factor @@ -16,7 +16,3 @@ TUPLE: ftp-response n strings parsed ; over strings>> push ; : ftp-send ( string -- ) write "\r\n" write flush ; - -CONSTANT: ftp-ipv4 1 - -CONSTANT: ftp-ipv6 2 diff --git a/basis/ftp/server/server-tests.factor b/basis/ftp/server/server-tests.factor new file mode 100644 index 0000000000..d7d9d8384d --- /dev/null +++ b/basis/ftp/server/server-tests.factor @@ -0,0 +1,50 @@ +USING: calendar ftp.server io.encodings.ascii io.files +io.files.unique namespaces threads tools.test kernel +io.servers.connection ftp.client accessors urls +io.pathnames io.directories sequences fry ; +IN: ftp.server.tests + +: test-file-contents ( -- string ) + "Files are so boring anymore." ; + +: create-test-file ( -- path ) + test-file-contents + "ftp.server" "test" make-unique-file + [ ascii set-file-contents ] keep canonicalize-path ; + +: test-ftp-server ( quot -- ) + '[ + current-temporary-directory get 0 + + [ start-server* ] + [ + sockets>> first addr>> port>> + + swap >>port + "ftp" >>protocol + "localhost" >>host + create-test-file >>path + _ call + ] + [ stop-server ] tri + ] with-unique-directory drop ; inline + +[ t ] +[ + + [ + unique-directory [ + [ ftp-get ] [ path>> file-name ascii file-contents ] bi + ] with-directory + ] test-ftp-server test-file-contents = +] unit-test + +[ + + [ + "/" >>path + unique-directory [ + [ ftp-get ] [ path>> file-name ascii file-contents ] bi + ] with-directory + ] test-ftp-server test-file-contents = +] must-fail diff --git a/basis/ftp/server/server.factor b/basis/ftp/server/server.factor index ffe16b2f4c..5247b824fa 100644 --- a/basis/ftp/server/server.factor +++ b/basis/ftp/server/server.factor @@ -61,11 +61,9 @@ C: ftp-disconnect normalize-path server get serving-directory>> head? ; : can-serve-directory? ( path -- ? ) - canonicalize-path { [ exists? ] [ file-info directory? ] [ serving? ] } 1&& ; : can-serve-file? ( path -- ? ) - canonicalize-path { [ exists? ] [ file-info type>> +regular-file+ = ] @@ -351,7 +349,7 @@ M: ftp-server handle-client* ( server -- ) : ( directory port -- server ) ftp-server new-threaded-server swap >>insecure - swap >>serving-directory + swap canonicalize-path >>serving-directory "ftp.server" >>name 5 minutes >>timeout latin1 >>encoding ; From 1ed6c013a2adc8ce2fa2474ae0ec070e5047c017 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 18 Feb 2009 15:49:18 -0600 Subject: [PATCH 039/119] call canonicalize-path when determining if we can serve a path --- basis/ftp/server/server.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/ftp/server/server.factor b/basis/ftp/server/server.factor index 5247b824fa..2eeeac714a 100644 --- a/basis/ftp/server/server.factor +++ b/basis/ftp/server/server.factor @@ -58,7 +58,7 @@ C: ftp-disconnect send-response ; : serving? ( path -- ? ) - normalize-path server get serving-directory>> head? ; + canonicalize-path server get serving-directory>> head? ; : can-serve-directory? ( path -- ? ) { [ exists? ] [ file-info directory? ] [ serving? ] } 1&& ; From b8445b3432c331ad693b4c953763e609ceea6ab1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 18 Feb 2009 15:51:03 -0600 Subject: [PATCH 040/119] remove dead code --- basis/ftp/server/server.factor | 6 ------ 1 file changed, 6 deletions(-) diff --git a/basis/ftp/server/server.factor b/basis/ftp/server/server.factor index 2eeeac714a..8438aae94e 100644 --- a/basis/ftp/server/server.factor +++ b/basis/ftp/server/server.factor @@ -70,14 +70,8 @@ C: ftp-disconnect [ serving? ] } 1&& ; -: can-serve? ( path -- ? ) - [ can-serve-file? ] [ can-serve-directory? ] bi or ; - : ftp-error ( string -- ) 500 server-response ; -: ftp-syntax-error ( string -- ) 501 server-response ; : ftp-unimplemented ( string -- ) 502 server-response ; -: ftp-file-not-available ( string -- ) 550 server-response ; -: ftp-illegal-file-name ( string -- ) 553 server-response ; : send-banner ( -- ) "Welcome to " host-name append 220 server-response ; From 91b4947e1eed69f07dbf34935725acced661a235 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 18 Feb 2009 16:01:53 -0600 Subject: [PATCH 041/119] with-logging should not take a DEBUG level --- basis/io/servers/connection/connection.factor | 2 +- basis/io/servers/packet/packet.factor | 1 - basis/logging/insomniac/insomniac.factor | 2 +- basis/logging/logging-docs.factor | 2 +- basis/logging/logging-tests.factor | 2 +- basis/logging/logging.factor | 6 ++---- extra/spider/spider.factor | 2 +- 7 files changed, 7 insertions(+), 10 deletions(-) diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor index 91fb3bfb37..589a50d2eb 100644 --- a/basis/io/servers/connection/connection.factor +++ b/basis/io/servers/connection/connection.factor @@ -117,7 +117,7 @@ M: threaded-server handle-client* handler>> call ; : (start-server) ( threaded-server -- ) init-server dup threaded-server [ - [ ] [ name>> ] [ log-level>> ] tri [ + [ ] [ name>> ] bi [ [ listen-on [ start-accept-loop ] parallel-each ] [ ready>> raise-flag ] bi diff --git a/basis/io/servers/packet/packet.factor b/basis/io/servers/packet/packet.factor index 3f092ab9f1..4edffa96b7 100644 --- a/basis/io/servers/packet/packet.factor +++ b/basis/io/servers/packet/packet.factor @@ -20,5 +20,4 @@ LOG: received-datagram NOTICE PRIVATE> : with-datagrams ( seq service quot -- ) - [ DEBUG ] dip '[ [ [ _ ] dip spawn-datagrams ] parallel-each ] with-logging ; inline diff --git a/basis/logging/insomniac/insomniac.factor b/basis/logging/insomniac/insomniac.factor index 935326da2d..91baae631f 100644 --- a/basis/logging/insomniac/insomniac.factor +++ b/basis/logging/insomniac/insomniac.factor @@ -30,7 +30,7 @@ SYMBOL: insomniac-recipients \ (email-log-report) NOTICE add-error-logging : email-log-report ( service word-names -- ) - "logging.insomniac" DEBUG [ (email-log-report) ] with-logging ; + "logging.insomniac" [ (email-log-report) ] with-logging ; : schedule-insomniac ( service word-names -- ) [ [ email-log-report ] assoc-each rotate-logs ] 2curry diff --git a/basis/logging/logging-docs.factor b/basis/logging/logging-docs.factor index 64956493c6..a4b3f3f019 100644 --- a/basis/logging/logging-docs.factor +++ b/basis/logging/logging-docs.factor @@ -94,7 +94,7 @@ HELP: close-logs { $description "Closes all open log streams. Subsequent logging will re-open the streams. This should be used before moving or deleting log files." } ; HELP: with-logging -{ $values { "service" "a log service name" } { "level" "a log level" } { "quot" quotation } } +{ $values { "service" "a log service name" } { "quot" quotation } } { $description "Calls the quotation a new dynamic scope where all logging calls more urgent than " { $link log-level } " are sent to the log file for " { $snippet "service" } "." } ; ARTICLE: "logging.rotation" "Log rotation" diff --git a/basis/logging/logging-tests.factor b/basis/logging/logging-tests.factor index 63eecc7319..796c8769fc 100644 --- a/basis/logging/logging-tests.factor +++ b/basis/logging/logging-tests.factor @@ -13,7 +13,7 @@ USING: tools.test logging math ; \ error-logging-test ERROR add-error-logging -"logging-test" DEBUG [ +"logging-test" [ [ 4 ] [ 1 3 input-logging-test ] unit-test [ 4 ] [ 1 3 output-logging-test ] unit-test diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor index 496dae2c61..ff1baa4ebb 100644 --- a/basis/logging/logging.factor +++ b/basis/logging/logging.factor @@ -55,10 +55,8 @@ ERROR: bad-log-message-parameters msg word level ; : close-logs ( -- ) { } "close-logs" send-to-log-server ; -: with-logging ( service level quot -- ) - '[ - _ log-service [ _ log-level _ with-variable ] with-variable - ] call ; inline +: with-logging ( service quot -- ) + [ log-service ] dip with-variable ; inline ! Aspect-oriented programming idioms diff --git a/extra/spider/spider.factor b/extra/spider/spider.factor index 0f702d7d22..bd5b2668be 100644 --- a/extra/spider/spider.factor +++ b/extra/spider/spider.factor @@ -88,7 +88,7 @@ links processing-time timestamp ; PRIVATE> : run-spider ( spider -- spider ) - "spider" DEBUG [ + "spider" [ dup spider [ queue-initial-links [ todo>> ] [ max-depth>> ] bi From ddce0e0a107ffdb295b02363c553d562641b72b9 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 18 Feb 2009 16:57:20 -0600 Subject: [PATCH 042/119] change literals so that $ works with constants in same compilation unit --- extra/literals/literals-docs.factor | 8 ++++---- extra/literals/literals-tests.factor | 5 +++-- extra/literals/literals.factor | 4 ++-- 3 files changed, 9 insertions(+), 8 deletions(-) diff --git a/extra/literals/literals-docs.factor b/extra/literals/literals-docs.factor index ae25c75495..6525264f6a 100644 --- a/extra/literals/literals-docs.factor +++ b/extra/literals/literals-docs.factor @@ -1,19 +1,19 @@ ! Copyright (C) 2008 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: help.markup help.syntax multiline ; +USING: help.markup help.syntax kernel multiline ; IN: literals HELP: $ { $syntax "$ word" } { $description "Executes " { $snippet "word" } " at parse time and adds the result(s) to the parser accumulator." } -{ $notes "Since " { $snippet "word" } " is executed at parse time, " { $snippet "$" } " cannot be used with words defined in the same compilation unit." } +{ $notes { $snippet "word" } "'s definition is looked up and " { $link call } "ed at parse time, so words that reference words in the current compilation unit cannot be used with " { $snippet "$" } "." } { $examples { $example <" USING: kernel literals prettyprint ; IN: scratchpad -<< : five 5 ; >> +CONSTANT: five 5 { $ five } . "> "{ 5 }" } @@ -30,7 +30,7 @@ IN: scratchpad HELP: $[ { $syntax "$[ code ]" } { $description "Calls " { $snippet "code" } " at parse time and adds the result(s) to the parser accumulator." } -{ $notes "Since " { $snippet "code" } " is executed at parse time, it cannot reference any words defined in the same compilation unit." } +{ $notes "Since " { $snippet "code" } " is " { $link call } "ed at parse time, it cannot reference any words defined in the same compilation unit." } { $examples { $example <" diff --git a/extra/literals/literals-tests.factor b/extra/literals/literals-tests.factor index 34ea4d6415..0e933d5209 100644 --- a/extra/literals/literals-tests.factor +++ b/extra/literals/literals-tests.factor @@ -2,11 +2,12 @@ USING: kernel literals math tools.test ; IN: literals.tests << -: five 5 ; -: seven-eleven 7 11 ; : six-six-six 6 6 6 ; >> +: five 5 ; +: seven-eleven 7 11 ; + [ { 5 } ] [ { $ five } ] unit-test [ { 7 11 } ] [ { $ seven-eleven } ] unit-test [ { 6 6 6 } ] [ { $ six-six-six } ] unit-test diff --git a/extra/literals/literals.factor b/extra/literals/literals.factor index 6df51a35ef..d3cfcaae23 100644 --- a/extra/literals/literals.factor +++ b/extra/literals/literals.factor @@ -1,6 +1,6 @@ ! (c) Joe Groff, see license for details -USING: continuations kernel parser words quotations vectors ; +USING: accessors continuations kernel parser words quotations vectors ; IN: literals -: $ scan-word [ execute ] curry with-datastack >vector ; parsing +: $ scan-word [ def>> call ] curry with-datastack >vector ; parsing : $[ \ ] parse-until >quotation with-datastack >vector ; parsing From 67d2da40404752979a9c07d75f0ba6c8aa84318b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 18 Feb 2009 16:59:23 -0600 Subject: [PATCH 043/119] set a default log level --- basis/logging/logging.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor index ff1baa4ebb..e295960baa 100644 --- a/basis/logging/logging.factor +++ b/basis/logging/logging.factor @@ -11,6 +11,8 @@ SYMBOLS: DEBUG NOTICE WARNING ERROR CRITICAL ; SYMBOL: log-level +log-level [ DEBUG ] initialize + : log-levels ( -- assoc ) H{ { DEBUG 0 } From adb6b216832979de9e7af2a6a544b6e5c3b830d2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 18 Feb 2009 17:25:58 -0600 Subject: [PATCH 044/119] fix load error --- basis/io/servers/packet/packet.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/servers/packet/packet.factor b/basis/io/servers/packet/packet.factor index 4edffa96b7..2a346b4d13 100644 --- a/basis/io/servers/packet/packet.factor +++ b/basis/io/servers/packet/packet.factor @@ -1,6 +1,6 @@ USING: concurrency.combinators destructors fry -io.servers.datagram.private io.sockets kernel logging ; -IN: io.servers.datagram +io.sockets kernel logging ; +IN: io.servers.packet Date: Thu, 19 Feb 2009 01:33:47 +0100 Subject: [PATCH 045/119] FUEL: Don't load vocabs in USING: form by default. --- extra/fuel/fuel.factor | 2 ++ extra/fuel/help/help.factor | 6 ++++++ misc/fuel/README | 1 + misc/fuel/fuel-autodoc.el | 21 +++++++++++++++++++-- misc/fuel/fuel-eval.el | 2 +- misc/fuel/fuel-mode.el | 15 ++++++++++++++- 6 files changed, 43 insertions(+), 4 deletions(-) diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index 2bf8f1b98d..403708e880 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -99,6 +99,8 @@ PRIVATE> : fuel-vocab-help ( name -- ) (fuel-vocab-help) fuel-eval-set-result ; +: fuel-word-synopsis ( word usings -- ) (fuel-word-synopsis) fuel-eval-set-result ; + : fuel-vocab-summary ( name -- ) (fuel-vocab-summary) fuel-eval-set-result ; diff --git a/extra/fuel/help/help.factor b/extra/fuel/help/help.factor index 55183734b3..bf637fd0b3 100644 --- a/extra/fuel/help/help.factor +++ b/extra/fuel/help/help.factor @@ -90,6 +90,12 @@ PRIVATE> : (fuel-word-help) ( name -- elem ) fuel-find-word [ [ auto-use? on (fuel-word-element) ] with-scope ] [ f ] if* ; +: (fuel-word-synopsis) ( word usings -- str/f ) + [ + [ vocab ] filter interactive-vocabs get append interactive-vocabs set + fuel-find-word [ synopsis ] when* + ] with-scope ; + : (fuel-word-see) ( word -- elem ) [ name>> \ article swap ] [ [ see ] with-string-writer \ $code swap 2array ] bi 3array ; inline diff --git a/misc/fuel/README b/misc/fuel/README index d712560b03..79b8f49f9a 100644 --- a/misc/fuel/README +++ b/misc/fuel/README @@ -111,6 +111,7 @@ beast. | C-cC-ev | edit vocabulary (fuel-edit-vocabulary) | | C-cC-ew | edit word (fuel-edit-word-at-point) | | C-cC-ed | edit word's doc (C-u M-x fuel-edit-word-doc-at-point) | + | C-cC-el | load vocabs in USING: form | |-----------------+------------------------------------------------------------| | C-cC-er | eval region | | C-M-r, C-cC-ee | eval region, extending it to definition boundaries | diff --git a/misc/fuel/fuel-autodoc.el b/misc/fuel/fuel-autodoc.el index 76919702bb..d02e4fcfb9 100644 --- a/misc/fuel/fuel-autodoc.el +++ b/misc/fuel/fuel-autodoc.el @@ -32,6 +32,22 @@ :type 'boolean) +(defcustom fuel-autodoc-eval-using-form-p nil + "When enabled, automatically load vocabularies in USING: form +to display autodoc messages. + +In order to show autodoc messages for words in a Factor buffer, +the used vocabularies must be loaded in the Factor image. Setting +this variable to `t' will do that automatically for you, +asynchronously. That means that you'll be able to move around +while the vocabs are being loaded, but no other FUEL +functionality will be available until loading finishes (and it +may take a while). Thus, this functionality is disabled by +default. You can force loading the vocabs in a Factor buffer +USING: form with \\[fuel-load-usings]." + :group 'fuel-autodoc + :type 'boolean) + ;;; Eldoc function: @@ -41,9 +57,10 @@ (let ((word (or word (fuel-syntax-symbol-at-point))) (fuel-log--inhibit-p t)) (when word - (let* ((cmd (if (fuel-syntax--in-using) + (let* ((usings (if fuel-autodoc-eval-using-form-p :usings t)) + (cmd (if (fuel-syntax--in-using) `(:fuel* (,word fuel-vocab-summary) :in t) - `(:fuel* (((:quote ,word) synopsis :get)) :in))) + `(:fuel* ((,word :usings fuel-word-synopsis)) t ,usings))) (ret (fuel-eval--send/wait cmd fuel-autodoc--timeout)) (res (fuel-eval--retort-result ret))) (when (and ret (not (fuel-eval--retort-error ret)) (stringp res)) diff --git a/misc/fuel/fuel-eval.el b/misc/fuel/fuel-eval.el index 9e8210a3e3..985722854f 100644 --- a/misc/fuel/fuel-eval.el +++ b/misc/fuel/fuel-eval.el @@ -77,7 +77,7 @@ (t (error "Invalid 'in' (%s)" in)))) (defsubst factor--fuel-usings (usings) - (cond ((null usings) :usings) + (cond ((or (null usings) (eq usings :usings)) :usings) ((eq usings t) nil) ((listp usings) `(:array ,@usings)) (t (error "Invalid 'usings' (%s)" usings)))) diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index 504308fccd..c4f08f3c62 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -132,6 +132,18 @@ With prefix argument, ask for the file name." (let ((file (car (fuel-mode--read-file arg)))) (when file (fuel-debug--uses-for-file file)))) +(defun fuel-load-usings () + "Loads all vocabularies in the current buffer's USING: from. +Useful to activate autodoc help messages in a vocabulary not yet +loaded. See documentation for `fuel-autodoc-eval-using-form-p' +for details." + (interactive) + (message "Loading all vocabularies in USING: form ...") + (let ((err (fuel-eval--retort-error + (fuel-eval--send/wait '(:fuel* (t) t :usings) 120000)))) + (message (if err "Warning: some vocabularies failed to load" + "All vocabularies loaded")))) + ;;; Minor mode definition: @@ -191,7 +203,8 @@ interacting with a factor listener is at your disposal. (fuel-mode--key ?e ?d 'fuel-edit-word-doc-at-point) (fuel-mode--key ?e ?e 'fuel-eval-extended-region) -(fuel-mode--key ?e ?l 'fuel-run-file) +(fuel-mode--key ?e ?k 'fuel-run-file) +(fuel-mode--key ?e ?l 'fuel-load-usings) (fuel-mode--key ?e ?r 'fuel-eval-region) (fuel-mode--key ?e ?u 'fuel-update-usings) (fuel-mode--key ?e ?v 'fuel-edit-vocabulary) From 8968093623a2bc7087527fcce6cc7c324148e3af Mon Sep 17 00:00:00 2001 From: Jason Merrill Date: Wed, 18 Feb 2009 21:28:48 -0500 Subject: [PATCH 046/119] Added dual versions of a few more words to math.dual. --- extra/math/derivatives/derivatives.factor | 23 +++++++++++-- extra/math/dual/dual-docs.factor | 42 +++++++++++++++++++++++ extra/math/dual/dual-tests.factor | 4 ++- extra/math/dual/dual.factor | 26 ++++++++++---- 4 files changed, 85 insertions(+), 10 deletions(-) diff --git a/extra/math/derivatives/derivatives.factor b/extra/math/derivatives/derivatives.factor index 8e69cec129..c6a9d1a357 100644 --- a/extra/math/derivatives/derivatives.factor +++ b/extra/math/derivatives/derivatives.factor @@ -1,8 +1,15 @@ ! Copyright (C) 2009 Jason W. Merrill. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.functions math.derivatives.syntax ; +USING: kernel math math.functions math.derivatives.syntax + math.order math.parser summary accessors make combinators ; IN: math.derivatives +ERROR: undefined-derivative point word ; +M: undefined-derivative summary + [ dup "Derivative of " % word>> name>> % + " is undefined at " % point>> # "." % ] + "" make ; + DERIVATIVE: + [ 2drop ] [ 2drop ] DERIVATIVE: - [ 2drop ] [ 2drop neg ] DERIVATIVE: * [ nip * ] [ drop * ] @@ -12,6 +19,15 @@ DERIVATIVE: / [ nip / ] [ sq / neg * ] DERIVATIVE: ^ [ [ 1 - ^ ] keep * * ] [ [ dup zero? ] 2dip [ 3drop 0 ] [ [ ^ ] keep log * * ] if ] +DERIVATIVE: abs + [ 0 <=> + { + { +lt+ [ neg ] } + { +eq+ [ 0 \ abs undefined-derivative ] } + { +gt+ [ ] } + } case + ] + DERIVATIVE: sqrt [ sqrt 2 * / ] DERIVATIVE: exp [ exp * ] @@ -31,4 +47,7 @@ DERIVATIVE: atan [ sq 1 + / ] DERIVATIVE: asinh [ sq 1 + sqrt / ] DERIVATIVE: acosh [ [ 1 + sqrt ] [ 1 - sqrt ] bi * / ] -DERIVATIVE: atanh [ sq neg 1 + / ] \ No newline at end of file +DERIVATIVE: atanh [ sq neg 1 + / ] + +DERIVATIVE: neg [ drop neg ] +DERIVATIVE: recip [ sq recip neg * ] diff --git a/extra/math/dual/dual-docs.factor b/extra/math/dual/dual-docs.factor index de3b0749a5..6c287a8f1e 100644 --- a/extra/math/dual/dual-docs.factor +++ b/extra/math/dual/dual-docs.factor @@ -46,6 +46,48 @@ HELP: d^ } { $description "Raise a dual number to a (possibly dual) power" } ; +HELP: dabs +{ $values + { "x" dual } + { "|x|" dual } +} +{ $description "Absolute value of a dual number." } ; + +HELP: dacosh +{ $values + { "x" dual } + { "y" dual } +} +{ $description "Inverse hyberbolic cosine of a dual number." } ; + +HELP: dasinh +{ $values + { "x" dual } + { "y" dual } +} +{ $description "Inverse hyberbolic sine of a dual number." } ; + +HELP: datanh +{ $values + { "x" dual } + { "y" dual } +} +{ $description "Inverse hyberbolic tangent of a dual number." } ; + +HELP: dneg +{ $values + { "x" dual } + { "-x" dual } +} +{ $description "Negative of a dual number." } ; + +HELP: drecip +{ $values + { "x" dual } + { "1/x" dual } +} +{ $description "Reciprocal of a dual number." } ; + HELP: define-dual-method { $values { "word" word } diff --git a/extra/math/dual/dual-tests.factor b/extra/math/dual/dual-tests.factor index 2fe751dd63..ea46c46124 100644 --- a/extra/math/dual/dual-tests.factor +++ b/extra/math/dual/dual-tests.factor @@ -11,4 +11,6 @@ IN: math.dual.tests [ 2 1 ] [ 2 3 1 -1 d* unpack-dual ] unit-test [ 1/2 -1/4 ] [ 2 1 1 swap d/ unpack-dual ] unit-test [ 2 ] [ 1 1 2 d^ epsilon-part>> ] unit-test -[ 2.0 .25 ] [ 4 1 sqrt unpack-dual ] unit-test \ No newline at end of file +[ 2.0 .25 ] [ 4 1 sqrt unpack-dual ] unit-test +[ 2 -1 ] [ -2 1 dabs unpack-dual ] unit-test +[ -2 -1 ] [ 2 1 dneg unpack-dual ] unit-test \ No newline at end of file diff --git a/extra/math/dual/dual.factor b/extra/math/dual/dual.factor index 214db9b678..36d684bc6d 100644 --- a/extra/math/dual/dual.factor +++ b/extra/math/dual/dual.factor @@ -51,9 +51,9 @@ MACRO: chain-rule ( word -- e ) PRIVATE> MACRO: dual-op ( word -- ) - [ '[ _ ordinary-op ] ] - [ input-length '[ _ nkeep ] ] - [ '[ _ chain-rule ] ] + [ '[ _ ordinary-op ] ] + [ input-length '[ _ nkeep ] ] + [ '[ _ chain-rule ] ] tri '[ _ @ @ ] ; @@ -64,17 +64,29 @@ MACRO: dual-op ( word -- ) [ { sqrt exp log sin cos tan sinh cosh tanh acos asin atan } [ define-dual-method ] each ] with-compilation-unit -! Inverse methods { asinh, acosh, atanh } are not generic, so +! Inverse methods { asinh, acosh, atanh } are not generic, so ! there is no way to specialize them for dual numbers. However, ! they are defined in terms of functions that can operate on ! dual numbers and arithmetic methods, so if it becomes ! possible to make arithmetic operators work directly on dual ! numbers, we will get these for free. -! Arithmetic methods are not generic (yet?), so we have to +! Arithmetic words are not generic (yet?), so we have to ! define special versions of them to operate on dual numbers. : d+ ( x y -- x+y ) \ + dual-op ; -: d- ( x y -- x-y ) \ - dual-op ; +: d- ( x y -- x-y ) \ - dual-op ; : d* ( x y -- x*y ) \ * dual-op ; : d/ ( x y -- x/y ) \ / dual-op ; -: d^ ( x y -- x^y ) \ ^ dual-op ; \ No newline at end of file +: d^ ( x y -- x^y ) \ ^ dual-op ; + +: dabs ( x -- |x| ) \ abs dual-op ; + +! The following words are also not generic, but are defined in +! terms of words that can operate on dual numbers and +! arithmetic. If it becomes possible to implement arithmetic on +! dual numbers directly, these functions can be deleted. +: dneg ( x -- -x ) \ neg dual-op ; +: drecip ( x -- 1/x ) \ recip dual-op ; +: dasinh ( x -- y ) \ asinh dual-op ; +: dacosh ( x -- y ) \ acosh dual-op ; +: datanh ( x -- y ) \ atanh dual-op ; \ No newline at end of file From 318533e1870d7b3d15b892bcbb7e0c92e0dd8246 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 18 Feb 2009 21:13:46 -0600 Subject: [PATCH 047/119] fix load error --- extra/annotations/annotations-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/annotations/annotations-docs.factor b/extra/annotations/annotations-docs.factor index 1effdf4067..bf8aef3a07 100644 --- a/extra/annotations/annotations-docs.factor +++ b/extra/annotations/annotations-docs.factor @@ -10,7 +10,7 @@ IN: annotations PRIVATE> : $annotation ( element -- ) - P first + first [ "!" " your comment here" surround 1array $syntax ] [ [ "Treats the rest of the line after the exclamation point as a code annotation that can be looked up with the " \ $link ] dip comment-usage.-word 2array " word." 3array $description ] [ ": foo ( x y z -- w )\n !" " --w-ó()ò-w-- kilroy was here\n + * ;" surround 1array $unchecked-example ] From 9c44c87b054140abd20a422d22151242e854184c Mon Sep 17 00:00:00 2001 From: Tim Wawrzynczak Date: Wed, 18 Feb 2009 21:32:31 -0600 Subject: [PATCH 048/119] Merged interfaces between v1 and v2 (id3-info); added textual genre names instead of numbers --- extra/id3/id3-docs.factor | 10 +- extra/id3/id3-tests.factor | 195 +++++-------------------------------- extra/id3/id3.factor | 185 +++++++++++++++++++++++++++++++---- 3 files changed, 196 insertions(+), 194 deletions(-) diff --git a/extra/id3/id3-docs.factor b/extra/id3/id3-docs.factor index da69c2ced3..a54bba1629 100644 --- a/extra/id3/id3-docs.factor +++ b/extra/id3/id3-docs.factor @@ -1,13 +1,19 @@ ! Copyright (C) 2008 Tim Wawrzynczak ! See http://factorcode.org/license.txt for BSD license. -USING: help.markup help.syntax sequences kernel ; +USING: help.markup help.syntax sequences kernel accessors ; IN: id3 HELP: file-id3-tags { $values { "path" "a path string" } { "object/f" "a tuple storing ID3 metadata or f" } } -{ $description "Return a tuple containing the ID3 information parsed out of the MP3 file, or " { $link f } " if no metadata is present." } ; + { $description "Return a tuple containing the ID3 information parsed out of the MP3 file, or " { $link f } " if no metadata is present. Currently, the parser supports the following tags: " + $nl { $link title>> } + $nl { $link artist>> } + $nl { $link album>> } + $nl { $link year>> } + $nl { $link genre>> } + $nl { $link comment>> } } ; ARTICLE: "id3" "ID3 tags" "The " { $vocab-link "id3" } " vocabulary contains words for parsing " { $emphasis "ID3" } " tags, which are textual fields storing an MP3's title, artist, and other metadata." $nl diff --git a/extra/id3/id3-tests.factor b/extra/id3/id3-tests.factor index fdbaf69f03..bcdc312440 100644 --- a/extra/id3/id3-tests.factor +++ b/extra/id3/id3-tests.factor @@ -1,182 +1,35 @@ ! Copyright (C) 2009 Tim Wawrzynczak ! See http://factorcode.org/license.txt for BSD license. -USING: tools.test id3 ; +USING: tools.test id3 id3.private ; IN: id3.tests -[ T{ mp3v2-file - { header T{ header f t 0 502 } } - { frames - { - T{ frame - { frame-id "COMM" } - { flags B{ 0 0 } } - { size 19 } - { data "eng, AG# 08E1C12E" } - } - T{ frame - { frame-id "TIT2" } - { flags B{ 0 0 } } - { size 15 } - { data "Stormy Weather" } - } - T{ frame - { frame-id "TRCK" } - { flags B{ 0 0 } } - { size 3 } - { data "32" } - } - T{ frame - { frame-id "TCON" } - { flags B{ 0 0 } } - { size 5 } - { data "(96)" } - } - T{ frame - { frame-id "TALB" } - { flags B{ 0 0 } } - { size 28 } - { data "Night and Day Frank Sinatra" } - } - T{ frame - { frame-id "PRIV" } - { flags B{ 0 0 } } - { size 39 } - { data "WM/MediaClassPrimaryID�}`�#��K�H�*(D" } - } - T{ frame - { frame-id "PRIV" } - { flags B{ 0 0 } } - { size 41 } - { data "WM/MediaClassSecondaryID" } - } - T{ frame - { frame-id "TPE1" } - { flags B{ 0 0 } } - { size 14 } - { data "Frank Sinatra" } - } - } - } -} -] [ "resource:extra/id3/tests/blah3.mp3" file-id3-tags ] unit-test +[ + T{ id3-info + { title "BLAH" } + { artist "ARTIST" } + { album "ALBUM" } + { year "2009" } + { comment "COMMENT" } + { genre "Bluegrass" } + } +] [ "resource:extra/id3/tests/blah.mp3" file-id3-tags ] unit-test [ - T{ mp3v2-file - { header - T{ header { version t } { flags 0 } { size 1405 } } + T{ id3-info + { title "Anthem of the Trinity" } + { artist "Terry Riley" } + { album "Shri Camel" } + { genre "Classical" } } - { frames - { - T{ frame - { frame-id "TIT2" } - { flags B{ 0 0 } } - { size 22 } - { data "Anthem of the Trinity" } - } - T{ frame - { frame-id "TPE1" } - { flags B{ 0 0 } } - { size 12 } - { data "Terry Riley" } - } - T{ frame - { frame-id "TALB" } - { flags B{ 0 0 } } - { size 11 } - { data "Shri Camel" } - } - T{ frame - { frame-id "TCON" } - { flags B{ 0 0 } } - { size 10 } - { data "Classical" } - } - T{ frame - { frame-id "UFID" } - { flags B{ 0 0 } } - { size 23 } - { data "http://musicbrainz.org" } - } - T{ frame - { frame-id "TXXX" } - { flags B{ 0 0 } } - { size 23 } - { data "MusicBrainz Artist Id" } - } - T{ frame - { frame-id "TXXX" } - { flags B{ 0 0 } } - { size 22 } - { data "musicbrainz_artistid" } - } - T{ frame - { frame-id "TRCK" } - { flags B{ 0 0 } } - { size 2 } - { data "1" } - } - T{ frame - { frame-id "TXXX" } - { flags B{ 0 0 } } - { size 22 } - { data "MusicBrainz Album Id" } - } - T{ frame - { frame-id "TXXX" } - { flags B{ 0 0 } } - { size 21 } - { data "musicbrainz_albumid" } - } - T{ frame - { frame-id "TXXX" } - { flags B{ 0 0 } } - { size 29 } - { data "MusicBrainz Album Artist Id" } - } - T{ frame - { frame-id "TXXX" } - { flags B{ 0 0 } } - { size 27 } - { data "musicbrainz_albumartistid" } - } - T{ frame - { frame-id "TPOS" } - { flags B{ 0 0 } } - { size 2 } - { data "1" } - } - T{ frame - { frame-id "TSOP" } - { flags B{ 0 0 } } - { size 1 } - } - T{ frame - { frame-id "TMED" } - { flags B{ 0 0 } } - { size 4 } - { data "DIG" } - } - } - } -} ] [ "resource:extra/id3/tests/blah2.mp3" file-id3-tags ] unit-test [ - T{ mp3v1-file - { title - "BLAH" - } - { artist - "ARTIST" - } - { album - "ALBUM" - } - { year "2009" } - { comment - "COMMENT" - } - { genre 89 } - } -] [ "resource:extra/id3/tests/blah.mp3" file-id3-tags ] unit-test + T{ id3-info + { title "Stormy Weather" } + { artist "Frank Sinatra" } + { album "Night and Day Frank Sinatra" } + { comment "eng, AG# 08E1C12E" } + { genre "Big Band" } + } +] [ "resource:extra/id3/tests/blah3.mp3" file-id3-tags ] unit-test diff --git a/extra/id3/id3.factor b/extra/id3/id3.factor index 5b0d3f373e..f2bbd08996 100644 --- a/extra/id3/id3.factor +++ b/extra/id3/id3.factor @@ -1,28 +1,159 @@ ! Copyright (C) 2009 Tim Wawrzynczak ! See http://factorcode.org/license.txt for BSD license. -USING: sequences io io.encodings.binary io.files io.pathnames strings kernel math io.mmap io.mmap.uchar accessors syntax combinators math.ranges unicode.categories byte-arrays prettyprint io.encodings.string io.encodings.ascii ; +USING: sequences io io.encodings.binary io.files io.pathnames strings kernel math io.mmap io.mmap.uchar accessors syntax combinators math.ranges unicode.categories byte-arrays io.encodings.string io.encodings.utf8 assocs math.parser ; IN: id3 + ( -- object ) mp3v1-file new ; +: ( -- object ) id3-info new ; -: ( header frames -- object ) mp3v2-file boa ; +: ( header frames -- object ) id3v2-info boa ; :
( -- object ) header new ; : ( -- object ) frame new ; - ] dip { - [ read-frame-id ascii decode >>frame-id ] + [ read-frame-id utf8 decode >>frame-id ] [ read-frame-flags >byte-array >>flags ] [ read-frame-size >28bitword >>size ] - [ read-frame-data ascii decode >>data ] + [ read-frame-data utf8 decode >>data ] } cleave ; : read-frame ( mmap -- frame/f ) @@ -98,9 +229,21 @@ TUPLE: mp3v1-file title artist album year comment genre ; : drop-header ( mmap -- seq1 seq2 ) dup 10 tail-slice swap ; -: read-v2-tag-data ( seq -- mp3v2-file ) - drop-header read-v2-header swap read-frames ; +: parse-frames ( id3v2-info -- id3-info ) + [ ] dip frames>> + { + [ [ frame-id>> "TIT2" = ] find nip [ data>> >>title ] when* ] + [ [ frame-id>> "TALB" = ] find nip [ data>> >>album ] when* ] + [ [ frame-id>> "TPE1" = ] find nip [ data>> >>artist ] when* ] + [ [ frame-id>> "TCON" = ] find nip [ data>> [ [ digit? ] filter string>number ] keep swap [ genres at nip ] when* + >>genre ] when* ] + [ [ frame-id>> "COMM" = ] find nip [ data>> >>comment ] when* ] + [ [ frame-id>> "TYER" = ] find nip [ data>> >>year ] when* ] + } cleave ; +: read-v2-tag-data ( seq -- id3-info ) + drop-header read-v2-header swap read-frames parse-frames ; + ! v1 information : skip-to-v1-data ( seq -- seq ) @@ -125,14 +268,14 @@ TUPLE: mp3v1-file title artist album year comment genre ; [ 124 ] dip nth ; : (read-v1-tag-data) ( seq -- mp3-file ) - [ ] dip + [ ] dip { - [ read-title ascii decode filter-text-data >>title ] - [ read-artist ascii decode filter-text-data >>artist ] - [ read-album ascii decode filter-text-data >>album ] - [ read-year ascii decode filter-text-data >>year ] - [ read-comment ascii decode filter-text-data >>comment ] - [ read-genre >fixnum >>genre ] + [ read-title utf8 decode filter-text-data >>title ] + [ read-artist utf8 decode filter-text-data >>artist ] + [ read-album utf8 decode filter-text-data >>album ] + [ read-year utf8 decode filter-text-data >>year ] + [ read-comment utf8 decode filter-text-data >>comment ] + [ read-genre >fixnum genres at >>genre ] } cleave ; : read-v1-tag-data ( seq -- mp3-file ) @@ -140,13 +283,13 @@ TUPLE: mp3v1-file title artist album year comment genre ; PRIVATE> -! main stuff +! public interface : file-id3-tags ( path -- object/f ) [ { - { [ dup id3v2? ] [ read-v2-tag-data ] } ! ( ? -- mp3v2-file ) - { [ dup id3v1? ] [ read-v1-tag-data ] } ! ( ? -- mp3v1-file ) + { [ dup id3v2? ] [ read-v2-tag-data ] } ! ( ? -- id3v2 ) + { [ dup id3v1? ] [ read-v1-tag-data ] } ! ( ? -- id3-info ) [ drop f ] ! ( mmap -- f ) } cond ] with-mapped-uchar-file ; From 9e68c222f0f34e14b0ba569e65904b4df6aad8c7 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Thu, 19 Feb 2009 10:26:00 +0100 Subject: [PATCH 049/119] FUEL: small refactoring. --- extra/fuel/help/help.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/fuel/help/help.factor b/extra/fuel/help/help.factor index bf637fd0b3..9aaae4ea80 100644 --- a/extra/fuel/help/help.factor +++ b/extra/fuel/help/help.factor @@ -92,7 +92,7 @@ PRIVATE> : (fuel-word-synopsis) ( word usings -- str/f ) [ - [ vocab ] filter interactive-vocabs get append interactive-vocabs set + [ vocab ] filter interactive-vocabs [ append ] change fuel-find-word [ synopsis ] when* ] with-scope ; From e426026f734d1e62209872041c8a0a7b2be46d5d Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Thu, 19 Feb 2009 10:36:52 +0100 Subject: [PATCH 050/119] FUEL: Fix. --- extra/fuel/help/help.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/fuel/help/help.factor b/extra/fuel/help/help.factor index 9aaae4ea80..64d77566b5 100644 --- a/extra/fuel/help/help.factor +++ b/extra/fuel/help/help.factor @@ -93,7 +93,7 @@ PRIVATE> : (fuel-word-synopsis) ( word usings -- str/f ) [ [ vocab ] filter interactive-vocabs [ append ] change - fuel-find-word [ synopsis ] when* + fuel-find-word [ synopsis ] [ f ] if* ] with-scope ; : (fuel-word-see) ( word -- elem ) From bdb790010a029adfcf2b3a5a5360067e6ef1af0d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 19 Feb 2009 04:08:32 -0600 Subject: [PATCH 051/119] Add bytes-per-pixel word to images vocab --- basis/images/images.factor | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/basis/images/images.factor b/basis/images/images.factor index c2dc33608e..5ac0da7a28 100644 --- a/basis/images/images.factor +++ b/basis/images/images.factor @@ -9,6 +9,24 @@ IN: images SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR R16G16B16 R32G32B32 R16G16B16A16 R32G32B32A32 ; +: bytes-per-pixel ( component-order -- n ) + { + { BGR [ 3 ] } + { RGB [ 3 ] } + { BGRA [ 4 ] } + { RGBA [ 4 ] } + { ABGR [ 4 ] } + { ARGB [ 4 ] } + { RGBX [ 4 ] } + { XRGB [ 4 ] } + { BGRX [ 4 ] } + { XBGR [ 4 ] } + { R16G16B16 [ 6 ] } + { R32G32B32 [ 12 ] } + { R16G16B16A16 [ 8 ] } + { R32G32B32A32 [ 16 ] } + } case ; + TUPLE: image dim component-order bitmap ; : ( -- image ) image new ; inline @@ -63,4 +81,4 @@ M: image normalize-scan-line-order ; : normalize-image ( image -- image ) [ >byte-array ] change-bitmap normalize-component-order - normalize-scan-line-order ; + normalize-scan-line-order ; \ No newline at end of file From d6cede8a8f1c8e88d33f360dabfd596381120525 Mon Sep 17 00:00:00 2001 From: Benjamin Pollack Date: Thu, 19 Feb 2009 11:48:40 -0500 Subject: [PATCH 052/119] documentation fix --- 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 39b5a13e30..36496ac5c4 100644 --- a/basis/help/handbook/handbook.factor +++ b/basis/help/handbook/handbook.factor @@ -33,8 +33,8 @@ $nl { { $snippet { $emphasis "foo" } "*" } { "alternative form of " { $snippet "foo" } ", or a generic word called by " { $snippet "foo" } } { { $links at* pprint* } } } { { $snippet "(" { $emphasis "foo" } ")" } { "implementation detail word used by " { $snippet "foo" } } { { $link (clone) } } } { { $snippet "set-" { $emphasis "foo" } } { "sets " { $snippet "foo" } " to a new value" } { $links set-length } } - { { $snippet { $emphasis "foo" } ">>" } { "gets the " { $snippet "foo" } " slot of the tuple at the top of the stack; see " { $link "accessors" } } { { $link >>name } } } - { { $snippet ">>" { $emphasis "foo" } } { "sets the " { $snippet "foo" } " slot of the tuple at the top of the stack; see " { $link "accessors" } } { { $link name>> } } } + { { $snippet { $emphasis "foo" } ">>" } { "gets the " { $snippet "foo" } " slot of the tuple at the top of the stack; see " { $link "accessors" } } { { $link name>> } } } + { { $snippet ">>" { $emphasis "foo" } } { "sets the " { $snippet "foo" } " slot of the tuple at the top of the stack; see " { $link "accessors" } } { { $link >>name } } } { { $snippet "with-" { $emphasis "foo" } } { "performs some kind of initialization and cleanup related to " { $snippet "foo" } ", usually in a new dynamic scope" } { $links with-scope with-input-stream with-output-stream } } { { $snippet "$" { $emphasis "foo" } } { "help markup" } { $links $heading $emphasis } } } From 60134eeb981dcbc75dcb21895071eed0fe719110 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 19 Feb 2009 13:35:53 -0600 Subject: [PATCH 053/119] Documentation fixes --- basis/compiler/compiler-docs.factor | 12 ++++++++---- basis/help/cookbook/cookbook.factor | 19 ------------------- basis/math/functions/functions-docs.factor | 2 +- basis/stack-checker/errors/errors-docs.factor | 2 ++ core/classes/tuple/tuple-docs.factor | 2 +- core/compiler/errors/errors-docs.factor | 13 ++++++++++--- core/vocabs/loader/loader-docs.factor | 13 ++++++++++--- 7 files changed, 32 insertions(+), 31 deletions(-) diff --git a/basis/compiler/compiler-docs.factor b/basis/compiler/compiler-docs.factor index 512d26f4bf..1c6e7b796e 100644 --- a/basis/compiler/compiler-docs.factor +++ b/basis/compiler/compiler-docs.factor @@ -19,15 +19,19 @@ ARTICLE: "compiler-usage" "Calling the optimizing compiler" "Higher-level words can be found in " { $link "compilation-units" } "." ; ARTICLE: "compiler" "Optimizing compiler" -"Factor is a fully compiled language implementation with two distinct compilers:" +"Factor includes two compilers which work behind the scenes. Words are always compiled, and the compilers do not have to be invoked explicitly. For the most part, compilation is fully transparent. However, there are a few things worth knowing about the compilation process." +$nl +"The two compilers differ in the level of analysis they perform:" { $list { "The " { $emphasis "non-optimizing quotation compiler" } " compiles quotations to naive machine code very quickly. The non-optimizing quotation compiler is part of the VM." } { "The " { $emphasis "optimizing word compiler" } " compiles whole words at a time while performing extensive data and control flow analysis. This provides greater performance for generated code, but incurs a much longer compile time. The optimizing compiler is written in Factor." } } -"The optimizing compiler only compiles words which have a static stack effect. This means that methods defined on fundamental generic words such as " { $link nth } " should have a static stack effect; for otherwise, most of the system would be compiled with the non-optimizing compiler. See " { $link "inference" } " and " { $link "cookbook-pitfalls" } "." -{ $subsection "compiler-usage" } +"The optimizing compiler only compiles words which have a static stack effect. This means that methods defined on fundamental generic words such as " { $link nth } " should have a static stack effect. See " { $link "inference" } " and " { $link "cookbook-pitfalls" } "." +$nl +"The optimizing compiler also trades off compile time for performance of generated code, so loading certain vocabularies might take a while. Saving the image after loading vocabularies can save you a lot of time that you would spend waiting for the same code to load in every coding session; see " { $link "images" } " for information." { $subsection "compiler-errors" } -{ $subsection "hints" } ; +{ $subsection "hints" } +{ $subsection "compiler-usage" } ; ABOUT: "compiler" diff --git a/basis/help/cookbook/cookbook.factor b/basis/help/cookbook/cookbook.factor index ebc711d527..3fe09de263 100644 --- a/basis/help/cookbook/cookbook.factor +++ b/basis/help/cookbook/cookbook.factor @@ -220,24 +220,6 @@ ARTICLE: "cookbook-io" "Input and output cookbook" "io" } ; -ARTICLE: "cookbook-compiler" "Compiler cookbook" -"Factor includes two compilers which work behind the scenes. Words are always compiled, and the compilers do not have to be invoked explicitly. For the most part, compilation is a fully transparent process. However, there are a few things worth knowing about the compilation process." -$nl -"The optimizing compiler trades off compile time for performance of generated code, so loading certain vocabularies might take a while. Saving the image after loading vocabularies can save you a lot of time that you would spend waiting for the same code to load in every coding session; see " { $link "images" } " for information." -$nl -"After loading a vocabulary, you might see messages like:" -{ $code - ":errors - print 2 compiler errors." - ":warnings - print 50 compiler warnings." -} -"These warnings arise from the compiler's stack effect checker. Warnings are non-fatal conditions -- not all code has a static stack effect, so you try to minimize warnings but understand that in many cases they cannot be eliminated. Errors indicate programming mistakes, such as erroneous stack effect declarations." -{ $references - "To learn more about the compiler and static stack effect inference, read these articles:" - "compiler" - "compiler-errors" - "inference" -} ; - ARTICLE: "cookbook-application" "Application cookbook" "Vocabularies can define a main entry point:" { $code "IN: game-of-life" @@ -396,7 +378,6 @@ ARTICLE: "cookbook" "Factor cookbook" { $subsection "cookbook-io" } { $subsection "cookbook-application" } { $subsection "cookbook-scripts" } -{ $subsection "cookbook-compiler" } { $subsection "cookbook-philosophy" } { $subsection "cookbook-pitfalls" } { $subsection "cookbook-next" } ; diff --git a/basis/math/functions/functions-docs.factor b/basis/math/functions/functions-docs.factor index ea3da55082..b463a48e49 100644 --- a/basis/math/functions/functions-docs.factor +++ b/basis/math/functions/functions-docs.factor @@ -235,7 +235,7 @@ HELP: arg HELP: >polar { $values { "z" number } { "abs" "a non-negative real number" } { "arg" "a number in the interval " { $snippet "(-pi,pi]" } } } -{ $description "Creates a complex number from an absolute value and argument (polar form)." } ; +{ $description "Converts a complex number into an absolute value and argument (polar form)." } ; HELP: cis { $values { "arg" "a real number" } { "z" "a complex number on the unit circle" } } diff --git a/basis/stack-checker/errors/errors-docs.factor b/basis/stack-checker/errors/errors-docs.factor index c3b9797a36..5b314a3154 100644 --- a/basis/stack-checker/errors/errors-docs.factor +++ b/basis/stack-checker/errors/errors-docs.factor @@ -87,6 +87,8 @@ HELP: inconsistent-recursive-call-error } ; ARTICLE: "inference-errors" "Inference warnings and errors" +"These conditions are thrown by " { $link "inference" } ", as well as the " { $link "compiler" } "." +$nl "Main wrapper for all inference warnings and errors:" { $subsection inference-error } "Inference warnings:" diff --git a/core/classes/tuple/tuple-docs.factor b/core/classes/tuple/tuple-docs.factor index 0469f3564a..32cab65904 100644 --- a/core/classes/tuple/tuple-docs.factor +++ b/core/classes/tuple/tuple-docs.factor @@ -22,7 +22,7 @@ ARTICLE: "slot-class-declaration" "Slot class declarations" ARTICLE: "slot-class-coercion" "Coercive slot declarations" "If the class of a slot is declared to be one of " { $link fixnum } " or " { $link float } ", then rather than testing values with the class predicate, writer words coerce values to the relevant type with " { $link >fixnum } " or " { $link >float } ". This may still result in error, but permits a wider range of values than a class predicate test. It also results in a possible loss of precision; for example, storing a large integer into a " { $link fixnum } " slot will silently overflow and discard high bits, and storing a ratio into a " { $link float } " slot may lose precision if the ratio is one which cannot be represented exactly with floating-point." $nl -"This feature is mostly intended as an optimization for low-level code designed to avoid integer overflow, or where floating point precision is sufficient. Most code needs to work transparently with large integers, and thus hsould avoid the coercion behavior by using " { $link integer } " and " { $link real } " in place of " { $link fixnum } " and " { $link float } "." ; +"This feature is mostly intended as an optimization for low-level code designed to avoid integer overflow, or where floating point precision is sufficient. Most code needs to work transparently with large integers, and thus should avoid the coercion behavior by using " { $link integer } " and " { $link real } " in place of " { $link fixnum } " and " { $link float } "." ; ARTICLE: "tuple-declarations" "Tuple slot declarations" "The slot specifier syntax of the " { $link POSTPONE: TUPLE: } " parsing word understands the following slot attributes:" diff --git a/core/compiler/errors/errors-docs.factor b/core/compiler/errors/errors-docs.factor index f5ecf5add1..8368afeb19 100644 --- a/core/compiler/errors/errors-docs.factor +++ b/core/compiler/errors/errors-docs.factor @@ -3,9 +3,16 @@ USING: help.markup help.syntax vocabs.loader words io quotations words.symbol ; ARTICLE: "compiler-errors" "Compiler warnings and errors" -"The compiler saves " { $link "inference-errors" } " in a global variable:" -{ $subsection compiler-errors } -"These notifications can be viewed later:" +"After loading a vocabulary, you might see messages like:" +{ $code + ":errors - print 2 compiler errors." + ":warnings - print 50 compiler warnings." +} +"These warnings arise from the compiler's stack effect checker. Warnings are non-fatal conditions -- not all code has a static stack effect, so you try to minimize warnings but understand that in many cases they cannot be eliminated. Errors indicate programming mistakes, such as erroneous stack effect declarations." +$nl +"The precise warning and error conditions are documented in " { $link "inference-errors" } "." +$nl +"Words to view warnings and errors:" { $subsection :errors } { $subsection :warnings } { $subsection :linkage } diff --git a/core/vocabs/loader/loader-docs.factor b/core/vocabs/loader/loader-docs.factor index ce3b5ea024..527da053fb 100644 --- a/core/vocabs/loader/loader-docs.factor +++ b/core/vocabs/loader/loader-docs.factor @@ -34,13 +34,20 @@ $nl { $subsection "vocabs.roots" } "Vocabulary names map directly to source files. A vocabulary named " { $snippet "foo.bar" } " must be defined in a " { $snippet "bar" } " directory nested inside a " { $snippet "foo" } " directory of a vocabulary root. Any level of vocabulary nesting is permitted." $nl -"The vocabulary directory - " { $snippet "bar" } " in our example - can contain the following files; the first is required while the rest are optional:" +"The vocabulary directory - " { $snippet "bar" } " in our example - contains a source file:" +{ $list + { { $snippet "foo/bar/bar.factor" } " - the source file, must define words in the " { $snippet "foo.bar" } " vocabulary with an " { $snippet "IN: foo.bar" } " form" } +} +"Two other Factor source files, storing documentation and tests, respectively, are optional:" { $list - { { $snippet "foo/bar/bar.factor" } " - the source file, defines words in the " { $snippet "foo.bar" } " vocabulary" } { { $snippet "foo/bar/bar-docs.factor" } " - documentation, see " { $link "writing-help" } } { { $snippet "foo/bar/bar-tests.factor" } " - unit tests, see " { $link "tools.test" } } +} +"Finally, three text files can contain meta-data:" +{ $list + { { $snippet "foo/bar/authors.txt" } " - a series of lines, with one author name per line. These are listed under " { $link "vocab-authors" } } { { $snippet "foo/bar/summary.txt" } " - a one-line description" } - { { $snippet "foo/bar/tags.txt" } " - a whitespace-separated list of tags which classify the vocabulary" } + { { $snippet "foo/bar/tags.txt" } " - a whitespace-separated list of tags which classify the vocabulary. Consult " { $link "vocab-tags" } " for a list of existing tags you can re-use" } } "While " { $link POSTPONE: USE: } " and " { $link POSTPONE: USING: } " load vocabularies which have not been loaded before adding them to the search path, it is also possible to load a vocabulary without adding it to the search path:" { $subsection require } From 90b6b38fd132a227c848c09fb6d77651f0274451 Mon Sep 17 00:00:00 2001 From: Jason Merrill Date: Thu, 19 Feb 2009 18:49:13 -0500 Subject: [PATCH 054/119] Changed math.dual to define words as dword instead of overloading generic words on dual numbers. --- basis/math/functions/functions.factor | 8 +--- .../math/derivatives/derivatives-tests.factor | 4 -- extra/math/dual/dual-docs.factor | 6 +-- extra/math/dual/dual-tests.factor | 6 +-- extra/math/dual/dual.factor | 43 +++++-------------- 5 files changed, 19 insertions(+), 48 deletions(-) delete mode 100644 extra/math/derivatives/derivatives-tests.factor diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 3a1ce18daa..85b4d711ac 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -252,14 +252,10 @@ M: real tanh ftanh ; : -i* ( x -- y ) >rect swap neg rect> ; -GENERIC: asin ( x -- y ) foldable - -M: number asin +: asin ( x -- y ) dup [-1,1]? [ fasin ] [ i* asinh -i* ] if ; inline -GENERIC: acos ( x -- y ) foldable - -M: number acos +: acos ( x -- y ) dup [-1,1]? [ facos ] [ asin pi 2 / swap - ] if ; inline diff --git a/extra/math/derivatives/derivatives-tests.factor b/extra/math/derivatives/derivatives-tests.factor deleted file mode 100644 index f95eb43849..0000000000 --- a/extra/math/derivatives/derivatives-tests.factor +++ /dev/null @@ -1,4 +0,0 @@ -! Copyright (C) 2009 Jason W. Merrill. -! See http://factorcode.org/license.txt for BSD license. -USING: tools.test automatic-differentiation.derivatives ; -IN: automatic-differentiation.derivatives.tests diff --git a/extra/math/dual/dual-docs.factor b/extra/math/dual/dual-docs.factor index 6c287a8f1e..1f24c8217c 100644 --- a/extra/math/dual/dual-docs.factor +++ b/extra/math/dual/dual-docs.factor @@ -88,14 +88,14 @@ HELP: drecip } { $description "Reciprocal of a dual number." } ; -HELP: define-dual-method +HELP: define-dual { $values { "word" word } } -{ $description "Defines a method on the dual numbers for generic word." } +{ $description "Defines a word " { $snippet "d[word]" } " in the " { $vocab-link "math.dual" } " vocabulary that operates on dual numbers." } { $notes "Uses the derivative word-prop, which holds a list of quotations giving the partial derivatives of the word with respect to each of its arguments. This can be set using " { $link POSTPONE: DERIVATIVE: } "." } ; -{ define-dual-method dual-op POSTPONE: DERIVATIVE: } related-words +{ define-dual dual-op POSTPONE: DERIVATIVE: } related-words HELP: dual { $class-description "The class of dual numbers with non-zero epsilon part." } ; diff --git a/extra/math/dual/dual-tests.factor b/extra/math/dual/dual-tests.factor index ea46c46124..dbafe74d6a 100644 --- a/extra/math/dual/dual-tests.factor +++ b/extra/math/dual/dual-tests.factor @@ -4,13 +4,13 @@ USING: tools.test math.dual kernel accessors math math.functions math.constants ; IN: math.dual.tests -[ 0.0 1.0 ] [ 0 1 sin unpack-dual ] unit-test -[ 1.0 0.0 ] [ 0 1 cos unpack-dual ] unit-test +[ 0.0 1.0 ] [ 0 1 dsin unpack-dual ] unit-test +[ 1.0 0.0 ] [ 0 1 dcos unpack-dual ] unit-test [ 3 5 ] [ 1 5 2 d+ unpack-dual ] unit-test [ 0 -1 ] [ 1 5 1 6 d- unpack-dual ] unit-test [ 2 1 ] [ 2 3 1 -1 d* unpack-dual ] unit-test [ 1/2 -1/4 ] [ 2 1 1 swap d/ unpack-dual ] unit-test [ 2 ] [ 1 1 2 d^ epsilon-part>> ] unit-test -[ 2.0 .25 ] [ 4 1 sqrt unpack-dual ] unit-test +[ 2.0 .25 ] [ 4 1 dsqrt unpack-dual ] unit-test [ 2 -1 ] [ -2 1 dabs unpack-dual ] unit-test [ -2 -1 ] [ 2 1 dneg unpack-dual ] unit-test \ No newline at end of file diff --git a/extra/math/dual/dual.factor b/extra/math/dual/dual.factor index 36d684bc6d..c85c23e51d 100644 --- a/extra/math/dual/dual.factor +++ b/extra/math/dual/dual.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Jason W. Merrill. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.functions math.derivatives accessors - macros words effects sequences generalizations fry + macros words effects vocabs sequences generalizations fry combinators.smart generic compiler.units ; IN: math.dual @@ -57,36 +57,15 @@ MACRO: dual-op ( word -- ) tri '[ _ @ @ ] ; -: define-dual-method ( word -- ) - [ \ dual swap create-method ] keep '[ _ dual-op ] define ; +: define-dual ( word -- ) + [ + [ stack-effect ] + [ name>> "d" prepend "math.dual" create ] + bi [ set-stack-effect ] keep + ] + keep + '[ _ dual-op ] define ; ! Specialize math functions to operate on dual numbers. -[ { sqrt exp log sin cos tan sinh cosh tanh acos asin atan } - [ define-dual-method ] each ] with-compilation-unit - -! Inverse methods { asinh, acosh, atanh } are not generic, so -! there is no way to specialize them for dual numbers. However, -! they are defined in terms of functions that can operate on -! dual numbers and arithmetic methods, so if it becomes -! possible to make arithmetic operators work directly on dual -! numbers, we will get these for free. - -! Arithmetic words are not generic (yet?), so we have to -! define special versions of them to operate on dual numbers. -: d+ ( x y -- x+y ) \ + dual-op ; -: d- ( x y -- x-y ) \ - dual-op ; -: d* ( x y -- x*y ) \ * dual-op ; -: d/ ( x y -- x/y ) \ / dual-op ; -: d^ ( x y -- x^y ) \ ^ dual-op ; - -: dabs ( x -- |x| ) \ abs dual-op ; - -! The following words are also not generic, but are defined in -! terms of words that can operate on dual numbers and -! arithmetic. If it becomes possible to implement arithmetic on -! dual numbers directly, these functions can be deleted. -: dneg ( x -- -x ) \ neg dual-op ; -: drecip ( x -- 1/x ) \ recip dual-op ; -: dasinh ( x -- y ) \ asinh dual-op ; -: dacosh ( x -- y ) \ acosh dual-op ; -: datanh ( x -- y ) \ atanh dual-op ; \ No newline at end of file +[ all-words [ "derivative" word-prop ] filter + [ define-dual ] each ] with-compilation-unit \ No newline at end of file From 3bd573fe13446ff4ec8b8fa15a93aec5a0b1f646 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Fri, 20 Feb 2009 01:02:24 +0100 Subject: [PATCH 055/119] FUEL: New refactoring command: fuel-refactor-make-generic. --- misc/fuel/README | 2 ++ misc/fuel/fuel-mode.el | 1 + misc/fuel/fuel-refactor.el | 22 ++++++++++++++++++++++ misc/fuel/fuel-syntax.el | 7 ++++--- 4 files changed, 29 insertions(+), 3 deletions(-) diff --git a/misc/fuel/README b/misc/fuel/README index 79b8f49f9a..0411e0709b 100644 --- a/misc/fuel/README +++ b/misc/fuel/README @@ -139,6 +139,8 @@ beast. | C-cC-xi | replace word by its definition (fuel-refactor-inline-word) | | C-cC-xw | rename all uses of a word (fuel-refactor-rename-word) | | C-cC-xa | extract region as a separate ARTICLE: form | + | C-cC-xg | convert current word definition into GENERIC + method | + | | (fuel-refactor-make-generic) | |-----------------+------------------------------------------------------------| *** In the listener: diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index c4f08f3c62..aa9a7d944e 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -213,6 +213,7 @@ interacting with a factor listener is at your disposal. (fuel-mode--key ?x ?a 'fuel-refactor-extract-article) (fuel-mode--key ?x ?i 'fuel-refactor-inline-word) +(fuel-mode--key ?x ?g 'fuel-refactor-make-generic) (fuel-mode--key ?x ?r 'fuel-refactor-extract-region) (fuel-mode--key ?x ?s 'fuel-refactor-extract-sexp) (fuel-mode--key ?x ?v 'fuel-refactor-extract-vocab) diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el index bd62227755..942d439466 100644 --- a/misc/fuel/fuel-refactor.el +++ b/misc/fuel/fuel-refactor.el @@ -145,6 +145,28 @@ word." (if (looking-at-p ";") (point) (fuel-syntax--end-of-symbol-pos)))) + +;;; Convert word to generic + method: + +(defun fuel-refactor-make-generic () + "Inserts a new generic definition with the current word's stack effect. +The word's body is put in a new method for the generic." + (interactive) + (let ((p (point))) + (fuel-syntax--beginning-of-defun) + (unless (re-search-forward fuel-syntax--word-signature-regex nil t) + (goto-char p) + (error "Cannot find a proper word definition here")) + (let ((begin (match-beginning 0)) + (end (match-end 0)) + (name (match-string-no-properties 1)) + (cls (read-string "Method's class (object): " nil nil "object"))) + (goto-char begin) + (insert "GENERIC") + (goto-char (+ end 7)) + (newline 2) + (insert "M: " cls " " name " ")))) + ;;; Inline word: diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 67341120c1..b6409b2fea 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -212,10 +212,11 @@ fuel-syntax--end-of-def-line-regex fuel-syntax--single-liner-regex)) +(defconst fuel-syntax--word-signature-regex + (format ":[^ ]* \\([^ ]+\\)\\(%s\\)*" fuel-syntax--stack-effect-regex)) + (defconst fuel-syntax--defun-signature-regex - (format "\\(%s\\|%s\\)" - (format ":[^ ]* [^ ]+\\(%s\\)*" fuel-syntax--stack-effect-regex) - "M[^:]*: [^ ]+ [^ ]+")) + (format "\\(%s\\|%s\\)" fuel-syntax--word-signature-regex "M[^:]*: [^ ]+ [^ ]+")) (defconst fuel-syntax--constructor-decl-regex "\\_ Date: Thu, 19 Feb 2009 18:26:11 -0600 Subject: [PATCH 056/119] fix sqlite foreign triggers create/delete bug ignore-errors only if there is a sql spec defined for the class until database-specific errors are implemented --- basis/db/sqlite/lib/lib.factor | 6 +- basis/db/sqlite/sqlite-tests.factor | 8 +- basis/db/sqlite/sqlite.factor | 135 ++++++++++++++++++++-------- basis/db/tuples/tuples.factor | 37 +++++--- 4 files changed, 130 insertions(+), 56 deletions(-) diff --git a/basis/db/sqlite/lib/lib.factor b/basis/db/sqlite/lib/lib.factor index b1bc9aa1a2..60141bc830 100644 --- a/basis/db/sqlite/lib/lib.factor +++ b/basis/db/sqlite/lib/lib.factor @@ -5,8 +5,7 @@ namespaces sequences db.sqlite.ffi db combinators continuations db.types calendar.format serialize io.streams.byte-array byte-arrays io.encodings.binary io.backend db.errors present urls io.encodings.utf8 -io.encodings.string accessors shuffle io prettyprint -db.private ; +io.encodings.string accessors shuffle io db.private ; IN: db.sqlite.lib ERROR: sqlite-error < db-error n string ; @@ -125,8 +124,7 @@ ERROR: sqlite-sql-error < sql-error n string ; ] if* (sqlite-bind-type) ; : sqlite-finalize ( handle -- ) sqlite3_finalize sqlite-check-result ; -: sqlite-reset ( handle -- ) -"resetting: " write dup . sqlite3_reset sqlite-check-result ; +: sqlite-reset ( handle -- ) sqlite3_reset sqlite-check-result ; : sqlite-clear-bindings ( handle -- ) sqlite3_clear_bindings sqlite-check-result ; : sqlite-#columns ( query -- int ) sqlite3_column_count ; diff --git a/basis/db/sqlite/sqlite-tests.factor b/basis/db/sqlite/sqlite-tests.factor index 5ad4b0c889..677ec17a6e 100644 --- a/basis/db/sqlite/sqlite-tests.factor +++ b/basis/db/sqlite/sqlite-tests.factor @@ -1,6 +1,7 @@ USING: io io.files io.files.temp io.directories io.launcher kernel namespaces prettyprint tools.test db.sqlite db sequences -continuations db.types db.tuples unicode.case ; +continuations db.types db.tuples unicode.case accessors arrays +sorting ; IN: db.sqlite.tests : db-path ( -- path ) "test.db" temp-file ; @@ -74,8 +75,9 @@ IN: db.sqlite.tests ] with-db ] unit-test +[ \ swap ensure-table ] must-fail + ! You don't need a primary key -USING: accessors arrays sorting ; TUPLE: things one two ; things "THINGS" { @@ -163,5 +165,3 @@ watch "WATCH" { user>> f user boa select-tuple ] with-db ] unit-test - -[ \ swap ensure-table ] must-fail diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index d006145ea8..62a1b4714f 100755 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -1,12 +1,12 @@ ! Copyright (C) 2005, 2008 Chris Double, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien arrays assocs classes compiler db hashtables -io.files kernel math math.parser namespaces prettyprint +io.files kernel math math.parser namespaces prettyprint fry sequences strings classes.tuple alien.c-types continuations db.sqlite.lib db.sqlite.ffi db.tuples words db.types combinators math.intervals io nmake accessors vectors math.ranges random math.bitwise db.queries destructors db.tuples.private interpolate -io.streams.string multiline make db.private ; +io.streams.string multiline make db.private sequences.deep ; IN: db.sqlite TUPLE: sqlite-db path ; @@ -126,30 +126,6 @@ M: sqlite-statement query-results ( query -- result-set ) dup handle>> sqlite-result-set new-result-set dup advance-row ; -M: sqlite-db-connection create-sql-statement ( class -- statement ) - [ - dupd - "create table " 0% 0% - "(" 0% [ ", " 0% ] [ - dup "sql-spec" set - dup column-name>> [ "table-id" set ] [ 0% ] bi - " " 0% - dup type>> lookup-create-type 0% - modifiers 0% - ] interleave - - find-primary-key [ - ", " 0% - "primary key(" 0% - [ "," 0% ] [ column-name>> 0% ] interleave - ")" 0% - ] unless-empty - ");" 0% - ] query-make ; - -M: sqlite-db-connection drop-sql-statement ( class -- statement ) - [ "drop table " 0% 0% ";" 0% drop ] query-make ; - M: sqlite-db-connection ( tuple -- statement ) [ "insert into " 0% 0% @@ -225,7 +201,7 @@ M: sqlite-db-connection persistent-table ( -- assoc ) : insert-trigger ( -- string ) [ <" - CREATE TRIGGER fki_${table-name}_${foreign-table-name}_id + CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id BEFORE INSERT ON ${table-name} FOR EACH ROW BEGIN SELECT RAISE(ROLLBACK, 'insert on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"') @@ -237,7 +213,7 @@ M: sqlite-db-connection persistent-table ( -- assoc ) : insert-trigger-not-null ( -- string ) [ <" - CREATE TRIGGER fki_${table-name}_${foreign-table-name}_id + CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id BEFORE INSERT ON ${table-name} FOR EACH ROW BEGIN SELECT RAISE(ROLLBACK, 'insert on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"') @@ -247,10 +223,17 @@ M: sqlite-db-connection persistent-table ( -- assoc ) "> interpolate ] with-string-writer ; +: drop-insert-trigger ( -- string ) + [ + <" + DROP TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id; + "> interpolate + ] with-string-writer ; + : update-trigger ( -- string ) [ <" - CREATE TRIGGER fku_${table-name}_${foreign-table-name}_id + CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id BEFORE UPDATE ON ${table-name} FOR EACH ROW BEGIN SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"') @@ -262,7 +245,7 @@ M: sqlite-db-connection persistent-table ( -- assoc ) : update-trigger-not-null ( -- string ) [ <" - CREATE TRIGGER fku_${table-name}_${foreign-table-name}_id + CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id BEFORE UPDATE ON ${table-name} FOR EACH ROW BEGIN SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"') @@ -272,10 +255,17 @@ M: sqlite-db-connection persistent-table ( -- assoc ) "> interpolate ] with-string-writer ; +: drop-update-trigger ( -- string ) + [ + <" + DROP TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id; + "> interpolate + ] with-string-writer ; + : delete-trigger-restrict ( -- string ) [ <" - CREATE TRIGGER fkd_${table-name}_${foreign-table-name}_id + CREATE TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id BEFORE DELETE ON ${foreign-table-name} FOR EACH ROW BEGIN SELECT RAISE(ROLLBACK, 'delete on table "${foreign-table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"') @@ -284,10 +274,17 @@ M: sqlite-db-connection persistent-table ( -- assoc ) "> interpolate ] with-string-writer ; +: drop-delete-trigger-restrict ( -- string ) + [ + <" + DROP TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id; + "> interpolate + ] with-string-writer ; + : delete-trigger-cascade ( -- string ) [ <" - CREATE TRIGGER fkd_${table-name}_${foreign-table-name}_id + CREATE TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id BEFORE DELETE ON ${foreign-table-name} FOR EACH ROW BEGIN DELETE from ${table-name} WHERE ${table-id} = OLD.${foreign-table-id}; @@ -295,6 +292,13 @@ M: sqlite-db-connection persistent-table ( -- assoc ) "> interpolate ] with-string-writer ; +: drop-delete-trigger-cascade ( -- string ) + [ + <" + DROP TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id; + "> interpolate + ] with-string-writer ; + : can-be-null? ( -- ? ) "sql-spec" get modifiers>> [ +not-null+ = ] any? not ; @@ -318,14 +322,69 @@ M: sqlite-db-connection persistent-table ( -- assoc ) delete-trigger-restrict sqlite-trigger, ] if ; +: drop-sqlite-triggers ( -- ) + drop-insert-trigger sqlite-trigger, + drop-update-trigger sqlite-trigger, + delete-cascade? [ + drop-delete-trigger-cascade sqlite-trigger, + ] [ + drop-delete-trigger-restrict sqlite-trigger, + ] if ; + +: db-triggers ( sql-specs word -- ) + '[ + [ modifiers>> [ +foreign-id+ = ] deep-any? ] filter + [ + [ class>> db-table-name "db-table" set ] + [ column-name>> "table-id" set ] + [ + modifiers>> [ [ +foreign-id+ = ] deep-any? ] filter + [ + [ second db-table-name "foreign-table-name" set ] + [ third "foreign-table-id" set ] bi + _ execute + ] each + ] tri + ] each + ] call ; + +: sqlite-create-table ( sql-specs class-name -- ) + [ + "create table " 0% 0% + "(" 0% [ ", " 0% ] [ + dup "sql-spec" set + dup column-name>> [ "table-id" set ] [ 0% ] bi + " " 0% + dup type>> lookup-create-type 0% + modifiers 0% + ] interleave + ] [ + drop + find-primary-key [ + ", " 0% + "primary key(" 0% + [ "," 0% ] [ column-name>> 0% ] interleave + ")" 0% + ] unless-empty + ");" 0% + ] 2bi ; + +M: sqlite-db-connection create-sql-statement ( class -- statement ) + [ + ! specs name + [ sqlite-create-table ] + [ drop \ create-sqlite-triggers db-triggers ] 2bi + ] query-make ; + +M: sqlite-db-connection drop-sql-statement ( class -- statements ) + [ + [ nip "drop table " 0% 0% ";" 0% ] + [ drop \ drop-sqlite-triggers db-triggers ] 2bi + ] query-make ; + M: sqlite-db-connection compound ( string seq -- new-string ) over { { "default" [ first number>string " " glue ] } - { "references" [ - [ >reference-string ] keep - first2 [ db-table-name "foreign-table-name" set ] - [ "foreign-table-id" set ] bi* - create-sqlite-triggers - ] } + { "references" [ >reference-string ] } [ 2drop ] } case ; diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor index 219116aefd..9edd5bac69 100644 --- a/basis/db/tuples/tuples.factor +++ b/basis/db/tuples/tuples.factor @@ -3,7 +3,8 @@ USING: arrays assocs classes db kernel namespaces classes.tuple words sequences slots math accessors math.parser io prettyprint db.types continuations -destructors mirrors sets db.types db.private ; +destructors mirrors sets db.types db.private fry +combinators.short-circuit ; IN: db.tuples HOOK: create-sql-statement db-connection ( class -- object ) @@ -29,7 +30,7 @@ GENERIC: eval-generator ( singleton -- object ) : resulting-tuple ( exemplar-tuple row out-params -- tuple ) rot class new [ - [ [ slot-name>> ] dip set-slot-named ] curry 2each + '[ slot-name>> _ set-slot-named ] 2each ] keep ; : query-tuples ( exemplar-tuple statement -- seq ) @@ -98,33 +99,49 @@ M: query >query clone ; M: tuple >query swap >>tuple ; +ERROR: no-defined-persistent object ; + +: ensure-defined-persistent ( object -- object ) + dup { [ class? ] [ "db-table" word-prop ] } 1&& [ + no-defined-persistent + ] unless ; + : create-table ( class -- ) + ensure-defined-persistent create-sql-statement [ execute-statement ] with-disposals ; : drop-table ( class -- ) + ensure-defined-persistent drop-sql-statement [ execute-statement ] with-disposals ; : recreate-table ( class -- ) + ensure-defined-persistent [ - [ drop-sql-statement [ execute-statement ] with-disposals - ] curry ignore-errors + '[ + _ drop-sql-statement [ execute-statement ] with-disposals + ] ignore-errors ] [ create-table ] bi ; -: ensure-table ( class -- ) [ create-table ] curry ignore-errors ; +: ensure-table ( class -- ) + ensure-defined-persistent + '[ _ create-table ] ignore-errors ; : ensure-tables ( classes -- ) [ ensure-table ] each ; : insert-tuple ( tuple -- ) - dup class db-columns find-primary-key db-assigned-id-spec? + dup class ensure-defined-persistent + db-columns find-primary-key db-assigned-id-spec? [ insert-db-assigned-statement ] [ insert-user-assigned-statement ] if ; : update-tuple ( tuple -- ) - dup class + dup class ensure-defined-persistent db-connection get update-statements>> [ ] cache [ bind-tuple ] keep execute-statement ; : delete-tuples ( tuple -- ) - dup dup class [ + dup + dup class ensure-defined-persistent + [ [ bind-tuple ] keep execute-statement ] with-disposal ; @@ -132,8 +149,8 @@ M: tuple >query swap >>tuple ; >query [ tuple>> ] [ query>statement ] bi do-select ; : select-tuple ( query/tuple -- tuple/f ) - >query 1 >>limit [ tuple>> ] [ query>statement ] bi do-select - [ f ] [ first ] if-empty ; + >query 1 >>limit [ tuple>> ] [ query>statement ] bi + do-select [ f ] [ first ] if-empty ; : count-tuples ( query/tuple -- n ) >query [ tuple>> ] [ ] bi do-count From dd1587c74582b08267de6d8c2278809e31265088 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 19 Feb 2009 18:52:45 -0600 Subject: [PATCH 057/119] Fixing SQLite unit tests --- basis/db/sqlite/sqlite-tests.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/basis/db/sqlite/sqlite-tests.factor b/basis/db/sqlite/sqlite-tests.factor index 677ec17a6e..fd730f07ae 100644 --- a/basis/db/sqlite/sqlite-tests.factor +++ b/basis/db/sqlite/sqlite-tests.factor @@ -117,7 +117,7 @@ hi "HELLO" { 1 insert-tuple f select-tuple 1 1 insert-tuple - f select-tuple + f f select-tuple hi drop-table foo drop-table ] with-db @@ -160,6 +160,7 @@ watch "WATCH" { show new insert-tuple show new select-tuple "littledan" f user boa select-tuple + swap [ username>> ] [ id>> ] bi* watch boa insert-tuple watch new select-tuple user>> f user boa select-tuple From d59415d23b606ad7d89e1a6d634d6644658f5a70 Mon Sep 17 00:00:00 2001 From: Jason Merrill Date: Thu, 19 Feb 2009 22:21:31 -0500 Subject: [PATCH 058/119] Fixed help for math.dual. Help is now autogenerated where possible. --- extra/math/dual/dual-docs.factor | 79 -------------------------------- extra/math/dual/dual.factor | 30 ++++++++---- 2 files changed, 21 insertions(+), 88 deletions(-) diff --git a/extra/math/dual/dual-docs.factor b/extra/math/dual/dual-docs.factor index 1f24c8217c..67b3d6ae97 100644 --- a/extra/math/dual/dual-docs.factor +++ b/extra/math/dual/dual-docs.factor @@ -10,84 +10,6 @@ HELP: } { $description "Creates a dual number from its ordinary and epsilon parts." } ; -HELP: d* -{ $values - { "x" dual } { "y" dual } - { "x*y" dual } -} -{ $description "Multiply dual numbers." } ; - -HELP: d+ -{ $values - { "x" dual } { "y" dual } - { "x+y" dual } -} -{ $description "Add dual numbers." } ; - -HELP: d- -{ $values - { "x" dual } { "y" dual } - { "x-y" dual } -} -{ $description "Subtract dual numbers." } ; - -HELP: d/ -{ $values - { "x" dual } { "y" dual } - { "x/y" dual } -} -{ $description "Divide dual numbers." } -{ $errors "Throws an error if the ordinary part of " { $snippet "x" } " is zero." } ; - -HELP: d^ -{ $values - { "x" dual } { "y" dual } - { "x^y" dual } -} -{ $description "Raise a dual number to a (possibly dual) power" } ; - -HELP: dabs -{ $values - { "x" dual } - { "|x|" dual } -} -{ $description "Absolute value of a dual number." } ; - -HELP: dacosh -{ $values - { "x" dual } - { "y" dual } -} -{ $description "Inverse hyberbolic cosine of a dual number." } ; - -HELP: dasinh -{ $values - { "x" dual } - { "y" dual } -} -{ $description "Inverse hyberbolic sine of a dual number." } ; - -HELP: datanh -{ $values - { "x" dual } - { "y" dual } -} -{ $description "Inverse hyberbolic tangent of a dual number." } ; - -HELP: dneg -{ $values - { "x" dual } - { "-x" dual } -} -{ $description "Negative of a dual number." } ; - -HELP: drecip -{ $values - { "x" dual } - { "1/x" dual } -} -{ $description "Reciprocal of a dual number." } ; - HELP: define-dual { $values { "word" word } @@ -128,5 +50,4 @@ $nl "Dual numbers are ordered pairs " { $snippet ""} "--an ordinary part and an epsilon part--with component-wise addition and multiplication defined by "{ $snippet "* = " } ". They are analagous to complex numbers with " { $snippet "i^2 = 0" } "instead of " { $snippet "i^2 = -1" } ". For well-behaved functions " { $snippet "f" } ", " { $snippet "f() = f(o1) + e1*f'(o1)" } ", where " { $snippet "f'"} " is the derivative of " { $snippet "f" } "." ; - ABOUT: "math.dual" diff --git a/extra/math/dual/dual.factor b/extra/math/dual/dual.factor index c85c23e51d..3e0e5437b4 100644 --- a/extra/math/dual/dual.factor +++ b/extra/math/dual/dual.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2009 Jason W. Merrill. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.functions math.derivatives accessors - macros words effects vocabs sequences generalizations fry - combinators.smart generic compiler.units ; + macros generic compiler.units words effects vocabs + sequences arrays assocs generalizations fry make + combinators.smart help help.markup ; IN: math.dual @@ -48,6 +49,19 @@ MACRO: chain-rule ( word -- e ) tri '[ [ @ _ @ ] sum-outputs ] ; +: set-dual-help ( word dword -- ) + [ swap + [ stack-effect [ in>> ] [ out>> ] bi append + [ dual ] { } map>assoc { $values } prepend + ] + [ [ { $description } % "Version of " , + { $link } swap suffix , + " extended to work on dual numbers." , ] + { } make + ] + bi* 2array + ] keep set-word-help ; + PRIVATE> MACRO: dual-op ( word -- ) @@ -58,13 +72,11 @@ MACRO: dual-op ( word -- ) '[ _ @ @ ] ; : define-dual ( word -- ) - [ - [ stack-effect ] - [ name>> "d" prepend "math.dual" create ] - bi [ set-stack-effect ] keep - ] - keep - '[ _ dual-op ] define ; + dup name>> "d" prepend "math.dual" create + [ [ stack-effect ] dip set-stack-effect ] + [ set-dual-help ] + [ swap '[ _ dual-op ] define ] + 2tri ; ! Specialize math functions to operate on dual numbers. [ all-words [ "derivative" word-prop ] filter From 989912cb476e904538b96377865a020cfa8a14db Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Fri, 20 Feb 2009 16:55:08 +0100 Subject: [PATCH 059/119] FUEL: Support for $or markup (still elisp-based, sorry). --- misc/fuel/fuel-markup.el | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el index 980ea111a6..3a00b70ab1 100644 --- a/misc/fuel/fuel-markup.el +++ b/misc/fuel/fuel-markup.el @@ -118,6 +118,7 @@ ($nl . fuel-markup--newline) ($notes . fuel-markup--notes) ($operation . fuel-markup--link) + ($or . fuel-markup--or) ($parsing-note . fuel-markup--parsing-note) ($predicate . fuel-markup--predicate) ($prettyprinting-note . fuel-markup--prettyprinting-note) @@ -468,6 +469,14 @@ (fuel-markup--instance (cons '$instance (cdr e))) (insert " or f ")) +(defun fuel-markup--or (e) + (let ((fst (car (cdr e))) + (mid (butlast (cddr e))) + (lst (car (last (cdr e))))) + (insert (format "%s" fst)) + (dolist (m mid) (insert (format ", %s" m))) + (insert (format " or %s" lst)))) + (defun fuel-markup--values (e) (fuel-markup--insert-heading "Inputs and outputs") (dolist (val (cdr e)) From 19acf89d82b0f7f33f58b02cbe505930432a036d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 20 Feb 2009 12:12:00 -0600 Subject: [PATCH 060/119] fix find-in-program-files --- basis/io/directories/search/search.factor | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index 41031f8ac3..b56fb7b6a3 100755 --- a/basis/io/directories/search/search.factor +++ b/basis/io/directories/search/search.factor @@ -57,8 +57,14 @@ PRIVATE> pusher [ [ f ] compose iterate-directory drop ] dip ] [ drop f ] recover ; inline +ERROR: file-not-found ; + : find-in-directories ( directories bfs? quot: ( obj -- ? ) -- path'/f ) - '[ _ _ find-file ] attempt-all ; + [ + '[ _ _ find-file [ file-not-found ] unless* ] attempt-all + ] [ + drop f + ] recover ; : find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f ) '[ _ _ find-all-files ] map concat ; From 394ec538a1afdd8d695b4aeb3b44e87147285006 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 20 Feb 2009 12:15:26 -0600 Subject: [PATCH 061/119] make emacsw32 work on windows out of the box --- basis/editors/emacs/emacs.factor | 13 +++++++++---- basis/editors/emacs/windows/authors.txt | 1 + basis/editors/emacs/windows/windows.factor | 9 +++++++++ 3 files changed, 19 insertions(+), 4 deletions(-) create mode 100755 basis/editors/emacs/windows/authors.txt create mode 100755 basis/editors/emacs/windows/windows.factor diff --git a/basis/editors/emacs/emacs.factor b/basis/editors/emacs/emacs.factor index 79387f9820..fa78c1b429 100644 --- a/basis/editors/emacs/emacs.factor +++ b/basis/editors/emacs/emacs.factor @@ -1,12 +1,18 @@ USING: definitions io.launcher kernel parser words sequences math -math.parser namespaces editors make system ; +math.parser namespaces editors make system combinators.short-circuit ; IN: editors.emacs +SYMBOL: emacsclient-path + +HOOK: default-emacsclient os ( -- path ) + +M: object default-emacsclient ( -- path ) "emacsclient" ; + : emacsclient ( file line -- ) [ - \ emacsclient get "emacsclient" or , + { [ \ emacsclient-path get ] [ default-emacsclient ] } 0|| , os windows? [ "--no-wait" , ] unless - "+" swap number>string append , + number>string "+" prepend , , ] { } make try-process ; @@ -14,4 +20,3 @@ IN: editors.emacs where first2 emacsclient ; [ emacsclient ] edit-hook set-global - diff --git a/basis/editors/emacs/windows/authors.txt b/basis/editors/emacs/windows/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/editors/emacs/windows/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/editors/emacs/windows/windows.factor b/basis/editors/emacs/windows/windows.factor new file mode 100755 index 0000000000..d5c1e7811c --- /dev/null +++ b/basis/editors/emacs/windows/windows.factor @@ -0,0 +1,9 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: editors.emacs io.directories.search.windows kernel sequences +system ; +IN: editors.emacs.windows + +M: windows default-emacsclient + "Emacs" t [ "emacsclient.exe" tail? ] find-in-program-files + "emacsclient.exe" or ; From 114d9bb21c2d8079b9d3ffb1f2ff14f5f21cd148 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 20 Feb 2009 12:25:55 -0600 Subject: [PATCH 062/119] run with --no-wait on windows so emacsclient doesn't block, use run-detached so that errors on emacsclient exit are ignored. emacs on windows is fully usable now --- basis/editors/emacs/emacs.factor | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/basis/editors/emacs/emacs.factor b/basis/editors/emacs/emacs.factor index fa78c1b429..0aeb7bb467 100644 --- a/basis/editors/emacs/emacs.factor +++ b/basis/editors/emacs/emacs.factor @@ -1,5 +1,6 @@ USING: definitions io.launcher kernel parser words sequences math -math.parser namespaces editors make system combinators.short-circuit ; +math.parser namespaces editors make system combinators.short-circuit +fry threads ; IN: editors.emacs SYMBOL: emacsclient-path @@ -11,10 +12,10 @@ M: object default-emacsclient ( -- path ) "emacsclient" ; : emacsclient ( file line -- ) [ { [ \ emacsclient-path get ] [ default-emacsclient ] } 0|| , - os windows? [ "--no-wait" , ] unless + "--no-wait" , number>string "+" prepend , , - ] { } make try-process ; + ] { } make run-detached drop ; : emacs ( word -- ) where first2 emacsclient ; From 1b9208490bb1d29cf67fb49f043a20cf9cdb92ae Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 20 Feb 2009 12:32:07 -0600 Subject: [PATCH 063/119] keep the old emacs behavior on unix systems --- basis/editors/emacs/emacs.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/basis/editors/emacs/emacs.factor b/basis/editors/emacs/emacs.factor index 0aeb7bb467..fa717a70fa 100644 --- a/basis/editors/emacs/emacs.factor +++ b/basis/editors/emacs/emacs.factor @@ -15,7 +15,8 @@ M: object default-emacsclient ( -- path ) "emacsclient" ; "--no-wait" , number>string "+" prepend , , - ] { } make run-detached drop ; + ] { } make + os windows? [ run-detached drop ] [ try-process ] if ; : emacs ( word -- ) where first2 emacsclient ; From 624719c18fb1894f09c278b4417f5e88475eb64e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 20 Feb 2009 12:58:19 -0600 Subject: [PATCH 064/119] emacsclient.exe is a console app, so whenever it's run a console box pops up. run emacsclientw.exe instead if it exists --- basis/editors/emacs/windows/windows.factor | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/basis/editors/emacs/windows/windows.factor b/basis/editors/emacs/windows/windows.factor index d5c1e7811c..e18c39ed60 100755 --- a/basis/editors/emacs/windows/windows.factor +++ b/basis/editors/emacs/windows/windows.factor @@ -1,9 +1,12 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: editors.emacs io.directories.search.windows kernel sequences -system ; +system combinators.short-circuit ; IN: editors.emacs.windows M: windows default-emacsclient - "Emacs" t [ "emacsclient.exe" tail? ] find-in-program-files - "emacsclient.exe" or ; + { + [ "Emacs" t [ "emacsclientw.exe" tail? ] find-in-program-files ] + [ "Emacs" t [ "emacsclient.exe" tail? ] find-in-program-files ] + [ "emacsclient.exe" ] + } 0|| ; From 8b5a2f4a0e94d91557b7ac8fe0b91285178dcfda Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 20 Feb 2009 14:52:38 -0600 Subject: [PATCH 065/119] fix sqlite triggers -- NEW.table-id not NEW.foreign-table-id --- basis/db/sqlite/sqlite-tests.factor | 20 ++++++++------------ basis/db/sqlite/sqlite.factor | 27 ++++++++++++++------------- 2 files changed, 22 insertions(+), 25 deletions(-) diff --git a/basis/db/sqlite/sqlite-tests.factor b/basis/db/sqlite/sqlite-tests.factor index fd730f07ae..b6e756a3dd 100644 --- a/basis/db/sqlite/sqlite-tests.factor +++ b/basis/db/sqlite/sqlite-tests.factor @@ -123,12 +123,8 @@ hi "HELLO" { ] with-db ] unit-test -[ ] [ - test.db [ - hi create-table - hi drop-table - ] with-db -] unit-test + +! Test SQLite triggers TUPLE: show id ; TUPLE: user username data ; @@ -144,12 +140,12 @@ show "SHOW" { } define-persistent watch "WATCH" { - { "user" "USER" TEXT +not-null+ - { +foreign-id+ user "USERNAME" } +user-assigned-id+ } - { "show" "SHOW" BIG-INTEGER +not-null+ - { +foreign-id+ show "ID" } +user-assigned-id+ } + { "user" "USER" TEXT +not-null+ +user-assigned-id+ + { +foreign-id+ user "USERNAME" } } + { "show" "SHOW" BIG-INTEGER +not-null+ +user-assigned-id+ + { +foreign-id+ show "ID" } } } define-persistent - + [ T{ user { username "littledan" } { data "foo" } } ] [ test.db [ user create-table @@ -160,7 +156,7 @@ watch "WATCH" { show new insert-tuple show new select-tuple "littledan" f user boa select-tuple - swap [ username>> ] [ id>> ] bi* + [ id>> ] [ username>> ] bi* watch boa insert-tuple watch new select-tuple user>> f user boa select-tuple diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index 62a1b4714f..c94de27894 100755 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -204,7 +204,7 @@ M: sqlite-db-connection persistent-table ( -- assoc ) CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id BEFORE INSERT ON ${table-name} FOR EACH ROW BEGIN - SELECT RAISE(ROLLBACK, 'insert on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"') + SELECT RAISE(ROLLBACK, 'insert on table "${table-name}" violates foreign key constraint "fki_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"') WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL; END; "> interpolate @@ -216,8 +216,8 @@ M: sqlite-db-connection persistent-table ( -- assoc ) CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id BEFORE INSERT ON ${table-name} FOR EACH ROW BEGIN - SELECT RAISE(ROLLBACK, 'insert on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"') - WHERE NEW.${foreign-table-id} IS NOT NULL + SELECT RAISE(ROLLBACK, 'insert on table "${table-name}" violates foreign key constraint "fki_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"') + WHERE NEW.${table-id} IS NOT NULL AND (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL; END; "> interpolate @@ -236,8 +236,8 @@ M: sqlite-db-connection persistent-table ( -- assoc ) CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id BEFORE UPDATE ON ${table-name} FOR EACH ROW BEGIN - SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"') - WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL; + SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fku_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"') + WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL; END; "> interpolate ] with-string-writer ; @@ -248,8 +248,8 @@ M: sqlite-db-connection persistent-table ( -- assoc ) CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id BEFORE UPDATE ON ${table-name} FOR EACH ROW BEGIN - SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"') - WHERE NEW.${foreign-table-id} IS NOT NULL + SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fku_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"') + WHERE NEW.${table-id} IS NOT NULL AND (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL; END; "> interpolate @@ -268,8 +268,8 @@ M: sqlite-db-connection persistent-table ( -- assoc ) CREATE TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id BEFORE DELETE ON ${foreign-table-name} FOR EACH ROW BEGIN - SELECT RAISE(ROLLBACK, 'delete on table "${foreign-table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"') - WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = OLD.${foreign-table-id}) IS NOT NULL; + SELECT RAISE(ROLLBACK, 'delete on table "${foreign-table-name}" violates foreign key constraint "fkd_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"') + WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = OLD.${foreign-table-id}) IS NOT NULL; END; "> interpolate ] with-string-writer ; @@ -336,15 +336,17 @@ M: sqlite-db-connection persistent-table ( -- assoc ) [ modifiers>> [ +foreign-id+ = ] deep-any? ] filter [ [ class>> db-table-name "db-table" set ] - [ column-name>> "table-id" set ] [ + [ "sql-spec" set ] + [ column-name>> "table-id" set ] + [ ] tri modifiers>> [ [ +foreign-id+ = ] deep-any? ] filter [ [ second db-table-name "foreign-table-name" set ] [ third "foreign-table-id" set ] bi _ execute ] each - ] tri + ] bi ] each ] call ; @@ -378,8 +380,7 @@ M: sqlite-db-connection create-sql-statement ( class -- statement ) M: sqlite-db-connection drop-sql-statement ( class -- statements ) [ - [ nip "drop table " 0% 0% ";" 0% ] - [ drop \ drop-sqlite-triggers db-triggers ] 2bi + nip "drop table " 0% 0% ";" 0% ] query-make ; M: sqlite-db-connection compound ( string seq -- new-string ) From 6eaa5aee2457b0eaad5020445f13b12299f8a4fc Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 20 Feb 2009 17:29:11 -0600 Subject: [PATCH 066/119] fix compile error --- basis/db/sqlite/sqlite.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index c94de27894..19cfc5d0b7 100755 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -348,7 +348,7 @@ M: sqlite-db-connection persistent-table ( -- assoc ) ] each ] bi ] each - ] call ; + ] call ; inline : sqlite-create-table ( sql-specs class-name -- ) [ From b54833c728fa0a0bc40e236fa7287b78e609364f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 20 Feb 2009 20:11:26 -0600 Subject: [PATCH 067/119] remove a bunch of trigger deletion code -- triggers get deleted when tables are dropped --- basis/db/sqlite/sqlite.factor | 74 ++++++++--------------------------- 1 file changed, 16 insertions(+), 58 deletions(-) diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index 19cfc5d0b7..a4adba3473 100755 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -223,13 +223,6 @@ M: sqlite-db-connection persistent-table ( -- assoc ) "> interpolate ] with-string-writer ; -: drop-insert-trigger ( -- string ) - [ - <" - DROP TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id; - "> interpolate - ] with-string-writer ; - : update-trigger ( -- string ) [ <" @@ -255,13 +248,6 @@ M: sqlite-db-connection persistent-table ( -- assoc ) "> interpolate ] with-string-writer ; -: drop-update-trigger ( -- string ) - [ - <" - DROP TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id; - "> interpolate - ] with-string-writer ; - : delete-trigger-restrict ( -- string ) [ <" @@ -274,13 +260,6 @@ M: sqlite-db-connection persistent-table ( -- assoc ) "> interpolate ] with-string-writer ; -: drop-delete-trigger-restrict ( -- string ) - [ - <" - DROP TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id; - "> interpolate - ] with-string-writer ; - : delete-trigger-cascade ( -- string ) [ <" @@ -292,13 +271,6 @@ M: sqlite-db-connection persistent-table ( -- assoc ) "> interpolate ] with-string-writer ; -: drop-delete-trigger-cascade ( -- string ) - [ - <" - DROP TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id; - "> interpolate - ] with-string-writer ; - : can-be-null? ( -- ? ) "sql-spec" get modifiers>> [ +not-null+ = ] any? not ; @@ -322,33 +294,22 @@ M: sqlite-db-connection persistent-table ( -- assoc ) delete-trigger-restrict sqlite-trigger, ] if ; -: drop-sqlite-triggers ( -- ) - drop-insert-trigger sqlite-trigger, - drop-update-trigger sqlite-trigger, - delete-cascade? [ - drop-delete-trigger-cascade sqlite-trigger, - ] [ - drop-delete-trigger-restrict sqlite-trigger, - ] if ; - -: db-triggers ( sql-specs word -- ) - '[ - [ modifiers>> [ +foreign-id+ = ] deep-any? ] filter +: create-db-triggers ( sql-specs -- ) + [ modifiers>> [ +foreign-id+ = ] deep-any? ] filter + [ + [ class>> db-table-name "db-table" set ] [ - [ class>> db-table-name "db-table" set ] + [ "sql-spec" set ] + [ column-name>> "table-id" set ] + [ ] tri + modifiers>> [ [ +foreign-id+ = ] deep-any? ] filter [ - [ "sql-spec" set ] - [ column-name>> "table-id" set ] - [ ] tri - modifiers>> [ [ +foreign-id+ = ] deep-any? ] filter - [ - [ second db-table-name "foreign-table-name" set ] - [ third "foreign-table-id" set ] bi - _ execute - ] each - ] bi - ] each - ] call ; inline + [ second db-table-name "foreign-table-name" set ] + [ third "foreign-table-id" set ] bi + create-sqlite-triggers + ] each + ] bi + ] each ; : sqlite-create-table ( sql-specs class-name -- ) [ @@ -373,15 +334,12 @@ M: sqlite-db-connection persistent-table ( -- assoc ) M: sqlite-db-connection create-sql-statement ( class -- statement ) [ - ! specs name [ sqlite-create-table ] - [ drop \ create-sqlite-triggers db-triggers ] 2bi + [ drop create-db-triggers ] 2bi ] query-make ; M: sqlite-db-connection drop-sql-statement ( class -- statements ) - [ - nip "drop table " 0% 0% ";" 0% - ] query-make ; + [ nip "drop table " 0% 0% ";" 0% ] query-make ; M: sqlite-db-connection compound ( string seq -- new-string ) over { From 70d931d0b2197da63474e3f817cc8cf27e0cf5b9 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Fri, 20 Feb 2009 20:14:54 -0600 Subject: [PATCH 068/119] Creating math.bits --- basis/math/bits/authors.txt | 1 + basis/math/bits/bits-docs.factor | 26 ++++++++++++++++++++++ basis/math/bits/bits-tests.factor | 16 +++++++++++++ basis/math/bits/bits.factor | 16 +++++++++++++ basis/math/bits/summary.txt | 1 + basis/math/bitwise/bitwise.factor | 4 ++-- basis/math/functions/functions-docs.factor | 8 ------- basis/math/functions/functions.factor | 18 ++++----------- extra/crypto/passwd-md5/passwd-md5.factor | 6 ++--- 9 files changed, 69 insertions(+), 27 deletions(-) create mode 100644 basis/math/bits/authors.txt create mode 100644 basis/math/bits/bits-docs.factor create mode 100644 basis/math/bits/bits-tests.factor create mode 100644 basis/math/bits/bits.factor create mode 100644 basis/math/bits/summary.txt diff --git a/basis/math/bits/authors.txt b/basis/math/bits/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/basis/math/bits/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/basis/math/bits/bits-docs.factor b/basis/math/bits/bits-docs.factor new file mode 100644 index 0000000000..6ae83f7af0 --- /dev/null +++ b/basis/math/bits/bits-docs.factor @@ -0,0 +1,26 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: help.syntax help.markup math ; +IN: math.bits + +ABOUT: "math.bits" + +ARTICLE: "math.bits" "Number bits virtual sequence" +{ $subsection bits } +{ $subsection } +{ $subsection make-bits } ; + +HELP: bits +{ $class-description "Virtual sequence class of bits of a number. The first bit is the least significant bit. This can be constructed with " { $link } " or " { $link make-bits } "." } ; + +HELP: +{ $values { "number" integer } { "length" integer } { "bits" bits } } +{ $description "Creates a virtual sequence of bits of a number in little endian order, with the given length." } ; + +HELP: make-bits +{ $values { "number" integer } { "bits" bits } } +{ $description "Creates a " { $link bits } " object out of the given number, using its log base 2 as the length. This implies that the last element, corresponding to the most significant bit, will be 1." } +{ $examples + { $example "USING: math.bits prettyprint arrays ;" "BIN: 1101 make-bits >array ." "{ t f t t }" } + { $example "USING: math.bits prettyprint arrays ;" "-3 make-bits >array ." "{ t f }" } +} ; diff --git a/basis/math/bits/bits-tests.factor b/basis/math/bits/bits-tests.factor new file mode 100644 index 0000000000..0503d27f33 --- /dev/null +++ b/basis/math/bits/bits-tests.factor @@ -0,0 +1,16 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test math.bits sequences arrays ; +IN: math.bits.tests + +[ t ] [ BIN: 111111 3 second ] unit-test +[ { t t t } ] [ BIN: 111111 3 >array ] unit-test +[ f ] [ BIN: 111101 3 second ] unit-test +[ { f f t } ] [ BIN: 111100 3 >array ] unit-test +[ 3 ] [ BIN: 111111 3 length ] unit-test +[ 6 ] [ BIN: 111111 make-bits length ] unit-test +[ 0 ] [ 0 make-bits length ] unit-test +[ 2 ] [ 3 make-bits length ] unit-test +[ 2 ] [ -3 make-bits length ] unit-test +[ 1 ] [ 1 make-bits length ] unit-test +[ 1 ] [ -1 make-bits length ] unit-test diff --git a/basis/math/bits/bits.factor b/basis/math/bits/bits.factor new file mode 100644 index 0000000000..8920955df3 --- /dev/null +++ b/basis/math/bits/bits.factor @@ -0,0 +1,16 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: sequences kernel math accessors sequences.private ; +IN: math.bits + +TUPLE: bits { number read-only } { length read-only } ; +C: bits + +: make-bits ( number -- bits ) + dup zero? [ drop T{ bits f 0 0 } ] [ dup abs log2 1+ ] if ; inline + +M: bits length length>> ; + +M: bits nth-unsafe number>> swap bit? ; + +INSTANCE: bits immutable-sequence diff --git a/basis/math/bits/summary.txt b/basis/math/bits/summary.txt new file mode 100644 index 0000000000..265a7b8277 --- /dev/null +++ b/basis/math/bits/summary.txt @@ -0,0 +1 @@ +Virtual sequence for bits of an integer diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor index 339703c0a6..4f639c02a7 100755 --- a/basis/math/bitwise/bitwise.factor +++ b/basis/math/bitwise/bitwise.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2008 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel math math.functions sequences +USING: arrays kernel math sequences accessors math.bits sequences.private words namespaces macros hints combinators fry io.binary combinators.smart ; IN: math.bitwise @@ -65,7 +65,7 @@ DEFER: byte-bit-count \ byte-bit-count 256 [ - 0 swap [ [ 1+ ] when ] each-bit + 8 0 [ [ 1+ ] when ] reduce ] B{ } map-as '[ HEX: ff bitand _ nth-unsafe ] (( byte -- table )) define-declared diff --git a/basis/math/functions/functions-docs.factor b/basis/math/functions/functions-docs.factor index b463a48e49..33a5d96fc4 100644 --- a/basis/math/functions/functions-docs.factor +++ b/basis/math/functions/functions-docs.factor @@ -278,14 +278,6 @@ HELP: mod-inv { $example "USING: math prettyprint ;" "173 815 * 1119 mod ." "1" } } ; -HELP: each-bit -{ $values { "n" integer } { "quot" { $quotation "( ? -- )" } } } -{ $description "Applies the quotation to each bit of the integer, starting from the least significant bit, and stopping at the last bit from which point on all bits are either clear (if the integer is positive) or all bits are set (if the integer is negataive)." } -{ $examples - { $example "USING: math.functions make prettyprint ;" "[ BIN: 1101 [ , ] each-bit ] { } make ." "{ t f t t }" } - { $example "USING: math.functions make prettyprint ;" "[ -3 [ , ] each-bit ] { } make ." "{ t f }" } -} ; - HELP: ~ { $values { "x" real } { "y" real } { "epsilon" real } { "?" "a boolean" } } { $description "Tests if " { $snippet "x" } " and " { $snippet "y" } " are approximately equal to each other. There are three possible comparison tests, chosen based on the sign of " { $snippet "epsilon" } ":" diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 85b4d711ac..7e2ac0884c 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: math kernel math.constants math.private +USING: math kernel math.constants math.private math.bits math.libm combinators math.order sequences ; IN: math.functions @@ -26,16 +26,6 @@ GENERIC: sqrt ( x -- y ) foldable M: real sqrt >float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ; -: each-bit ( n quot: ( ? -- ) -- ) - over [ 0 = ] [ -1 = ] bi or [ - 2drop - ] [ - 2dup { [ odd? ] [ call ] [ 2/ ] [ each-bit ] } spread - ] if ; inline recursive - -: map-bits ( n quot: ( ? -- obj ) -- seq ) - accumulator [ each-bit ] dip ; inline - : factor-2s ( n -- r s ) #! factor an integer into 2^r * s dup 0 = [ 1 ] [ @@ -47,7 +37,7 @@ M: real sqrt GENERIC# ^n 1 ( z w -- z^w ) : (^n) ( z w -- z^w ) - 1 swap [ [ dupd * ] when [ sq ] dip ] each-bit nip ; inline + make-bits 1 [ [ dupd * ] when [ sq ] dip ] reduce nip ; inline M: integer ^n [ factor-2s ] dip [ (^n) ] keep rot * shift ; @@ -94,9 +84,9 @@ PRIVATE> dup zero? [ drop 0./0. ] [ 0 < 1./0. 0 ? ] if ; inline : (^mod) ( n x y -- z ) - 1 swap [ + make-bits 1 [ [ dupd * pick mod ] when [ sq over mod ] dip - ] each-bit 2nip ; inline + ] reduce 2nip ; inline : (gcd) ( b a x y -- a d ) over zero? [ diff --git a/extra/crypto/passwd-md5/passwd-md5.factor b/extra/crypto/passwd-md5/passwd-md5.factor index e292981876..286a313fda 100644 --- a/extra/crypto/passwd-md5/passwd-md5.factor +++ b/extra/crypto/passwd-md5/passwd-md5.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: kernel base64 checksums.md5 sequences checksums -locals prettyprint math math.bitwise grouping io combinators +locals prettyprint math math.bits grouping io combinators fry make combinators.short-circuit math.functions splitting ; IN: crypto.passwd-md5 @@ -22,8 +22,8 @@ PRIVATE> password length [ 16 / ceiling swap concat ] keep head-slice append - password [ length ] [ first ] bi - '[ [ CHAR: \0 _ ? , ] each-bit ] "" make append + password [ length make-bits ] [ first ] bi + '[ CHAR: \0 _ ? ] "" map-as append md5 checksum-bytes ] | 1000 [ "" swap From 985597ba6858552d22294dc40e5794170fdaa3d6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 20 Feb 2009 20:40:17 -0600 Subject: [PATCH 069/119] add error handling to sqlite, postgresql is next. switching computers.. --- basis/db/db.factor | 8 +++-- basis/db/errors/errors.factor | 12 ++++++- basis/db/errors/postgresql/authors.txt | 1 + .../errors/postgresql/postgresql-tests.factor | 4 +++ basis/db/errors/postgresql/postgresql.factor | 7 +++++ basis/db/errors/sqlite/authors.txt | 1 + basis/db/errors/sqlite/sqlite-tests.factor | 26 ++++++++++++++++ basis/db/errors/sqlite/sqlite.factor | 31 +++++++++++++++++++ basis/db/postgresql/postgresql-tests.factor | 22 ++++++------- 9 files changed, 98 insertions(+), 14 deletions(-) create mode 100644 basis/db/errors/postgresql/authors.txt create mode 100644 basis/db/errors/postgresql/postgresql-tests.factor create mode 100644 basis/db/errors/postgresql/postgresql.factor create mode 100644 basis/db/errors/sqlite/authors.txt create mode 100644 basis/db/errors/sqlite/sqlite-tests.factor create mode 100644 basis/db/errors/sqlite/sqlite.factor diff --git a/basis/db/db.factor b/basis/db/db.factor index 0b18044f2b..eb06f0c894 100644 --- a/basis/db/db.factor +++ b/basis/db/db.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs classes continuations destructors kernel math namespaces sequences classes.tuple words strings -tools.walker accessors combinators fry ; +tools.walker accessors combinators fry db.errors ; IN: db > execute-statement* ; diff --git a/basis/db/errors/errors.factor b/basis/db/errors/errors.factor index da6301639f..1d48012cf9 100644 --- a/basis/db/errors/errors.factor +++ b/basis/db/errors/errors.factor @@ -1,10 +1,20 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel ; +USING: kernel db.private ; IN: db.errors +HOOK: parse-db-error db-connection ( error -- error' ) + ERROR: db-error ; ERROR: sql-error ; ERROR: table-exists ; ERROR: bad-schema ; + +ERROR: sql-syntax-error error ; + +ERROR: sql-table-exists table ; +C: sql-table-exists + +ERROR: sql-table-missing table ; +C: sql-table-missing diff --git a/basis/db/errors/postgresql/authors.txt b/basis/db/errors/postgresql/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/db/errors/postgresql/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/db/errors/postgresql/postgresql-tests.factor b/basis/db/errors/postgresql/postgresql-tests.factor new file mode 100644 index 0000000000..59b9bfe4a8 --- /dev/null +++ b/basis/db/errors/postgresql/postgresql-tests.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test db.errors.postgresql ; +IN: db.errors.postgresql.tests diff --git a/basis/db/errors/postgresql/postgresql.factor b/basis/db/errors/postgresql/postgresql.factor new file mode 100644 index 0000000000..9d88c96cb1 --- /dev/null +++ b/basis/db/errors/postgresql/postgresql.factor @@ -0,0 +1,7 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: ; +IN: db.errors.postgresql + +M: postgresql-db-connection parse-db-error + ; \ No newline at end of file diff --git a/basis/db/errors/sqlite/authors.txt b/basis/db/errors/sqlite/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/db/errors/sqlite/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/db/errors/sqlite/sqlite-tests.factor b/basis/db/errors/sqlite/sqlite-tests.factor new file mode 100644 index 0000000000..68ae55f8a8 --- /dev/null +++ b/basis/db/errors/sqlite/sqlite-tests.factor @@ -0,0 +1,26 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors combinators.short-circuit db db.errors +db.errors.sqlite db.sqlite io.files.unique kernel namespaces +tools.test ; +IN: db.errors.sqlite.tests + +: sqlite-error-test-db-path ( -- path ) + "sqlite" "error-test" make-unique-file ; + +sqlite-error-test-db-path [ + + [ + "insert into foo (id) values('1');" sql-command + ] [ + { [ sql-table-missing? ] [ table>> "foo" = ] } 1&& + ] must-fail-with + + [ + "create table foo(id);" sql-command + "create table foo(id);" sql-command + ] [ + { [ sql-table-exists? ] [ table>> "foo" = ] } 1&& + ] must-fail-with + +] with-db \ No newline at end of file diff --git a/basis/db/errors/sqlite/sqlite.factor b/basis/db/errors/sqlite/sqlite.factor new file mode 100644 index 0000000000..770a12b2a1 --- /dev/null +++ b/basis/db/errors/sqlite/sqlite.factor @@ -0,0 +1,31 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors combinators db.errors db.sqlite.private kernel +sequences peg.ebnf strings ; +IN: db.errors.sqlite + +ERROR: unparsed-sqlite-error error ; + +SINGLETONS: table-exists table-missing ; + +: sqlite-table-error ( table message -- error ) + { + { table-exists [ ] } + } case ; + +EBNF: parse-sqlite-sql-error + +TableMessage = " already exists" => [[ table-exists ]] + +SqliteError = + "table " (!(TableMessage).)+:table TableMessage:message + => [[ table >string message sqlite-table-error ]] + | "no such table: " .+:table + => [[ table >string ]] +;EBNF + +M: sqlite-db-connection parse-db-error + dup n>> { + { 1 [ string>> parse-sqlite-sql-error ] } + [ drop ] + } case ; \ No newline at end of file diff --git a/basis/db/postgresql/postgresql-tests.factor b/basis/db/postgresql/postgresql-tests.factor index cf6dc903f1..e2e2cbf7c0 100644 --- a/basis/db/postgresql/postgresql-tests.factor +++ b/basis/db/postgresql/postgresql-tests.factor @@ -3,7 +3,7 @@ prettyprint sequences namespaces tools.test db db.private db.tuples db.types unicode.case accessors system ; IN: db.postgresql.tests -: test-db ( -- postgresql-db ) +: postgresql-test-db ( -- postgresql-db ) "localhost" >>host "postgres" >>username @@ -11,10 +11,10 @@ IN: db.postgresql.tests "factor-test" >>database ; os windows? cpu x86.64? and [ - [ ] [ test-db [ ] with-db ] unit-test + [ ] [ postgresql-test-db [ ] with-db ] unit-test [ ] [ - test-db [ + postgresql-test-db [ [ "drop table person;" sql-command ] ignore-errors "create table person (name varchar(30), country varchar(30));" sql-command @@ -30,7 +30,7 @@ os windows? cpu x86.64? and [ { "Jane" "New Zealand" } } ] [ - test-db [ + postgresql-test-db [ "select * from person" sql-query ] with-db ] unit-test @@ -40,11 +40,11 @@ os windows? cpu x86.64? and [ { "John" "America" } { "Jane" "New Zealand" } } - ] [ test-db [ "select * from person" sql-query ] with-db ] unit-test + ] [ postgresql-test-db [ "select * from person" sql-query ] with-db ] unit-test [ ] [ - test-db [ + postgresql-test-db [ "insert into person(name, country) values('Jimmy', 'Canada')" sql-command ] with-db @@ -56,10 +56,10 @@ os windows? cpu x86.64? and [ { "Jane" "New Zealand" } { "Jimmy" "Canada" } } - ] [ test-db [ "select * from person" sql-query ] with-db ] unit-test + ] [ postgresql-test-db [ "select * from person" sql-query ] with-db ] unit-test [ - test-db [ + postgresql-test-db [ [ "insert into person(name, country) values('Jose', 'Mexico')" sql-command "insert into person(name, country) values('Jose', 'Mexico')" sql-command @@ -69,14 +69,14 @@ os windows? cpu x86.64? and [ ] must-fail [ 3 ] [ - test-db [ + postgresql-test-db [ "select * from person" sql-query length ] with-db ] unit-test [ ] [ - test-db [ + postgresql-test-db [ [ "insert into person(name, country) values('Jose', 'Mexico')" sql-command @@ -87,7 +87,7 @@ os windows? cpu x86.64? and [ ] unit-test [ 5 ] [ - test-db [ + postgresql-test-db [ "select * from person" sql-query length ] with-db ] unit-test From a1f3e5695b9dc3dd1feec2bd6c1498ca006a4283 Mon Sep 17 00:00:00 2001 From: sheeple Date: Fri, 20 Feb 2009 22:59:01 -0600 Subject: [PATCH 070/119] fix circularity in db --- basis/db/db.factor | 5 +++-- basis/db/errors/errors.factor | 4 +--- basis/db/errors/postgresql/postgresql.factor | 3 --- basis/db/errors/sqlite/sqlite.factor | 10 ++-------- basis/db/postgresql/postgresql.factor | 7 +++++-- basis/db/sqlite/sqlite.factor | 9 ++++++++- 6 files changed, 19 insertions(+), 19 deletions(-) diff --git a/basis/db/db.factor b/basis/db/db.factor index eb06f0c894..96b72b8865 100644 --- a/basis/db/db.factor +++ b/basis/db/db.factor @@ -5,14 +5,14 @@ namespaces sequences classes.tuple words strings tools.walker accessors combinators fry db.errors ; IN: db ->insert-statements @@ -23,6 +23,7 @@ PRIVATE> GENERIC: db-open ( db -- db-connection ) HOOK: db-close db-connection ( handle -- ) +HOOK: parse-db-error db-connection ( error -- error' ) : dispose-statements ( assoc -- ) values dispose-each ; diff --git a/basis/db/errors/errors.factor b/basis/db/errors/errors.factor index 1d48012cf9..9420dbbfc4 100644 --- a/basis/db/errors/errors.factor +++ b/basis/db/errors/errors.factor @@ -1,10 +1,8 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel db.private ; +USING: kernel ; IN: db.errors -HOOK: parse-db-error db-connection ( error -- error' ) - ERROR: db-error ; ERROR: sql-error ; diff --git a/basis/db/errors/postgresql/postgresql.factor b/basis/db/errors/postgresql/postgresql.factor index 9d88c96cb1..e45ff092e8 100644 --- a/basis/db/errors/postgresql/postgresql.factor +++ b/basis/db/errors/postgresql/postgresql.factor @@ -2,6 +2,3 @@ ! See http://factorcode.org/license.txt for BSD license. USING: ; IN: db.errors.postgresql - -M: postgresql-db-connection parse-db-error - ; \ No newline at end of file diff --git a/basis/db/errors/sqlite/sqlite.factor b/basis/db/errors/sqlite/sqlite.factor index 770a12b2a1..c247a36257 100644 --- a/basis/db/errors/sqlite/sqlite.factor +++ b/basis/db/errors/sqlite/sqlite.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators db.errors db.sqlite.private kernel -sequences peg.ebnf strings ; +USING: accessors combinators db kernel sequences peg.ebnf +strings db.errors ; IN: db.errors.sqlite ERROR: unparsed-sqlite-error error ; @@ -23,9 +23,3 @@ SqliteError = | "no such table: " .+:table => [[ table >string ]] ;EBNF - -M: sqlite-db-connection parse-db-error - dup n>> { - { 1 [ string>> parse-sqlite-sql-error ] } - [ drop ] - } case ; \ No newline at end of file diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor index 1f55dcf769..1c39166071 100644 --- a/basis/db/postgresql/postgresql.factor +++ b/basis/db/postgresql/postgresql.factor @@ -5,8 +5,8 @@ kernel math math.parser namespaces make prettyprint quotations sequences debugger db db.postgresql.lib db.postgresql.ffi db.tuples db.types tools.annotations math.ranges combinators classes locals words tools.walker db.private -nmake accessors random db.queries destructors db.tuples.private ; -USE: tools.walker +nmake accessors random db.queries destructors db.tuples.private +db.postgresql ; IN: db.postgresql TUPLE: postgresql-db host port pgopts pgtty database username password ; @@ -280,3 +280,6 @@ M: postgresql-db-connection compound ( string object -- string' ) { "references" [ >reference-string ] } [ drop no-compound-found ] } case ; + +M: postgresql-db-connection parse-db-error + ; diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index a4adba3473..5b658f36c9 100755 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -6,7 +6,8 @@ sequences strings classes.tuple alien.c-types continuations db.sqlite.lib db.sqlite.ffi db.tuples words db.types combinators math.intervals io nmake accessors vectors math.ranges random math.bitwise db.queries destructors db.tuples.private interpolate -io.streams.string multiline make db.private sequences.deep ; +io.streams.string multiline make db.private sequences.deep +db.errors.sqlite ; IN: db.sqlite TUPLE: sqlite-db path ; @@ -347,3 +348,9 @@ M: sqlite-db-connection compound ( string seq -- new-string ) { "references" [ >reference-string ] } [ 2drop ] } case ; + +M: sqlite-db-connection parse-db-error + dup n>> { + { 1 [ string>> parse-sqlite-sql-error ] } + [ drop ] + } case ; From d6d89e0a40418f7e80d2b51cd8b1bb7b7b854524 Mon Sep 17 00:00:00 2001 From: sheeple Date: Sat, 21 Feb 2009 21:22:51 -0600 Subject: [PATCH 071/119] add parsing for postgresql errors and some unit tests --- basis/db/errors/errors.factor | 22 ++++--- .../errors/postgresql/postgresql-tests.factor | 30 +++++++++- basis/db/errors/postgresql/postgresql.factor | 58 ++++++++++++++++++- basis/db/postgresql/postgresql-tests.factor | 9 +-- basis/db/postgresql/postgresql.factor | 12 +++- basis/db/sqlite/lib/lib.factor | 7 ++- basis/db/tester/tester.factor | 38 ++++++++++-- basis/db/tuples/tuples-tests.factor | 34 +---------- 8 files changed, 153 insertions(+), 57 deletions(-) diff --git a/basis/db/errors/errors.factor b/basis/db/errors/errors.factor index 9420dbbfc4..00aa568154 100644 --- a/basis/db/errors/errors.factor +++ b/basis/db/errors/errors.factor @@ -1,18 +1,24 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel ; +USING: accessors kernel ; IN: db.errors ERROR: db-error ; -ERROR: sql-error ; +ERROR: sql-error location ; -ERROR: table-exists ; ERROR: bad-schema ; -ERROR: sql-syntax-error error ; +ERROR: sql-table-exists < sql-error table ; +: ( table -- error ) + \ sql-table-exists new + swap >>table ; -ERROR: sql-table-exists table ; -C: sql-table-exists +ERROR: sql-table-missing < sql-error table ; +: ( table -- error ) + \ sql-table-missing new + swap >>table ; -ERROR: sql-table-missing table ; -C: sql-table-missing +ERROR: sql-syntax-error < sql-error message ; +: ( message -- error ) + \ sql-syntax-error new + swap >>message ; diff --git a/basis/db/errors/postgresql/postgresql-tests.factor b/basis/db/errors/postgresql/postgresql-tests.factor index 59b9bfe4a8..770b325086 100644 --- a/basis/db/errors/postgresql/postgresql-tests.factor +++ b/basis/db/errors/postgresql/postgresql-tests.factor @@ -1,4 +1,32 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: tools.test db.errors.postgresql ; +USING: accessors combinators.short-circuit db db.errors +db.errors.postgresql db.postgresql io.files.unique kernel namespaces +tools.test db.tester ; IN: db.errors.postgresql.tests + +postgresql-test-db [ + + [ "drop table foo;" sql-command ] ignore-errors + [ "drop table ship;" sql-command ] ignore-errors + + [ + "insert into foo (id) values('1');" sql-command + ] [ + { [ sql-table-missing? ] [ table>> "foo" = ] } 1&& + ] must-fail-with + + [ + "create table ship(id integer);" sql-command + "create table ship(id integer);" sql-command + ] [ + { [ sql-table-exists? ] [ table>> "ship" = ] } 1&& + ] must-fail-with + + [ + "create table foo(id) lol;" sql-command + ] [ + sql-syntax-error? + ] must-fail-with + +] with-db diff --git a/basis/db/errors/postgresql/postgresql.factor b/basis/db/errors/postgresql/postgresql.factor index e45ff092e8..fac10d092f 100644 --- a/basis/db/errors/postgresql/postgresql.factor +++ b/basis/db/errors/postgresql/postgresql.factor @@ -1,4 +1,60 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: ; +USING: kernel db.errors peg.ebnf strings sequences math +combinators.short-circuit accessors math.parser ; IN: db.errors.postgresql + +! ERROR: relation "foo" does not exist + +: quote? ( ch -- ? ) "'\"" member? ; + +: quoted? ( str -- ? ) + { + [ length 1 > ] + [ first quote? ] + [ [ first ] [ peek ] bi = ] + } 1&& ; + +: unquote ( str -- newstr ) + dup quoted? [ but-last-slice rest-slice >string ] when ; + + +EBNF: parse-postgresql-sql-error + +Error = "ERROR:" [ ]+ + +TableError = + Error "relation " (!(" already exists").)+:table " already exists" + => [[ table >string unquote ]] + | Error "relation " (!(" does not exist").)+:table " does not exist" + => [[ table >string unquote ]] + +SyntaxError = + Error "syntax error at end of input":error + => [[ error >string ]] + | Error "syntax error at or near " .+:syntaxerror + => [[ syntaxerror >string unquote ]] + +PostgresqlSqlError = (TableError | SyntaxError) + +;EBNF + + +ERROR: parse-postgresql-location column line text ; +C: parse-postgresql-location + +EBNF: parse-postgresql-line-error + +Line = "LINE " [0-9]+:line ": " .+:sql + => [[ f line >string string>number sql >string ]] + +;EBNF + +:: set-caret-position ( error caret-line -- error ) + caret-line length + error line>> number>string length "LINE : " length + + - [ error ] dip >>column ; + +: postgresql-location ( line column -- obj ) + [ parse-postgresql-line-error ] dip + set-caret-position ; diff --git a/basis/db/postgresql/postgresql-tests.factor b/basis/db/postgresql/postgresql-tests.factor index e2e2cbf7c0..266337b8c8 100644 --- a/basis/db/postgresql/postgresql-tests.factor +++ b/basis/db/postgresql/postgresql-tests.factor @@ -1,15 +1,8 @@ USING: kernel db.postgresql alien continuations io classes prettyprint sequences namespaces tools.test db db.private -db.tuples db.types unicode.case accessors system ; +db.tuples db.types unicode.case accessors system db.tester ; IN: db.postgresql.tests -: postgresql-test-db ( -- postgresql-db ) - - "localhost" >>host - "postgres" >>username - "thepasswordistrust" >>password - "factor-test" >>database ; - os windows? cpu x86.64? and [ [ ] [ postgresql-test-db [ ] with-db ] unit-test diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor index 1c39166071..9e51f41ff1 100644 --- a/basis/db/postgresql/postgresql.factor +++ b/basis/db/postgresql/postgresql.factor @@ -6,7 +6,7 @@ sequences debugger db db.postgresql.lib db.postgresql.ffi db.tuples db.types tools.annotations math.ranges combinators classes locals words tools.walker db.private nmake accessors random db.queries destructors db.tuples.private -db.postgresql ; +db.postgresql db.errors.postgresql splitting ; IN: db.postgresql TUPLE: postgresql-db host port pgopts pgtty database username password ; @@ -282,4 +282,12 @@ M: postgresql-db-connection compound ( string object -- string' ) } case ; M: postgresql-db-connection parse-db-error - ; + "\n" split dup length { + { 1 [ first parse-postgresql-sql-error ] } + { 3 [ + first3 + [ parse-postgresql-sql-error ] 2dip + postgresql-location >>location + ] } + } case ; + diff --git a/basis/db/sqlite/lib/lib.factor b/basis/db/sqlite/lib/lib.factor index 60141bc830..3565b09856 100644 --- a/basis/db/sqlite/lib/lib.factor +++ b/basis/db/sqlite/lib/lib.factor @@ -11,12 +11,17 @@ IN: db.sqlite.lib ERROR: sqlite-error < db-error n string ; ERROR: sqlite-sql-error < sql-error n string ; +: ( n string -- error ) + \ sqlite-sql-error new + swap >>string + swap >>n ; + : throw-sqlite-error ( n -- * ) dup sqlite-error-messages nth sqlite-error ; : sqlite-statement-error ( -- * ) SQLITE_ERROR - db-connection get handle>> sqlite3_errmsg sqlite-sql-error ; + db-connection get handle>> sqlite3_errmsg throw ; : sqlite-check-result ( n -- ) { diff --git a/basis/db/tester/tester.factor b/basis/db/tester/tester.factor index 490f6bbef5..fcc5abf1cf 100644 --- a/basis/db/tester/tester.factor +++ b/basis/db/tester/tester.factor @@ -2,9 +2,42 @@ ! See http://factorcode.org/license.txt for BSD license. USING: concurrency.combinators db.pools db.sqlite db.tuples db.types kernel math random threads tools.test db sequences -io prettyprint ; +io prettyprint db.postgresql db.sqlite accessors io.files.temp +namespaces fry system ; IN: db.tester +: postgresql-test-db ( -- postgresql-db ) + + "localhost" >>host + "postgres" >>username + "thepasswordistrust" >>password + "factor-test" >>database ; + +: sqlite-test-db ( -- sqlite-db ) + "tuples-test.db" temp-file ; + + +! These words leak resources, but are useful for interactivel testing +: set-sqlite-db ( -- ) + sqlite-db db-open db-connection set ; + +: set-postgresql-db ( -- ) + postgresql-db db-open db-connection set ; + + +: test-sqlite ( quot -- ) + '[ + [ ] [ sqlite-test-db _ with-db ] unit-test + ] call ; inline + +: test-postgresql ( quot -- ) + '[ + os windows? cpu x86.64? and [ + [ ] [ postgresql-test-db _ with-db ] unit-test + ] unless + ] call ; inline + + TUPLE: test-1 id a b c ; test-1 "TEST1" { @@ -23,9 +56,6 @@ test-2 "TEST2" { { "z" "Z" { VARCHAR 256 } +not-null+ } } define-persistent -: sqlite-test-db ( -- db ) "test.db" ; -: test-db ( -- db ) "test.db" ; - : db-tester ( test-db -- ) [ [ diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor index 246946c715..af77ce6ac1 100644 --- a/basis/db/tuples/tuples-tests.factor +++ b/basis/db/tuples/tuples-tests.factor @@ -4,40 +4,10 @@ USING: io.files io.files.temp kernel tools.test db db.tuples classes db.types continuations namespaces math math.ranges prettyprint calendar sequences db.sqlite math.intervals db.postgresql accessors random math.bitwise system -math.ranges strings urls fry db.tuples.private db.private ; +math.ranges strings urls fry db.tuples.private db.private +db.tester ; IN: db.tuples.tests -: sqlite-db ( -- sqlite-db ) - "tuples-test.db" temp-file ; - -: test-sqlite ( quot -- ) - '[ - [ ] [ - "tuples-test.db" temp-file _ with-db - ] unit-test - ] call ; inline - -: postgresql-db ( -- postgresql-db ) - - "localhost" >>host - "postgres" >>username - "thepasswordistrust" >>password - "factor-test" >>database ; - -: test-postgresql ( quot -- ) - '[ - os windows? cpu x86.64? and [ - [ ] [ postgresql-db _ with-db ] unit-test - ] unless - ] call ; inline - -! These words leak resources, but are useful for interactivel testing -: sqlite-test-db ( -- ) - sqlite-db db-open db-connection set ; - -: postgresql-test-db ( -- ) - postgresql-db db-open db-connection set ; - TUPLE: person the-id the-name the-number the-real ts date time blob factor-blob url ; From 02cec3a9f41e7b89f027eea21fd05c09834a8872 Mon Sep 17 00:00:00 2001 From: sheeple Date: Sat, 21 Feb 2009 21:59:23 -0600 Subject: [PATCH 072/119] add more postgres error handling, remove usage of ignore-errors in db.tuples --- basis/db/errors/errors.factor | 32 ++++++++++++++++++- .../errors/postgresql/postgresql-tests.factor | 2 +- basis/db/errors/postgresql/postgresql.factor | 16 +++++++--- basis/db/tuples/tuples.factor | 10 +++--- 4 files changed, 49 insertions(+), 11 deletions(-) diff --git a/basis/db/errors/errors.factor b/basis/db/errors/errors.factor index 00aa568154..5239086f93 100644 --- a/basis/db/errors/errors.factor +++ b/basis/db/errors/errors.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel ; +USING: accessors kernel continuations fry words ; IN: db.errors ERROR: db-error ; @@ -8,6 +8,11 @@ ERROR: sql-error location ; ERROR: bad-schema ; +ERROR: sql-unknown-error < sql-error message ; +: ( message -- error ) + \ sql-unknown-error new + swap >>message ; + ERROR: sql-table-exists < sql-error table ; : ( table -- error ) \ sql-table-exists new @@ -22,3 +27,28 @@ ERROR: sql-syntax-error < sql-error message ; : ( message -- error ) \ sql-syntax-error new swap >>message ; + +ERROR: sql-function-exists < sql-error message ; +: ( message -- error ) + \ sql-function-exists new + swap >>message ; + +ERROR: sql-function-missing < sql-error message ; +: ( message -- error ) + \ sql-function-missing new + swap >>message ; + +: ignore-error ( quot word -- ) + '[ dup _ execute [ drop ] [ rethrow ] if ] recover ; inline + +: ignore-table-exists ( quot -- ) + \ sql-table-exists? ignore-error ; inline + +: ignore-table-missing ( quot -- ) + \ sql-table-missing? ignore-error ; inline + +: ignore-function-exists ( quot -- ) + \ sql-function-exists? ignore-error ; inline + +: ignore-function-missing ( quot -- ) + \ sql-function-missing? ignore-error ; inline diff --git a/basis/db/errors/postgresql/postgresql-tests.factor b/basis/db/errors/postgresql/postgresql-tests.factor index 770b325086..9dbebe0712 100644 --- a/basis/db/errors/postgresql/postgresql-tests.factor +++ b/basis/db/errors/postgresql/postgresql-tests.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors combinators.short-circuit db db.errors db.errors.postgresql db.postgresql io.files.unique kernel namespaces -tools.test db.tester ; +tools.test db.tester continuations ; IN: db.errors.postgresql.tests postgresql-test-db [ diff --git a/basis/db/errors/postgresql/postgresql.factor b/basis/db/errors/postgresql/postgresql.factor index fac10d092f..2b79859050 100644 --- a/basis/db/errors/postgresql/postgresql.factor +++ b/basis/db/errors/postgresql/postgresql.factor @@ -4,8 +4,6 @@ USING: kernel db.errors peg.ebnf strings sequences math combinators.short-circuit accessors math.parser ; IN: db.errors.postgresql -! ERROR: relation "foo" does not exist - : quote? ( ch -- ? ) "'\"" member? ; : quoted? ( str -- ? ) @@ -24,18 +22,26 @@ EBNF: parse-postgresql-sql-error Error = "ERROR:" [ ]+ TableError = - Error "relation " (!(" already exists").)+:table " already exists" + Error ("relation "|"table ")(!(" already exists").)+:table " already exists" => [[ table >string unquote ]] - | Error "relation " (!(" does not exist").)+:table " does not exist" + | Error ("relation "|"table ")(!(" does not exist").)+:table " does not exist" => [[ table >string unquote ]] +FunctionError = + Error "function" (!(" already exists").)+:table " already exists" + => [[ table >string ]] + | Error "function" (!(" does not exist").)+:table " does not exist" + => [[ table >string ]] + SyntaxError = Error "syntax error at end of input":error => [[ error >string ]] | Error "syntax error at or near " .+:syntaxerror => [[ syntaxerror >string unquote ]] -PostgresqlSqlError = (TableError | SyntaxError) +UnknownError = .* => [[ >string ]] + +PostgresqlSqlError = (TableError | FunctionError | SyntaxError | UnknownError) ;EBNF diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor index 9edd5bac69..19d4be5fc8 100644 --- a/basis/db/tuples/tuples.factor +++ b/basis/db/tuples/tuples.factor @@ -4,7 +4,7 @@ USING: arrays assocs classes db kernel namespaces classes.tuple words sequences slots math accessors math.parser io prettyprint db.types continuations destructors mirrors sets db.types db.private fry -combinators.short-circuit ; +combinators.short-circuit db.errors ; IN: db.tuples HOOK: create-sql-statement db-connection ( class -- object ) @@ -118,13 +118,15 @@ ERROR: no-defined-persistent object ; ensure-defined-persistent [ '[ - _ drop-sql-statement [ execute-statement ] with-disposals - ] ignore-errors + [ + _ drop-sql-statement [ execute-statement ] with-disposals + ] ignore-table-missing + ] ignore-function-missing ] [ create-table ] bi ; : ensure-table ( class -- ) ensure-defined-persistent - '[ _ create-table ] ignore-errors ; + '[ [ _ create-table ] ignore-table-exists ] ignore-function-exists ; : ensure-tables ( classes -- ) [ ensure-table ] each ; From 785d7ac9afb64283676e015b2e74bf4b96978249 Mon Sep 17 00:00:00 2001 From: sheeple Date: Sat, 21 Feb 2009 22:18:02 -0600 Subject: [PATCH 073/119] clean up scaffold tool a bit, don't create a -tests.factor file when scaffolding a new vocab --- basis/tools/scaffold/scaffold.factor | 50 +++++++++++++++------------- 1 file changed, 27 insertions(+), 23 deletions(-) diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index acea984700..d1623b223a 100755 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -5,7 +5,7 @@ io.encodings.utf8 hashtables kernel namespaces sequences vocabs.loader io combinators calendar accessors math.parser io.streams.string ui.tools.operations quotations strings arrays prettyprint words vocabs sorting sets classes math alien urls -splitting ascii ; +splitting ascii combinators.short-circuit ; IN: tools.scaffold SYMBOL: developer-name @@ -18,18 +18,19 @@ ERROR: no-vocab vocab ; . ; +: not-scaffolding ( path -- path ) + "Not creating scaffolding for " write dup . ; -: scaffolding ( path -- ) - "Creating scaffolding for " write . ; +: scaffolding ( path -- path ) + "Creating scaffolding for " write dup . ; : (scaffold-path) ( path string -- path ) - dupd [ file-name ] dip append append-path ; + [ dup file-name ] dip append append-path ; : scaffold-path ( path string -- path ? ) (scaffold-path) - dup exists? [ dup not-scaffolding f ] [ dup scaffolding t ] if ; + dup exists? [ not-scaffolding f ] [ scaffolding t ] if ; : scaffold-copyright ( -- ) "! Copyright (C) " write now year>> number>string write @@ -85,14 +86,14 @@ ERROR: no-vocab vocab ; : scaffold-authors ( path -- ) "authors.txt" append-path dup exists? [ - not-scaffolding + not-scaffolding drop ] [ - dup scaffolding + scaffolding developer-name get swap utf8 set-file-contents ] if ; : lookup-type ( string -- object/string ? ) - "new" ?head drop [ [ CHAR: ' = ] [ digit? ] bi or ] trim-tail + "new" ?head drop [ { [ CHAR: ' = ] [ digit? ] } 1|| ] trim-tail H{ { "object" object } { "obj" object } { "quot" quotation } @@ -134,6 +135,9 @@ ERROR: no-vocab vocab ; " }" write ] each ; +: 4bl ( -- ) + " " write ; inline + : $values. ( word -- ) "declared-effect" word-prop [ [ in>> ] [ out>> ] bi @@ -141,8 +145,8 @@ ERROR: no-vocab vocab ; 2drop ] [ "{ $values" print - [ " " write ($values.) ] - [ [ nl " " write ($values.) ] unless-empty ] bi* + [ 4bl ($values.) ] + [ [ nl 4bl ($values.) ] unless-empty ] bi* nl "}" print ] if ] when* ; @@ -159,7 +163,7 @@ ERROR: no-vocab vocab ; : interesting-words ( vocab -- array ) words - [ [ "help" word-prop ] [ predicate? ] bi or not ] filter + [ { [ "help" word-prop ] [ predicate? ] } 1|| not ] filter natural-sort ; : interesting-words. ( vocab -- ) @@ -237,7 +241,6 @@ PRIVATE> { [ drop scaffold-directory ] [ scaffold-main ] - [ scaffold-tests ] [ drop scaffold-authors ] [ nip require ] } 2cleave ; @@ -250,7 +253,7 @@ SYMBOL: examples-flag " \"\"" " \"\"" "}" - } [ examples-flag get [ " " write ] when print ] each ; + } [ examples-flag get [ 4bl ] when print ] each ; : examples ( n -- ) t \ examples-flag [ @@ -260,10 +263,11 @@ SYMBOL: examples-flag ] with-variable ; : scaffold-rc ( path -- ) + [ home ] dip append-path [ touch-file ] [ "Click to edit: " write . ] bi ; -: scaffold-factor-boot-rc ( -- ) - home ".factor-boot-rc" append-path scaffold-rc ; +: scaffold-factor-boot-rc ( -- ) ".factor-boot-rc" scaffold-rc ; -: scaffold-factor-rc ( -- ) - home ".factor-rc" append-path scaffold-rc ; +: scaffold-factor-rc ( -- ) ".factor-rc" scaffold-rc ; + +: scaffold-emacs ( -- ) ".emacs" scaffold-rc ; From 405b3dc1ad97525fd5a31aae405284bfbe2d4fea Mon Sep 17 00:00:00 2001 From: sheeple Date: Sun, 22 Feb 2009 00:19:10 -0600 Subject: [PATCH 074/119] refactor tools.scaffold -- scaffold-help -> scaffold-docs, it takes a vocab name now --- basis/tools/scaffold/scaffold.factor | 146 +++++++++++++++------------ 1 file changed, 80 insertions(+), 66 deletions(-) diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index d1623b223a..eb7017f57f 100755 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -32,10 +32,37 @@ ERROR: no-vocab vocab ; : check-root ( string -- string ) dup vocab-root? [ not-a-vocab-root ] unless ; +: check-vocab ( vocab -- vocab ) + dup find-vocab-root [ no-vocab ] unless ; + +: check-vocab-root/vocab ( vocab-root string -- vocab-root string ) + [ check-root ] [ check-vocab-name ] bi* ; + +: replace-vocab-separators ( vocab -- path ) + path-separator first CHAR: . associate substitute ; inline + +: vocab-root/vocab>path ( vocab-root vocab -- path ) + check-vocab-root/vocab + [ ] [ replace-vocab-separators ] bi* append-path ; + +: vocab>path ( vocab -- path ) + check-vocab + [ find-vocab-root ] keep vocab-root/vocab>path ; + +: vocab-root/vocab/file>path ( vocab-root vocab file -- path ) + [ vocab-root/vocab>path ] dip append-path ; + +: vocab-root/vocab/suffix>path ( vocab-root vocab suffix -- path ) + [ vocab-root/vocab>path dup file-name append-path ] dip append ; + +: vocab/suffix>path ( vocab suffix -- path ) + [ vocab>path dup file-name append-path ] dip append ; + : directory-exists ( path -- ) "Not creating a directory, it already exists: " write print ; -: scaffold-directory ( path -- ) +: scaffold-directory ( vocab-root vocab -- ) + vocab-root/vocab>path dup exists? [ directory-exists ] [ make-directories ] if ; : not-scaffolding ( path -- path ) @@ -44,11 +71,7 @@ ERROR: no-vocab vocab ; : scaffolding ( path -- path ) "Creating scaffolding for " write dup . ; -: (scaffold-path) ( path string -- path ) - [ dup file-name ] dip append append-path ; - -: scaffold-path ( path string -- path ? ) - (scaffold-path) +: scaffolding? ( path -- path ? ) dup exists? [ not-scaffolding f ] [ scaffolding t ] if ; : scaffold-copyright ( -- ) @@ -63,33 +86,21 @@ ERROR: no-vocab vocab ; "IN: " write print ] with-string-writer ; -: set-scaffold-main-file ( path vocab -- ) - main-file-string swap utf8 set-file-contents ; +: set-scaffold-main-file ( vocab path -- ) + [ main-file-string ] dip utf8 set-file-contents ; -: scaffold-main ( path vocab -- ) - [ ".factor" scaffold-path ] dip - swap [ set-scaffold-main-file ] [ 2drop ] if ; - -: tests-file-string ( vocab -- string ) - [ - scaffold-copyright - "USING: tools.test " write dup write " ;" print - "IN: " write write ".tests" print - ] with-string-writer ; - -: set-scaffold-tests-file ( path vocab -- ) - tests-file-string swap utf8 set-file-contents ; - -: scaffold-tests ( path vocab -- ) - [ "-tests.factor" scaffold-path ] dip - swap [ set-scaffold-tests-file ] [ 2drop ] if ; - -: scaffold-authors ( path -- ) - "authors.txt" append-path dup exists? [ - not-scaffolding drop +: scaffold-main ( vocab-root vocab -- ) + tuck ".factor" vocab-root/vocab/suffix>path scaffolding? [ + set-scaffold-main-file ] [ - scaffolding - developer-name get swap utf8 set-file-contents + 2drop + ] if ; + +: scaffold-authors ( vocab-root vocab -- ) + "authors.txt" vocab-root/vocab/file>path scaffolding? [ + [ developer-name get ] dip utf8 set-file-contents + ] [ + drop ] if ; : lookup-type ( string -- object/string ? ) @@ -155,11 +166,11 @@ ERROR: no-vocab vocab ; drop "{ $description \"\" } ;" print ; -: help-header. ( word -- ) +: docs-header. ( word -- ) "HELP: " write name>> print ; -: (help.) ( word -- ) - [ help-header. ] [ $values. ] [ $description. ] tri ; +: (docs.) ( word -- ) + [ docs-header. ] [ $values. ] [ $description. ] tri ; : interesting-words ( vocab -- array ) words @@ -167,9 +178,9 @@ ERROR: no-vocab vocab ; natural-sort ; : interesting-words. ( vocab -- ) - interesting-words [ (help.) nl ] each ; + interesting-words [ (docs.) nl ] each ; -: help-file-string ( vocab -- str2 ) +: docs-file-string ( vocab -- str2 ) [ { [ "IN: " write print nl ] @@ -190,61 +201,64 @@ ERROR: no-vocab vocab ; [ bl write ] each " ;" print ; -: set-scaffold-help-file ( path vocab -- ) - swap utf8 [ +: set-scaffold-docs-file ( vocab path -- ) + utf8 [ scaffold-copyright - [ help-file-string ] [ write-using ] bi + [ docs-file-string ] [ write-using ] bi write ] with-output-stream ; -: check-scaffold ( vocab-root string -- vocab-root string ) - [ check-root ] [ check-vocab-name ] bi* ; - -: vocab>scaffold-path ( vocab-root string -- path ) - path-separator first CHAR: . associate substitute - append-path ; - -: prepare-scaffold ( vocab-root string -- string path ) - check-scaffold [ vocab>scaffold-path ] keep ; - : with-scaffold ( quot -- ) [ H{ } clone using ] dip with-variable ; inline -: check-vocab ( vocab -- vocab ) - dup find-vocab-root [ no-vocab ] unless ; - PRIVATE> : link-vocab ( vocab -- ) check-vocab "Edit documentation: " write - [ find-vocab-root ] - [ vocab>scaffold-path ] bi - "-docs.factor" (scaffold-path) . ; + "-docs.factor" vocab/suffix>path . ; -: help. ( word -- ) - [ (help.) ] [ nl vocabulary>> link-vocab ] bi ; +: docs. ( word -- ) + [ (docs.) ] [ nl vocabulary>> link-vocab ] bi ; -: scaffold-help ( string -- ) +: scaffold-docs ( vocab -- ) [ - [ find-vocab-root ] [ check-vocab ] bi - prepare-scaffold - [ "-docs.factor" scaffold-path ] dip - swap [ set-scaffold-help-file ] [ 2drop ] if + dup "-docs.factor" vocab/suffix>path scaffolding? [ + set-scaffold-docs-file + ] [ + 2drop + ] if ] with-scaffold ; : scaffold-undocumented ( string -- ) [ interesting-words. ] [ link-vocab ] bi ; -: scaffold-vocab ( vocab-root string -- ) - prepare-scaffold +: scaffold-vocab ( vocab-root vocab -- ) { - [ drop scaffold-directory ] + [ scaffold-directory ] [ scaffold-main ] - [ drop scaffold-authors ] + [ scaffold-authors ] [ nip require ] } 2cleave ; +: tests-file-string ( vocab -- string ) + [ + scaffold-copyright + "USING: tools.test " write dup write " ;" print + "IN: " write write ".tests" print + ] with-string-writer ; + +: set-scaffold-tests-file ( vocab path -- ) + [ tests-file-string ] dip utf8 set-file-contents ; + +: scaffold-tests ( vocab -- ) + dup "-tests.factor" vocab/suffix>path + scaffolding? [ + set-scaffold-tests-file + ] [ + 2drop + ] if ; + SYMBOL: examples-flag : example ( -- ) From 43679966789315c76caa14a81f8dc692971d6767 Mon Sep 17 00:00:00 2001 From: sheeple Date: Sun, 22 Feb 2009 00:33:00 -0600 Subject: [PATCH 075/119] make some more words private, rename scaffold-docs back to scaffold-help --- basis/tools/scaffold/scaffold.factor | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index eb7017f57f..5a0bf66e26 100755 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -211,8 +211,6 @@ ERROR: no-vocab vocab ; : with-scaffold ( quot -- ) [ H{ } clone using ] dip with-variable ; inline -PRIVATE> - : link-vocab ( vocab -- ) check-vocab "Edit documentation: " write @@ -221,7 +219,9 @@ PRIVATE> : docs. ( word -- ) [ (docs.) ] [ nl vocabulary>> link-vocab ] bi ; -: scaffold-docs ( vocab -- ) +PRIVATE> + +: scaffold-help ( vocab -- ) [ dup "-docs.factor" vocab/suffix>path scaffolding? [ set-scaffold-docs-file @@ -233,7 +233,7 @@ PRIVATE> : scaffold-undocumented ( string -- ) [ interesting-words. ] [ link-vocab ] bi ; -: scaffold-vocab ( vocab-root vocab -- ) +: scaffold-vocab ( vocab-root string -- ) { [ scaffold-directory ] [ scaffold-main ] @@ -241,6 +241,8 @@ PRIVATE> [ nip require ] } 2cleave ; + : set-scaffold-tests-file ( vocab path -- ) [ tests-file-string ] dip utf8 set-file-contents ; +PRIVATE> + : scaffold-tests ( vocab -- ) dup "-tests.factor" vocab/suffix>path scaffolding? [ From 57bd819886d5dc36e259f327c74919eacd17924f Mon Sep 17 00:00:00 2001 From: sheeple Date: Sun, 22 Feb 2009 00:42:21 -0600 Subject: [PATCH 076/119] add quoting vocab --- basis/quoting/authors.txt | 1 + basis/quoting/quoting-docs.factor | 32 ++++++++++++++++++++++++++++++ basis/quoting/quoting-tests.factor | 10 ++++++++++ basis/quoting/quoting.factor | 16 +++++++++++++++ 4 files changed, 59 insertions(+) create mode 100644 basis/quoting/authors.txt create mode 100644 basis/quoting/quoting-docs.factor create mode 100644 basis/quoting/quoting-tests.factor create mode 100644 basis/quoting/quoting.factor diff --git a/basis/quoting/authors.txt b/basis/quoting/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/quoting/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/quoting/quoting-docs.factor b/basis/quoting/quoting-docs.factor new file mode 100644 index 0000000000..5fb68db719 --- /dev/null +++ b/basis/quoting/quoting-docs.factor @@ -0,0 +1,32 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax strings ; +IN: quoting + +HELP: quote? +{ $values + { "ch" "a character" } + { "?" "a boolean" } +} +{ $description "Returns true if the character is a single or double quote." } ; + +HELP: quoted? +{ $values + { "str" string } + { "?" "a boolean" } +} +{ $description "Returns true if a string is surrounded by matching single or double quotes as the first and last characters." } ; + +HELP: unquote +{ $values + { "str" string } + { "newstr" string } +} +{ $description "Removes a pair of matching single or double quotes from a string." } ; + +ARTICLE: "quoting" "Quotation marks" +"The " { $vocab-link "quoting" } " vocabulary is for removing quotes from a string." $nl +"Removing quotes:" +{ $subsection unquote } ; + +ABOUT: "quoting" diff --git a/basis/quoting/quoting-tests.factor b/basis/quoting/quoting-tests.factor new file mode 100644 index 0000000000..0cc28a1354 --- /dev/null +++ b/basis/quoting/quoting-tests.factor @@ -0,0 +1,10 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test quoting ; +IN: quoting.tests + + +[ "abc" ] [ "'abc'" unquote ] unit-test +[ "abc" ] [ "\"abc\"" unquote ] unit-test +[ "'abc" ] [ "'abc" unquote ] unit-test +[ "abc'" ] [ "abc'" unquote ] unit-test diff --git a/basis/quoting/quoting.factor b/basis/quoting/quoting.factor new file mode 100644 index 0000000000..9e25037cd9 --- /dev/null +++ b/basis/quoting/quoting.factor @@ -0,0 +1,16 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: combinators.short-circuit kernel math sequences strings ; +IN: quoting + +: quote? ( ch -- ? ) "'\"" member? ; + +: quoted? ( str -- ? ) + { + [ length 1 > ] + [ first quote? ] + [ [ first ] [ peek ] bi = ] + } 1&& ; + +: unquote ( str -- newstr ) + dup quoted? [ but-last-slice rest-slice >string ] when ; From 06f6eb98aa1b8a9009a557acfeb3b3f59b9e7e37 Mon Sep 17 00:00:00 2001 From: sheeple Date: Sun, 22 Feb 2009 00:42:35 -0600 Subject: [PATCH 077/119] use quoting vocab --- basis/db/errors/postgresql/postgresql.factor | 15 +-------------- basis/mime/multipart/multipart.factor | 15 ++------------- 2 files changed, 3 insertions(+), 27 deletions(-) diff --git a/basis/db/errors/postgresql/postgresql.factor b/basis/db/errors/postgresql/postgresql.factor index 2b79859050..02b43ecd88 100644 --- a/basis/db/errors/postgresql/postgresql.factor +++ b/basis/db/errors/postgresql/postgresql.factor @@ -1,22 +1,9 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: kernel db.errors peg.ebnf strings sequences math -combinators.short-circuit accessors math.parser ; +combinators.short-circuit accessors math.parser quoting ; IN: db.errors.postgresql -: quote? ( ch -- ? ) "'\"" member? ; - -: quoted? ( str -- ? ) - { - [ length 1 > ] - [ first quote? ] - [ [ first ] [ peek ] bi = ] - } 1&& ; - -: unquote ( str -- newstr ) - dup quoted? [ but-last-slice rest-slice >string ] when ; - - EBNF: parse-postgresql-sql-error Error = "ERROR:" [ ]+ diff --git a/basis/mime/multipart/multipart.factor b/basis/mime/multipart/multipart.factor index 37d5e13129..0edfb05a30 100755 --- a/basis/mime/multipart/multipart.factor +++ b/basis/mime/multipart/multipart.factor @@ -3,7 +3,8 @@ USING: multiline kernel sequences io splitting fry namespaces http.parsers hashtables assocs combinators ascii io.files.unique accessors io.encodings.binary io.files byte-arrays math -io.streams.string combinators.short-circuit strings math.order ; +io.streams.string combinators.short-circuit strings math.order +quoting ; IN: mime.multipart CONSTANT: buffer-size 65536 @@ -75,18 +76,6 @@ ERROR: end-of-stream multipart ; : empty-name? ( string -- ? ) { "''" "\"\"" "" f } member? ; -: quote? ( ch -- ? ) "'\"" member? ; - -: quoted? ( str -- ? ) - { - [ length 1 > ] - [ first quote? ] - [ [ first ] [ peek ] bi = ] - } 1&& ; - -: unquote ( str -- newstr ) - dup quoted? [ but-last-slice rest-slice >string ] when ; - : save-uploaded-file ( multipart -- ) dup filename>> empty-name? [ drop From 1f5a701f6809ba7d7004fe167f6de61eed40f6af Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 10:03:37 -0600 Subject: [PATCH 078/119] fix load error in scaffold --- basis/tools/scaffold/scaffold-docs.factor | 4 ++-- basis/tools/scaffold/scaffold.factor | 10 +++++----- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/basis/tools/scaffold/scaffold-docs.factor b/basis/tools/scaffold/scaffold-docs.factor index 9074c80986..0a75732553 100644 --- a/basis/tools/scaffold/scaffold-docs.factor +++ b/basis/tools/scaffold/scaffold-docs.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: help.markup help.syntax kernel strings words ; +USING: help.markup help.syntax kernel strings words vocabs ; IN: tools.scaffold HELP: developer-name @@ -13,7 +13,7 @@ HELP: help. { $description "Prints out scaffold help markup for a given word." } ; HELP: scaffold-help -{ $values { "string" string } } +{ $values { "vocab" vocab } } { $description "Takes an existing vocabulary and creates a help file with scaffolded help for each word. This word only works if no help file yet exists." } ; HELP: scaffold-undocumented diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index 5a0bf66e26..16729394bf 100755 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -169,7 +169,7 @@ ERROR: no-vocab vocab ; : docs-header. ( word -- ) "HELP: " write name>> print ; -: (docs.) ( word -- ) +: (help.) ( word -- ) [ docs-header. ] [ $values. ] [ $description. ] tri ; : interesting-words ( vocab -- array ) @@ -178,7 +178,7 @@ ERROR: no-vocab vocab ; natural-sort ; : interesting-words. ( vocab -- ) - interesting-words [ (docs.) nl ] each ; + interesting-words [ (help.) nl ] each ; : docs-file-string ( vocab -- str2 ) [ @@ -216,11 +216,11 @@ ERROR: no-vocab vocab ; "Edit documentation: " write "-docs.factor" vocab/suffix>path . ; -: docs. ( word -- ) - [ (docs.) ] [ nl vocabulary>> link-vocab ] bi ; - PRIVATE> +: help. ( word -- ) + [ (help.) ] [ nl vocabulary>> link-vocab ] bi ; + : scaffold-help ( vocab -- ) [ dup "-docs.factor" vocab/suffix>path scaffolding? [ From b78d8a491fd069935475cd05d245c30b1c7daea0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 10:27:29 -0600 Subject: [PATCH 079/119] add docs for scaffold-rc --- basis/tools/scaffold/scaffold-docs.factor | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/basis/tools/scaffold/scaffold-docs.factor b/basis/tools/scaffold/scaffold-docs.factor index 0a75732553..4d1240ad38 100644 --- a/basis/tools/scaffold/scaffold-docs.factor +++ b/basis/tools/scaffold/scaffold-docs.factor @@ -28,6 +28,21 @@ HELP: scaffold-vocab { "vocab-root" "a vocabulary root string" } { "string" string } } { $description "Creates a directory in the given root for a new vocabulary and adds a main .factor file, a tests file, and an authors.txt file." } ; +HELP: scaffold-emacs +{ $description "Touches the .emacs file in your home directory and provides a clickable link to open it in an editor." } ; + +HELP: scaffold-factor-boot-rc +{ $description "Touches the .factor-boot-rc file in your home directory and provides a clickable link to open it in an editor." } ; + +HELP: scaffold-factor-rc +{ $description "Touches the .factor-rc file in your home directory and provides a clickable link to open it in an editor." } ; + +HELP: scaffold-rc +{ $values + { "path" "a pathname string" } +} +{ $description "Touches the given path in your home directory and provides a clickable link to open it in an editor." } ; + HELP: using { $description "Stores the vocabularies that are pulled into the documentation file from looking up the stack effect types." } ; @@ -40,7 +55,12 @@ ARTICLE: "tools.scaffold" "Scaffold tool" { $subsection scaffold-help } { $subsection scaffold-undocumented } { $subsection help. } -"Types that are unrecognized by the scaffold generator will be of type " { $link null } ". The developer should change these to strings that describe the stack effect names instead." +"Types that are unrecognized by the scaffold generator will be of type " { $link null } ". The developer should change these to strings that describe the stack effect names instead." $nl +"Scaffolding a configuration file:" +{ $subsection scaffold-rc } +{ $subsection scaffold-factor-boot-rc } +{ $subsection scaffold-factor-rc } +{ $subsection scaffold-emacs } ; ABOUT: "tools.scaffold" From 50bf9228323d64f4391143d9bb68a3d48b126908 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Feb 2009 12:35:18 -0600 Subject: [PATCH 080/119] Tweak annotations docs so that help-lint passes --- extra/annotations/annotations-docs.factor | 34 +++++++++++++++++------ 1 file changed, 26 insertions(+), 8 deletions(-) diff --git a/extra/annotations/annotations-docs.factor b/extra/annotations/annotations-docs.factor index bf8aef3a07..1bece9d4fb 100644 --- a/extra/annotations/annotations-docs.factor +++ b/extra/annotations/annotations-docs.factor @@ -1,6 +1,6 @@ USING: accessors arrays combinators definitions generalizations help help.markup help.topics kernel sequences sorting vocabs -words ; +words combinators.smart ; IN: annotations first [ "!" " your comment here" surround 1array $syntax ] [ [ "Treats the rest of the line after the exclamation point as a code annotation that can be looked up with the " \ $link ] dip comment-usage.-word 2array " word." 3array $description ] - [ ": foo ( x y z -- w )\n !" " --w-ó()ò-w-- kilroy was here\n + * ;" surround 1array $unchecked-example ] + [ ": foo ( x y z -- w )\n !" " --w-ó()ò-w-- kilroy was here\n + * ;" surround 1array $code ] tri ; +: <$annotation> ( word -- element ) + \ $annotation swap 2array 1array ; + : $annotation-usage. ( element -- ) first [ "Displays a list of words, help articles, and vocabularies that contain " \ $link ] dip comment-word 2array " annotations." 3array $description ; +: <$annotation-usage.> ( word -- element ) + \ $annotation-usage. swap 2array 1array ; + : $annotation-usage ( element -- ) - first - { "usages" sequence } $values - [ "Returns a list of words, help articles, and vocabularies that contain " \ $link ] dip [ comment-word 2array " annotations. For a more user-friendly display, use the " \ $link ] [ comment-usage.-word 2array " word." 6 narray ] bi 1array $description ; + first [ + [ "Returns a list of words, help articles, and vocabularies that contain " ] dip + [ + comment-word <$link> + " annotations. For a more user-friendly display, use the " + ] [ + comment-usage.-word <$link> + " word." + ] bi + ] output>array $description ; + +: <$annotation-usage> ( word -- element ) + [ { $values { "usages" sequence } } ] dip + \ $annotation-usage swap 2array + 2array ; "Code annotations" { @@ -42,9 +60,9 @@ annotation-tags natural-sort annotation-tags [ { - [ [ \ $annotation swap 2array 1array ] [ comment-word set-word-help ] bi ] - [ [ \ $annotation-usage swap 2array 1array ] [ comment-usage-word set-word-help ] bi ] - [ [ \ $annotation-usage. swap 2array 1array ] [ comment-usage.-word set-word-help ] bi ] + [ [ <$annotation> ] [ comment-word set-word-help ] bi ] + [ [ <$annotation-usage> ] [ comment-usage-word set-word-help ] bi ] + [ [ <$annotation-usage.> ] [ comment-usage.-word set-word-help ] bi ] [ [ comment-word ] [ comment-usage-word ] [ comment-usage.-word ] tri 3array related-words ] } cleave ] each From 90dac6f881726f68edf72b9a18901df2c148713d Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sun, 22 Feb 2009 20:20:46 +0100 Subject: [PATCH 081/119] FUEL: C-uC-co won't ask for file creation while cycling. --- misc/fuel/factor-mode.el | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/misc/fuel/factor-mode.el b/misc/fuel/factor-mode.el index ba9be2edd3..b302fb6b8f 100644 --- a/misc/fuel/factor-mode.el +++ b/misc/fuel/factor-mode.el @@ -197,7 +197,7 @@ code in the buffer." (when (string-match factor-mode--cycle-basename-regex basename) (cons (match-string 1 basename) (match-string 2 basename)))) -(defun factor-mode--cycle-next (file) +(defun factor-mode--cycle-next (file skip) (let* ((dir (file-name-directory file)) (basename (file-name-nondirectory file)) (p/s (factor-mode--cycle-split basename)) @@ -211,7 +211,8 @@ code in the buffer." (let* ((suffix (ring-ref ring (+ i idx))) (path (expand-file-name (concat prefix suffix) dir))) (when (or (file-exists-p path) - (and (not (member suffix factor-mode--cycling-no-ask)) + (and (not skip) + (not (member suffix factor-mode--cycling-no-ask)) (y-or-n-p (format "Create %s? " path)))) (setq result path)) (when (and (not factor-mode-cycle-always-ask-p) @@ -224,10 +225,11 @@ code in the buffer." (defsubst factor-mode--cycling-setup () (setq factor-mode--cycling-no-ask nil)) -(defun factor-mode-visit-other-file (&optional file) - "Cycle between code, tests and docs factor files." - (interactive) - (let ((file (factor-mode--cycle-next (or file (buffer-file-name))))) +(defun factor-mode-visit-other-file (&optional skip) + "Cycle between code, tests and docs factor files. +With prefix, non-existing files will be skipped." + (interactive "P") + (let ((file (factor-mode--cycle-next (buffer-file-name) skip))) (unless file (error "No other file found")) (find-file file) (unless (file-exists-p file) From ff44ef224d7585efef9430b8cf8b73549d4ba8ef Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 17:13:18 -0600 Subject: [PATCH 082/119] add ?at, tests, documentation --- core/assocs/assocs-docs.factor | 7 ++++++- core/assocs/assocs-tests.factor | 5 ++++- core/assocs/assocs.factor | 7 +++++-- 3 files changed, 15 insertions(+), 4 deletions(-) diff --git a/core/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor index e5c43f3ed6..9576a41b7b 100755 --- a/core/assocs/assocs-docs.factor +++ b/core/assocs/assocs-docs.factor @@ -58,6 +58,7 @@ ARTICLE: "assocs-lookup" "Lookup and querying of assocs" "Utility operations built up from the " { $link "assocs-protocol" } ":" { $subsection key? } { $subsection at } +{ $subsection ?at } { $subsection assoc-empty? } { $subsection keys } { $subsection values } @@ -188,12 +189,16 @@ HELP: key? { $values { "key" object } { "assoc" assoc } { "?" "a boolean" } } { $description "Tests if an assoc contains a key." } ; -{ at at* key? } related-words +{ at at* key? ?at } related-words HELP: at { $values { "key" "an object" } { "assoc" assoc } { "value/f" "the value associated to the key, or " { $link f } " if the key is not present in the assoc" } } { $description "Looks up the value associated with a key. This word makes no distinction between a missing value and a value set to " { $link f } "; if the difference is important, use " { $link at* } "." } ; +HELP: ?at +{ $values { "key" "an object" } { "assoc" assoc } { "value/key" "the value associated to the key, or the key if the key is not present in the assoc" } { "?" "a boolean" } } +{ $description "Looks up the value associated with a key. If the key was not present, an error can be thrown without extra stack shuffling. This word handles assocs that store " { $link f } "." } ; + HELP: assoc-each { $values { "assoc" assoc } { "quot" { $quotation "( key value -- )" } } } { $description "Applies a quotation to each entry in the assoc." } diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor index 5617888148..fc74df6d45 100644 --- a/core/assocs/assocs-tests.factor +++ b/core/assocs/assocs-tests.factor @@ -138,4 +138,7 @@ unit-test { "c" [ 3 ] } { "d" [ 4 ] } } [ nip first even? ] assoc-partition -] unit-test \ No newline at end of file +] unit-test + +[ 1 f ] [ 1 H{ } ?at ] unit-test +[ 2 t ] [ 1 H{ { 1 2 } } ?at ] unit-test diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index e46bb7abb6..fdaa02e6c4 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -19,6 +19,9 @@ GENERIC: >alist ( assoc -- newassoc ) M: assoc assoc-like drop ; +: ?at ( key assoc -- value/key ? ) + dupd at* [ [ nip ] [ drop ] if ] keep ; inline + at* drop ; inline : at-default ( key assoc -- value/key ) - 2dup at* [ 2nip ] [ 2drop ] if ; inline + ?at drop ; inline M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) [ dup assoc-size ] dip new-assoc From 7a3c086178687d951b4e7233d1647fdde4bbadbd Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 17:14:46 -0600 Subject: [PATCH 083/119] remove ?at from db.types, images.tiff --- basis/db/types/types.factor | 3 --- basis/images/tiff/tiff.factor | 3 --- 2 files changed, 6 deletions(-) diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor index e39a5977ef..30116e3fc5 100755 --- a/basis/db/types/types.factor +++ b/basis/db/types/types.factor @@ -124,9 +124,6 @@ FACTOR-BLOB NULL URL ; ! PostgreSQL Types: ! http://developer.postgresql.org/pgdocs/postgres/datatype.html -: ?at ( obj assoc -- value/obj ? ) - dupd at* [ [ nip ] [ drop ] if ] keep ; - ERROR: unknown-modifier modifier ; : lookup-modifier ( obj -- string ) diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor index 02440deea5..a50ac0cad9 100755 --- a/basis/images/tiff/tiff.factor +++ b/basis/images/tiff/tiff.factor @@ -243,9 +243,6 @@ ERROR: bad-tiff-magic bytes ; ERROR: no-tag class ; -: ?at ( key assoc -- value/key ? ) - dupd at* [ nip t ] [ drop f ] if ; inline - : find-tag ( idf class -- tag ) swap processed-tags>> ?at [ no-tag ] unless ; From edbaba2322a1bddd9a25e457afe1be4d304fd39c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 17:29:27 -0600 Subject: [PATCH 084/119] report the value not found in lzw --- basis/compression/lzw/lzw.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/compression/lzw/lzw.factor b/basis/compression/lzw/lzw.factor index 67248474d3..29cbe96d69 100644 --- a/basis/compression/lzw/lzw.factor +++ b/basis/compression/lzw/lzw.factor @@ -69,11 +69,11 @@ ERROR: index-too-big n ; : omega-k-in-table? ( lzw -- ? ) [ omega-k>> ] [ table>> ] bi key? ; -ERROR: not-in-table ; +ERROR: not-in-table value ; : write-output ( lzw -- ) [ - [ omega>> ] [ table>> ] bi at* [ not-in-table ] unless + [ omega>> ] [ table>> ] bi ?at [ not-in-table ] unless ] [ [ lzw-bit-width-compress ] [ output>> write-bits ] bi From d0030ba8995babe6964d967e900127f7ccbafda1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 17:44:09 -0600 Subject: [PATCH 085/119] remove old io.serial --- extra/io/serial/authors.txt | 1 - extra/io/serial/serial.factor | 21 --- extra/io/serial/summary.txt | 1 - extra/io/serial/tags.txt | 1 - extra/io/serial/unix/bsd/bsd.factor | 86 ------------ extra/io/serial/unix/bsd/tags.txt | 1 - extra/io/serial/unix/linux/linux.factor | 130 ------------------ extra/io/serial/unix/linux/tags.txt | 1 - extra/io/serial/unix/tags.txt | 1 - extra/io/serial/unix/termios/bsd/bsd.factor | 19 --- extra/io/serial/unix/termios/bsd/tags.txt | 1 - .../io/serial/unix/termios/linux/linux.factor | 20 --- extra/io/serial/unix/termios/linux/tags.txt | 1 - extra/io/serial/unix/termios/tags.txt | 1 - extra/io/serial/unix/termios/termios.factor | 9 -- extra/io/serial/unix/unix-tests.factor | 21 --- extra/io/serial/unix/unix.factor | 62 --------- 17 files changed, 377 deletions(-) delete mode 100644 extra/io/serial/authors.txt delete mode 100644 extra/io/serial/serial.factor delete mode 100644 extra/io/serial/summary.txt delete mode 100644 extra/io/serial/tags.txt delete mode 100644 extra/io/serial/unix/bsd/bsd.factor delete mode 100644 extra/io/serial/unix/bsd/tags.txt delete mode 100644 extra/io/serial/unix/linux/linux.factor delete mode 100644 extra/io/serial/unix/linux/tags.txt delete mode 100644 extra/io/serial/unix/tags.txt delete mode 100644 extra/io/serial/unix/termios/bsd/bsd.factor delete mode 100644 extra/io/serial/unix/termios/bsd/tags.txt delete mode 100644 extra/io/serial/unix/termios/linux/linux.factor delete mode 100644 extra/io/serial/unix/termios/linux/tags.txt delete mode 100644 extra/io/serial/unix/termios/tags.txt delete mode 100644 extra/io/serial/unix/termios/termios.factor delete mode 100644 extra/io/serial/unix/unix-tests.factor delete mode 100644 extra/io/serial/unix/unix.factor diff --git a/extra/io/serial/authors.txt b/extra/io/serial/authors.txt deleted file mode 100644 index 7c1b2f2279..0000000000 --- a/extra/io/serial/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/extra/io/serial/serial.factor b/extra/io/serial/serial.factor deleted file mode 100644 index bcea984579..0000000000 --- a/extra/io/serial/serial.factor +++ /dev/null @@ -1,21 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types assocs combinators destructors -kernel math math.bitwise math.parser sequences summary system -vocabs.loader ; -IN: io.serial - -TUPLE: serial stream path baud - termios iflag oflag cflag lflag ; - -ERROR: invalid-baud baud ; -M: invalid-baud summary ( invalid-baud -- string ) - baud>> number>string - "Baud rate " " not supported" surround ; - -HOOK: lookup-baud os ( m -- n ) -HOOK: open-serial os ( serial -- stream ) - -{ - { [ os unix? ] [ "io.serial.unix" ] } -} cond require diff --git a/extra/io/serial/summary.txt b/extra/io/serial/summary.txt deleted file mode 100644 index 5ccd99dbaa..0000000000 --- a/extra/io/serial/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Serial port library diff --git a/extra/io/serial/tags.txt b/extra/io/serial/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/extra/io/serial/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/extra/io/serial/unix/bsd/bsd.factor b/extra/io/serial/unix/bsd/bsd.factor deleted file mode 100644 index b684190698..0000000000 --- a/extra/io/serial/unix/bsd/bsd.factor +++ /dev/null @@ -1,86 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax kernel math.bitwise sequences system io.serial ; -IN: io.serial.unix - -M: bsd lookup-baud ( m -- n ) - dup { - 0 50 75 110 134 150 200 300 600 1200 1800 2400 4800 - 7200 9600 14400 19200 28800 38400 57600 76800 115200 - 230400 460800 921600 - } member? [ invalid-baud ] unless ; - -: TCSANOW 0 ; inline -: TCSADRAIN 1 ; inline -: TCSAFLUSH 2 ; inline -: TCSASOFT HEX: 10 ; inline - -: TCIFLUSH 1 ; inline -: TCOFLUSH 2 ; inline -: TCIOFLUSH 3 ; inline -: TCOOFF 1 ; inline -: TCOON 2 ; inline -: TCIOFF 3 ; inline -: TCION 4 ; inline - -! iflags -: IGNBRK HEX: 00000001 ; inline -: BRKINT HEX: 00000002 ; inline -: IGNPAR HEX: 00000004 ; inline -: PARMRK HEX: 00000008 ; inline -: INPCK HEX: 00000010 ; inline -: ISTRIP HEX: 00000020 ; inline -: INLCR HEX: 00000040 ; inline -: IGNCR HEX: 00000080 ; inline -: ICRNL HEX: 00000100 ; inline -: IXON HEX: 00000200 ; inline -: IXOFF HEX: 00000400 ; inline -: IXANY HEX: 00000800 ; inline -: IMAXBEL HEX: 00002000 ; inline -: IUTF8 HEX: 00004000 ; inline - -! oflags -: OPOST HEX: 00000001 ; inline -: ONLCR HEX: 00000002 ; inline -: OXTABS HEX: 00000004 ; inline -: ONOEOT HEX: 00000008 ; inline - -! cflags -: CIGNORE HEX: 00000001 ; inline -: CSIZE HEX: 00000300 ; inline -: CS5 HEX: 00000000 ; inline -: CS6 HEX: 00000100 ; inline -: CS7 HEX: 00000200 ; inline -: CS8 HEX: 00000300 ; inline -: CSTOPB HEX: 00000400 ; inline -: CREAD HEX: 00000800 ; inline -: PARENB HEX: 00001000 ; inline -: PARODD HEX: 00002000 ; inline -: HUPCL HEX: 00004000 ; inline -: CLOCAL HEX: 00008000 ; inline -: CCTS_OFLOW HEX: 00010000 ; inline -: CRTS_IFLOW HEX: 00020000 ; inline -: CRTSCTS { CCTS_OFLOW CRTS_IFLOW } flags ; inline -: CDTR_IFLOW HEX: 00040000 ; inline -: CDSR_OFLOW HEX: 00080000 ; inline -: CCAR_OFLOW HEX: 00100000 ; inline -: MDMBUF HEX: 00100000 ; inline - -! lflags -: ECHOKE HEX: 00000001 ; inline -: ECHOE HEX: 00000002 ; inline -: ECHOK HEX: 00000004 ; inline -: ECHO HEX: 00000008 ; inline -: ECHONL HEX: 00000010 ; inline -: ECHOPRT HEX: 00000020 ; inline -: ECHOCTL HEX: 00000040 ; inline -: ISIG HEX: 00000080 ; inline -: ICANON HEX: 00000100 ; inline -: ALTWERASE HEX: 00000200 ; inline -: IEXTEN HEX: 00000400 ; inline -: EXTPROC HEX: 00000800 ; inline -: TOSTOP HEX: 00400000 ; inline -: FLUSHO HEX: 00800000 ; inline -: NOKERNINFO HEX: 02000000 ; inline -: PENDIN HEX: 20000000 ; inline -: NOFLSH HEX: 80000000 ; inline diff --git a/extra/io/serial/unix/bsd/tags.txt b/extra/io/serial/unix/bsd/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/extra/io/serial/unix/bsd/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/extra/io/serial/unix/linux/linux.factor b/extra/io/serial/unix/linux/linux.factor deleted file mode 100644 index 342ff4499f..0000000000 --- a/extra/io/serial/unix/linux/linux.factor +++ /dev/null @@ -1,130 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: assocs alien.syntax kernel io.serial system unix ; -IN: io.serial.unix - -: TCSANOW 0 ; inline -: TCSADRAIN 1 ; inline -: TCSAFLUSH 2 ; inline - -: TCIFLUSH 0 ; inline -: TCOFLUSH 1 ; inline -: TCIOFLUSH 2 ; inline - -: TCOOFF 0 ; inline -: TCOON 1 ; inline -: TCIOFF 2 ; inline -: TCION 3 ; inline - -! iflag -: IGNBRK OCT: 0000001 ; inline -: BRKINT OCT: 0000002 ; inline -: IGNPAR OCT: 0000004 ; inline -: PARMRK OCT: 0000010 ; inline -: INPCK OCT: 0000020 ; inline -: ISTRIP OCT: 0000040 ; inline -: INLCR OCT: 0000100 ; inline -: IGNCR OCT: 0000200 ; inline -: ICRNL OCT: 0000400 ; inline -: IUCLC OCT: 0001000 ; inline -: IXON OCT: 0002000 ; inline -: IXANY OCT: 0004000 ; inline -: IXOFF OCT: 0010000 ; inline -: IMAXBEL OCT: 0020000 ; inline -: IUTF8 OCT: 0040000 ; inline - -! oflag -: OPOST OCT: 0000001 ; inline -: OLCUC OCT: 0000002 ; inline -: ONLCR OCT: 0000004 ; inline -: OCRNL OCT: 0000010 ; inline -: ONOCR OCT: 0000020 ; inline -: ONLRET OCT: 0000040 ; inline -: OFILL OCT: 0000100 ; inline -: OFDEL OCT: 0000200 ; inline -: NLDLY OCT: 0000400 ; inline -: NL0 OCT: 0000000 ; inline -: NL1 OCT: 0000400 ; inline -: CRDLY OCT: 0003000 ; inline -: CR0 OCT: 0000000 ; inline -: CR1 OCT: 0001000 ; inline -: CR2 OCT: 0002000 ; inline -: CR3 OCT: 0003000 ; inline -: TABDLY OCT: 0014000 ; inline -: TAB0 OCT: 0000000 ; inline -: TAB1 OCT: 0004000 ; inline -: TAB2 OCT: 0010000 ; inline -: TAB3 OCT: 0014000 ; inline -: BSDLY OCT: 0020000 ; inline -: BS0 OCT: 0000000 ; inline -: BS1 OCT: 0020000 ; inline -: FFDLY OCT: 0100000 ; inline -: FF0 OCT: 0000000 ; inline -: FF1 OCT: 0100000 ; inline - -! cflags -: CSIZE OCT: 0000060 ; inline -: CS5 OCT: 0000000 ; inline -: CS6 OCT: 0000020 ; inline -: CS7 OCT: 0000040 ; inline -: CS8 OCT: 0000060 ; inline -: CSTOPB OCT: 0000100 ; inline -: CREAD OCT: 0000200 ; inline -: PARENB OCT: 0000400 ; inline -: PARODD OCT: 0001000 ; inline -: HUPCL OCT: 0002000 ; inline -: CLOCAL OCT: 0004000 ; inline -: CIBAUD OCT: 002003600000 ; inline -: CRTSCTS OCT: 020000000000 ; inline - -! lflags -: ISIG OCT: 0000001 ; inline -: ICANON OCT: 0000002 ; inline -: XCASE OCT: 0000004 ; inline -: ECHO OCT: 0000010 ; inline -: ECHOE OCT: 0000020 ; inline -: ECHOK OCT: 0000040 ; inline -: ECHONL OCT: 0000100 ; inline -: NOFLSH OCT: 0000200 ; inline -: TOSTOP OCT: 0000400 ; inline -: ECHOCTL OCT: 0001000 ; inline -: ECHOPRT OCT: 0002000 ; inline -: ECHOKE OCT: 0004000 ; inline -: FLUSHO OCT: 0010000 ; inline -: PENDIN OCT: 0040000 ; inline -: IEXTEN OCT: 0100000 ; inline - -M: linux lookup-baud ( n -- n ) - dup H{ - { 0 OCT: 0000000 } - { 50 OCT: 0000001 } - { 75 OCT: 0000002 } - { 110 OCT: 0000003 } - { 134 OCT: 0000004 } - { 150 OCT: 0000005 } - { 200 OCT: 0000006 } - { 300 OCT: 0000007 } - { 600 OCT: 0000010 } - { 1200 OCT: 0000011 } - { 1800 OCT: 0000012 } - { 2400 OCT: 0000013 } - { 4800 OCT: 0000014 } - { 9600 OCT: 0000015 } - { 19200 OCT: 0000016 } - { 38400 OCT: 0000017 } - { 57600 OCT: 0010001 } - { 115200 OCT: 0010002 } - { 230400 OCT: 0010003 } - { 460800 OCT: 0010004 } - { 500000 OCT: 0010005 } - { 576000 OCT: 0010006 } - { 921600 OCT: 0010007 } - { 1000000 OCT: 0010010 } - { 1152000 OCT: 0010011 } - { 1500000 OCT: 0010012 } - { 2000000 OCT: 0010013 } - { 2500000 OCT: 0010014 } - { 3000000 OCT: 0010015 } - { 3500000 OCT: 0010016 } - { 4000000 OCT: 0010017 } - } at* [ nip ] [ drop invalid-baud ] if ; diff --git a/extra/io/serial/unix/linux/tags.txt b/extra/io/serial/unix/linux/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/extra/io/serial/unix/linux/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/extra/io/serial/unix/tags.txt b/extra/io/serial/unix/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/extra/io/serial/unix/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/extra/io/serial/unix/termios/bsd/bsd.factor b/extra/io/serial/unix/termios/bsd/bsd.factor deleted file mode 100644 index 414ec98438..0000000000 --- a/extra/io/serial/unix/termios/bsd/bsd.factor +++ /dev/null @@ -1,19 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax kernel sequences system ; -IN: io.serial.unix.termios - -: NCCS 20 ; inline - -TYPEDEF: uint tcflag_t -TYPEDEF: uchar cc_t -TYPEDEF: uint speed_t - -C-STRUCT: termios - { "tcflag_t" "iflag" } ! input mode flags - { "tcflag_t" "oflag" } ! output mode flags - { "tcflag_t" "cflag" } ! control mode flags - { "tcflag_t" "lflag" } ! local mode flags - { { "cc_t" NCCS } "cc" } ! control characters - { "speed_t" "ispeed" } ! input speed - { "speed_t" "ospeed" } ; ! output speed diff --git a/extra/io/serial/unix/termios/bsd/tags.txt b/extra/io/serial/unix/termios/bsd/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/extra/io/serial/unix/termios/bsd/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/extra/io/serial/unix/termios/linux/linux.factor b/extra/io/serial/unix/termios/linux/linux.factor deleted file mode 100644 index c7da10a6f5..0000000000 --- a/extra/io/serial/unix/termios/linux/linux.factor +++ /dev/null @@ -1,20 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax kernel system unix ; -IN: io.serial.unix.termios - -: NCCS 32 ; inline - -TYPEDEF: uchar cc_t -TYPEDEF: uint speed_t -TYPEDEF: uint tcflag_t - -C-STRUCT: termios - { "tcflag_t" "iflag" } ! input mode flags - { "tcflag_t" "oflag" } ! output mode flags - { "tcflag_t" "cflag" } ! control mode flags - { "tcflag_t" "lflag" } ! local mode flags - { "cc_t" "line" } ! line discipline - { { "cc_t" NCCS } "cc" } ! control characters - { "speed_t" "ispeed" } ! input speed - { "speed_t" "ospeed" } ; ! output speed diff --git a/extra/io/serial/unix/termios/linux/tags.txt b/extra/io/serial/unix/termios/linux/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/extra/io/serial/unix/termios/linux/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/extra/io/serial/unix/termios/tags.txt b/extra/io/serial/unix/termios/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/extra/io/serial/unix/termios/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/extra/io/serial/unix/termios/termios.factor b/extra/io/serial/unix/termios/termios.factor deleted file mode 100644 index e5ccd37e87..0000000000 --- a/extra/io/serial/unix/termios/termios.factor +++ /dev/null @@ -1,9 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: combinators system vocabs.loader ; -IN: io.serial.unix.termios - -{ - { [ os linux? ] [ "io.serial.unix.termios.linux" ] } - { [ os bsd? ] [ "io.serial.unix.termios.bsd" ] } -} cond require diff --git a/extra/io/serial/unix/unix-tests.factor b/extra/io/serial/unix/unix-tests.factor deleted file mode 100644 index 6dd056feb5..0000000000 --- a/extra/io/serial/unix/unix-tests.factor +++ /dev/null @@ -1,21 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel math.bitwise serial serial.unix ; -IN: io.serial.unix - -: serial-obj ( -- obj ) - serial new - "/dev/ttyS0" >>path - 19200 >>baud - { IGNPAR ICRNL } flags >>iflag - { } flags >>oflag - { CS8 CLOCAL CREAD } flags >>cflag - { ICANON } flags >>lflag ; - -: serial-test ( -- serial ) - serial-obj - open-serial - dup get-termios >>termios - dup configure-termios - dup tciflush - dup apply-termios ; diff --git a/extra/io/serial/unix/unix.factor b/extra/io/serial/unix/unix.factor deleted file mode 100644 index 1da6385f96..0000000000 --- a/extra/io/serial/unix/unix.factor +++ /dev/null @@ -1,62 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types alien.syntax combinators io.ports -io.streams.duplex io.unix.backend system kernel math math.bitwise -vocabs.loader unix io.serial io.serial.unix.termios ; -IN: io.serial.unix - -<< { - { [ os linux? ] [ "io.serial.unix.linux" ] } - { [ os bsd? ] [ "io.serial.unix.bsd" ] } -} cond require >> - -FUNCTION: speed_t cfgetispeed ( termios* t ) ; -FUNCTION: speed_t cfgetospeed ( termios* t ) ; -FUNCTION: int cfsetispeed ( termios* t, speed_t s ) ; -FUNCTION: int cfsetospeed ( termios* t, speed_t s ) ; -FUNCTION: int tcgetattr ( int i1, termios* t ) ; -FUNCTION: int tcsetattr ( int i1, int i2, termios* t ) ; -FUNCTION: int tcdrain ( int i1 ) ; -FUNCTION: int tcflow ( int i1, int i2 ) ; -FUNCTION: int tcflush ( int i1, int i2 ) ; -FUNCTION: int tcsendbreak ( int i1, int i2 ) ; -FUNCTION: void cfmakeraw ( termios* t ) ; -FUNCTION: int cfsetspeed ( termios* t, speed_t s ) ; - -: fd>duplex-stream ( fd -- duplex-stream ) - init-fd - [ ] [ ] bi ; - -: open-rw ( path -- fd ) O_RDWR file-mode open-file ; -: ( path -- stream ) open-rw fd>duplex-stream ; - -M: unix open-serial ( serial -- serial' ) - path>> { O_RDWR O_NOCTTY O_NDELAY } flags file-mode open-file - fd>duplex-stream ; - -: serial-fd ( serial -- fd ) - stream>> in>> handle>> fd>> ; - -: get-termios ( serial -- termios ) - serial-fd - "termios" [ tcgetattr io-error ] keep ; - -: configure-termios ( serial -- ) - dup termios>> - { - [ [ iflag>> ] dip over [ set-termios-iflag ] [ 2drop ] if ] - [ [ oflag>> ] dip over [ set-termios-oflag ] [ 2drop ] if ] - [ - [ - [ cflag>> 0 or ] [ baud>> lookup-baud ] bi bitor - ] dip set-termios-cflag - ] - [ [ lflag>> ] dip over [ set-termios-lflag ] [ 2drop ] if ] - } 2cleave ; - -: tciflush ( serial -- ) - serial-fd TCIFLUSH tcflush io-error ; - -: apply-termios ( serial -- ) - [ serial-fd TCSANOW ] - [ termios>> ] bi tcsetattr io-error ; From 0ccb04e50f4ab92375b97f6bfc5c692444112c3b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 17:45:04 -0600 Subject: [PATCH 086/119] use CONSTANT: in lots of places --- extra/serial/unix/bsd/bsd.factor | 130 +++++++-------- extra/serial/unix/linux/linux.factor | 162 +++++++++---------- extra/serial/unix/termios/bsd/bsd.factor | 2 +- extra/serial/unix/termios/linux/linux.factor | 2 +- extra/serial/unix/unix.factor | 4 +- 5 files changed, 150 insertions(+), 150 deletions(-) diff --git a/extra/serial/unix/bsd/bsd.factor b/extra/serial/unix/bsd/bsd.factor index d31d947dcb..22886ecb15 100644 --- a/extra/serial/unix/bsd/bsd.factor +++ b/extra/serial/unix/bsd/bsd.factor @@ -10,77 +10,77 @@ M: bsd lookup-baud ( m -- n ) 230400 460800 921600 } member? [ invalid-baud ] unless ; -: TCSANOW 0 ; inline -: TCSADRAIN 1 ; inline -: TCSAFLUSH 2 ; inline -: TCSASOFT HEX: 10 ; inline +CONSTANT: TCSANOW 0 +CONSTANT: TCSADRAIN 1 +CONSTANT: TCSAFLUSH 2 +CONSTANT: TCSASOFT HEX: 10 -: TCIFLUSH 1 ; inline -: TCOFLUSH 2 ; inline -: TCIOFLUSH 3 ; inline -: TCOOFF 1 ; inline -: TCOON 2 ; inline -: TCIOFF 3 ; inline -: TCION 4 ; inline +CONSTANT: TCIFLUSH 1 +CONSTANT: TCOFLUSH 2 +CONSTANT: TCIOFLUSH 3 +CONSTANT: TCOOFF 1 +CONSTANT: TCOON 2 +CONSTANT: TCIOFF 3 +CONSTANT: TCION 4 ! iflags -: IGNBRK HEX: 00000001 ; inline -: BRKINT HEX: 00000002 ; inline -: IGNPAR HEX: 00000004 ; inline -: PARMRK HEX: 00000008 ; inline -: INPCK HEX: 00000010 ; inline -: ISTRIP HEX: 00000020 ; inline -: INLCR HEX: 00000040 ; inline -: IGNCR HEX: 00000080 ; inline -: ICRNL HEX: 00000100 ; inline -: IXON HEX: 00000200 ; inline -: IXOFF HEX: 00000400 ; inline -: IXANY HEX: 00000800 ; inline -: IMAXBEL HEX: 00002000 ; inline -: IUTF8 HEX: 00004000 ; inline +CONSTANT: IGNBRK HEX: 00000001 +CONSTANT: BRKINT HEX: 00000002 +CONSTANT: IGNPAR HEX: 00000004 +CONSTANT: PARMRK HEX: 00000008 +CONSTANT: INPCK HEX: 00000010 +CONSTANT: ISTRIP HEX: 00000020 +CONSTANT: INLCR HEX: 00000040 +CONSTANT: IGNCR HEX: 00000080 +CONSTANT: ICRNL HEX: 00000100 +CONSTANT: IXON HEX: 00000200 +CONSTANT: IXOFF HEX: 00000400 +CONSTANT: IXANY HEX: 00000800 +CONSTANT: IMAXBEL HEX: 00002000 +CONSTANT: IUTF8 HEX: 00004000 ! oflags -: OPOST HEX: 00000001 ; inline -: ONLCR HEX: 00000002 ; inline -: OXTABS HEX: 00000004 ; inline -: ONOEOT HEX: 00000008 ; inline +CONSTANT: OPOST HEX: 00000001 +CONSTANT: ONLCR HEX: 00000002 +CONSTANT: OXTABS HEX: 00000004 +CONSTANT: ONOEOT HEX: 00000008 ! cflags -: CIGNORE HEX: 00000001 ; inline -: CSIZE HEX: 00000300 ; inline -: CS5 HEX: 00000000 ; inline -: CS6 HEX: 00000100 ; inline -: CS7 HEX: 00000200 ; inline -: CS8 HEX: 00000300 ; inline -: CSTOPB HEX: 00000400 ; inline -: CREAD HEX: 00000800 ; inline -: PARENB HEX: 00001000 ; inline -: PARODD HEX: 00002000 ; inline -: HUPCL HEX: 00004000 ; inline -: CLOCAL HEX: 00008000 ; inline -: CCTS_OFLOW HEX: 00010000 ; inline -: CRTS_IFLOW HEX: 00020000 ; inline -: CRTSCTS { CCTS_OFLOW CRTS_IFLOW } flags ; inline -: CDTR_IFLOW HEX: 00040000 ; inline -: CDSR_OFLOW HEX: 00080000 ; inline -: CCAR_OFLOW HEX: 00100000 ; inline -: MDMBUF HEX: 00100000 ; inline +CONSTANT: CIGNORE HEX: 00000001 +CONSTANT: CSIZE HEX: 00000300 +CONSTANT: CS5 HEX: 00000000 +CONSTANT: CS6 HEX: 00000100 +CONSTANT: CS7 HEX: 00000200 +CONSTANT: CS8 HEX: 00000300 +CONSTANT: CSTOPB HEX: 00000400 +CONSTANT: CREAD HEX: 00000800 +CONSTANT: PARENB HEX: 00001000 +CONSTANT: PARODD HEX: 00002000 +CONSTANT: HUPCL HEX: 00004000 +CONSTANT: CLOCAL HEX: 00008000 +CONSTANT: CCTS_OFLOW HEX: 00010000 +CONSTANT: CRTS_IFLOW HEX: 00020000 +: CRTSCTS ( -- n ) { CCTS_OFLOW CRTS_IFLOW } flags ; inline +CONSTANT: CDTR_IFLOW HEX: 00040000 +CONSTANT: CDSR_OFLOW HEX: 00080000 +CONSTANT: CCAR_OFLOW HEX: 00100000 +CONSTANT: MDMBUF HEX: 00100000 ! lflags -: ECHOKE HEX: 00000001 ; inline -: ECHOE HEX: 00000002 ; inline -: ECHOK HEX: 00000004 ; inline -: ECHO HEX: 00000008 ; inline -: ECHONL HEX: 00000010 ; inline -: ECHOPRT HEX: 00000020 ; inline -: ECHOCTL HEX: 00000040 ; inline -: ISIG HEX: 00000080 ; inline -: ICANON HEX: 00000100 ; inline -: ALTWERASE HEX: 00000200 ; inline -: IEXTEN HEX: 00000400 ; inline -: EXTPROC HEX: 00000800 ; inline -: TOSTOP HEX: 00400000 ; inline -: FLUSHO HEX: 00800000 ; inline -: NOKERNINFO HEX: 02000000 ; inline -: PENDIN HEX: 20000000 ; inline -: NOFLSH HEX: 80000000 ; inline +CONSTANT: ECHOKE HEX: 00000001 +CONSTANT: ECHOE HEX: 00000002 +CONSTANT: ECHOK HEX: 00000004 +CONSTANT: ECHO HEX: 00000008 +CONSTANT: ECHONL HEX: 00000010 +CONSTANT: ECHOPRT HEX: 00000020 +CONSTANT: ECHOCTL HEX: 00000040 +CONSTANT: ISIG HEX: 00000080 +CONSTANT: ICANON HEX: 00000100 +CONSTANT: ALTWERASE HEX: 00000200 +CONSTANT: IEXTEN HEX: 00000400 +CONSTANT: EXTPROC HEX: 00000800 +CONSTANT: TOSTOP HEX: 00400000 +CONSTANT: FLUSHO HEX: 00800000 +CONSTANT: NOKERNINFO HEX: 02000000 +CONSTANT: PENDIN HEX: 20000000 +CONSTANT: NOFLSH HEX: 80000000 diff --git a/extra/serial/unix/linux/linux.factor b/extra/serial/unix/linux/linux.factor index 3ad5088fc8..9511ec45bf 100644 --- a/extra/serial/unix/linux/linux.factor +++ b/extra/serial/unix/linux/linux.factor @@ -3,96 +3,96 @@ USING: assocs alien.syntax kernel serial system unix ; IN: serial.unix -: TCSANOW 0 ; inline -: TCSADRAIN 1 ; inline -: TCSAFLUSH 2 ; inline +CONSTANT: TCSANOW 0 +CONSTANT: TCSADRAIN 1 +CONSTANT: TCSAFLUSH 2 -: TCIFLUSH 0 ; inline -: TCOFLUSH 1 ; inline -: TCIOFLUSH 2 ; inline +CONSTANT: TCIFLUSH 0 +CONSTANT: TCOFLUSH 1 +CONSTANT: TCIOFLUSH 2 -: TCOOFF 0 ; inline -: TCOON 1 ; inline -: TCIOFF 2 ; inline -: TCION 3 ; inline +CONSTANT: TCOOFF 0 +CONSTANT: TCOON 1 +CONSTANT: TCIOFF 2 +CONSTANT: TCION 3 ! iflag -: IGNBRK OCT: 0000001 ; inline -: BRKINT OCT: 0000002 ; inline -: IGNPAR OCT: 0000004 ; inline -: PARMRK OCT: 0000010 ; inline -: INPCK OCT: 0000020 ; inline -: ISTRIP OCT: 0000040 ; inline -: INLCR OCT: 0000100 ; inline -: IGNCR OCT: 0000200 ; inline -: ICRNL OCT: 0000400 ; inline -: IUCLC OCT: 0001000 ; inline -: IXON OCT: 0002000 ; inline -: IXANY OCT: 0004000 ; inline -: IXOFF OCT: 0010000 ; inline -: IMAXBEL OCT: 0020000 ; inline -: IUTF8 OCT: 0040000 ; inline +CONSTANT: IGNBRK OCT: 0000001 +CONSTANT: BRKINT OCT: 0000002 +CONSTANT: IGNPAR OCT: 0000004 +CONSTANT: PARMRK OCT: 0000010 +CONSTANT: INPCK OCT: 0000020 +CONSTANT: ISTRIP OCT: 0000040 +CONSTANT: INLCR OCT: 0000100 +CONSTANT: IGNCR OCT: 0000200 +CONSTANT: ICRNL OCT: 0000400 +CONSTANT: IUCLC OCT: 0001000 +CONSTANT: IXON OCT: 0002000 +CONSTANT: IXANY OCT: 0004000 +CONSTANT: IXOFF OCT: 0010000 +CONSTANT: IMAXBEL OCT: 0020000 +CONSTANT: IUTF8 OCT: 0040000 ! oflag -: OPOST OCT: 0000001 ; inline -: OLCUC OCT: 0000002 ; inline -: ONLCR OCT: 0000004 ; inline -: OCRNL OCT: 0000010 ; inline -: ONOCR OCT: 0000020 ; inline -: ONLRET OCT: 0000040 ; inline -: OFILL OCT: 0000100 ; inline -: OFDEL OCT: 0000200 ; inline -: NLDLY OCT: 0000400 ; inline -: NL0 OCT: 0000000 ; inline -: NL1 OCT: 0000400 ; inline -: CRDLY OCT: 0003000 ; inline -: CR0 OCT: 0000000 ; inline -: CR1 OCT: 0001000 ; inline -: CR2 OCT: 0002000 ; inline -: CR3 OCT: 0003000 ; inline -: TABDLY OCT: 0014000 ; inline -: TAB0 OCT: 0000000 ; inline -: TAB1 OCT: 0004000 ; inline -: TAB2 OCT: 0010000 ; inline -: TAB3 OCT: 0014000 ; inline -: BSDLY OCT: 0020000 ; inline -: BS0 OCT: 0000000 ; inline -: BS1 OCT: 0020000 ; inline -: FFDLY OCT: 0100000 ; inline -: FF0 OCT: 0000000 ; inline -: FF1 OCT: 0100000 ; inline +CONSTANT: OPOST OCT: 0000001 +CONSTANT: OLCUC OCT: 0000002 +CONSTANT: ONLCR OCT: 0000004 +CONSTANT: OCRNL OCT: 0000010 +CONSTANT: ONOCR OCT: 0000020 +CONSTANT: ONLRET OCT: 0000040 +CONSTANT: OFILL OCT: 0000100 +CONSTANT: OFDEL OCT: 0000200 +CONSTANT: NLDLY OCT: 0000400 +CONSTANT: NL0 OCT: 0000000 +CONSTANT: NL1 OCT: 0000400 +CONSTANT: CRDLY OCT: 0003000 +CONSTANT: CR0 OCT: 0000000 +CONSTANT: CR1 OCT: 0001000 +CONSTANT: CR2 OCT: 0002000 +CONSTANT: CR3 OCT: 0003000 +CONSTANT: TABDLY OCT: 0014000 +CONSTANT: TAB0 OCT: 0000000 +CONSTANT: TAB1 OCT: 0004000 +CONSTANT: TAB2 OCT: 0010000 +CONSTANT: TAB3 OCT: 0014000 +CONSTANT: BSDLY OCT: 0020000 +CONSTANT: BS0 OCT: 0000000 +CONSTANT: BS1 OCT: 0020000 +CONSTANT: FFDLY OCT: 0100000 +CONSTANT: FF0 OCT: 0000000 +CONSTANT: FF1 OCT: 0100000 ! cflags -: CSIZE OCT: 0000060 ; inline -: CS5 OCT: 0000000 ; inline -: CS6 OCT: 0000020 ; inline -: CS7 OCT: 0000040 ; inline -: CS8 OCT: 0000060 ; inline -: CSTOPB OCT: 0000100 ; inline -: CREAD OCT: 0000200 ; inline -: PARENB OCT: 0000400 ; inline -: PARODD OCT: 0001000 ; inline -: HUPCL OCT: 0002000 ; inline -: CLOCAL OCT: 0004000 ; inline -: CIBAUD OCT: 002003600000 ; inline -: CRTSCTS OCT: 020000000000 ; inline +CONSTANT: CSIZE OCT: 0000060 +CONSTANT: CS5 OCT: 0000000 +CONSTANT: CS6 OCT: 0000020 +CONSTANT: CS7 OCT: 0000040 +CONSTANT: CS8 OCT: 0000060 +CONSTANT: CSTOPB OCT: 0000100 +CONSTANT: CREAD OCT: 0000200 +CONSTANT: PARENB OCT: 0000400 +CONSTANT: PARODD OCT: 0001000 +CONSTANT: HUPCL OCT: 0002000 +CONSTANT: CLOCAL OCT: 0004000 +CONSTANT: CIBAUD OCT: 002003600000 +CONSTANT: CRTSCTS OCT: 020000000000 ! lflags -: ISIG OCT: 0000001 ; inline -: ICANON OCT: 0000002 ; inline -: XCASE OCT: 0000004 ; inline -: ECHO OCT: 0000010 ; inline -: ECHOE OCT: 0000020 ; inline -: ECHOK OCT: 0000040 ; inline -: ECHONL OCT: 0000100 ; inline -: NOFLSH OCT: 0000200 ; inline -: TOSTOP OCT: 0000400 ; inline -: ECHOCTL OCT: 0001000 ; inline -: ECHOPRT OCT: 0002000 ; inline -: ECHOKE OCT: 0004000 ; inline -: FLUSHO OCT: 0010000 ; inline -: PENDIN OCT: 0040000 ; inline -: IEXTEN OCT: 0100000 ; inline +CONSTANT: ISIG OCT: 0000001 +CONSTANT: ICANON OCT: 0000002 +CONSTANT: XCASE OCT: 0000004 +CONSTANT: ECHO OCT: 0000010 +CONSTANT: ECHOE OCT: 0000020 +CONSTANT: ECHOK OCT: 0000040 +CONSTANT: ECHONL OCT: 0000100 +CONSTANT: NOFLSH OCT: 0000200 +CONSTANT: TOSTOP OCT: 0000400 +CONSTANT: ECHOCTL OCT: 0001000 +CONSTANT: ECHOPRT OCT: 0002000 +CONSTANT: ECHOKE OCT: 0004000 +CONSTANT: FLUSHO OCT: 0010000 +CONSTANT: PENDIN OCT: 0040000 +CONSTANT: IEXTEN OCT: 0100000 M: linux lookup-baud ( n -- n ) dup H{ @@ -127,4 +127,4 @@ M: linux lookup-baud ( n -- n ) { 3000000 OCT: 0010015 } { 3500000 OCT: 0010016 } { 4000000 OCT: 0010017 } - } at* [ nip ] [ drop invalid-baud ] if ; + } ?at [ invalid-baud ] unless ; diff --git a/extra/serial/unix/termios/bsd/bsd.factor b/extra/serial/unix/termios/bsd/bsd.factor index 5fbc571519..87414089cc 100644 --- a/extra/serial/unix/termios/bsd/bsd.factor +++ b/extra/serial/unix/termios/bsd/bsd.factor @@ -3,7 +3,7 @@ USING: alien.syntax kernel sequences system ; IN: serial.unix.termios -: NCCS 20 ; inline +CONSTANT: NCCS 20 TYPEDEF: uint tcflag_t TYPEDEF: uchar cc_t diff --git a/extra/serial/unix/termios/linux/linux.factor b/extra/serial/unix/termios/linux/linux.factor index de9906e2b9..41df31db09 100644 --- a/extra/serial/unix/termios/linux/linux.factor +++ b/extra/serial/unix/termios/linux/linux.factor @@ -3,7 +3,7 @@ USING: alien.syntax kernel system unix ; IN: serial.unix.termios -: NCCS 32 ; inline +CONSTANT: NCCS 32 TYPEDEF: uchar cc_t TYPEDEF: uint speed_t diff --git a/extra/serial/unix/unix.factor b/extra/serial/unix/unix.factor index 90dbd185bd..ee320b0d2e 100644 --- a/extra/serial/unix/unix.factor +++ b/extra/serial/unix/unix.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types alien.syntax combinators io.ports -io.streams.duplex io.unix.backend system kernel math math.bitwise -vocabs.loader unix serial serial.unix.termios ; +io.streams.duplex system kernel math math.bitwise +vocabs.loader unix serial serial.unix.termios io.backend.unix ; IN: serial.unix << { From 378c8f90ffd3367c9ad608a76e06d12302357fab Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 17:50:29 -0600 Subject: [PATCH 087/119] move serial to io.serial --- extra/{ => io}/serial/authors.txt | 0 extra/{ => io}/serial/serial.factor | 11 +++++------ extra/{ => io}/serial/summary.txt | 0 extra/{ => io}/serial/tags.txt | 0 extra/{ => io}/serial/unix/bsd/bsd.factor | 4 ++-- extra/{ => io}/serial/unix/bsd/tags.txt | 0 extra/{ => io}/serial/unix/linux/linux.factor | 4 ++-- extra/{ => io}/serial/unix/linux/tags.txt | 0 extra/{ => io}/serial/unix/tags.txt | 0 extra/{ => io}/serial/unix/termios/bsd/bsd.factor | 2 +- extra/{ => io}/serial/unix/termios/bsd/tags.txt | 0 extra/{ => io}/serial/unix/termios/linux/linux.factor | 2 +- extra/{ => io}/serial/unix/termios/linux/tags.txt | 0 extra/{ => io}/serial/unix/termios/tags.txt | 0 extra/{ => io}/serial/unix/termios/termios.factor | 6 +++--- extra/{ => io}/serial/unix/unix-tests.factor | 4 ++-- extra/{ => io}/serial/unix/unix.factor | 8 ++++---- extra/{ => io}/serial/windows/authors.txt | 0 extra/{ => io}/serial/windows/tags.txt | 0 extra/{ => io}/serial/windows/windows.factor | 2 +- extra/serial/windows/windows-tests.factor | 4 ---- 21 files changed, 21 insertions(+), 26 deletions(-) rename extra/{ => io}/serial/authors.txt (100%) rename extra/{ => io}/serial/serial.factor (75%) rename extra/{ => io}/serial/summary.txt (100%) rename extra/{ => io}/serial/tags.txt (100%) rename extra/{ => io}/serial/unix/bsd/bsd.factor (96%) rename extra/{ => io}/serial/unix/bsd/tags.txt (100%) rename extra/{ => io}/serial/unix/linux/linux.factor (97%) rename extra/{ => io}/serial/unix/linux/tags.txt (100%) rename extra/{ => io}/serial/unix/tags.txt (100%) rename extra/{ => io}/serial/unix/termios/bsd/bsd.factor (95%) rename extra/{ => io}/serial/unix/termios/bsd/tags.txt (100%) rename extra/{ => io}/serial/unix/termios/linux/linux.factor (96%) rename extra/{ => io}/serial/unix/termios/linux/tags.txt (100%) rename extra/{ => io}/serial/unix/termios/tags.txt (100%) rename extra/{ => io}/serial/unix/termios/termios.factor (52%) rename extra/{ => io}/serial/unix/unix-tests.factor (84%) rename extra/{ => io}/serial/unix/unix.factor (91%) rename extra/{ => io}/serial/windows/authors.txt (100%) rename extra/{ => io}/serial/windows/tags.txt (100%) rename extra/{ => io}/serial/windows/windows.factor (96%) delete mode 100755 extra/serial/windows/windows-tests.factor diff --git a/extra/serial/authors.txt b/extra/io/serial/authors.txt similarity index 100% rename from extra/serial/authors.txt rename to extra/io/serial/authors.txt diff --git a/extra/serial/serial.factor b/extra/io/serial/serial.factor similarity index 75% rename from extra/serial/serial.factor rename to extra/io/serial/serial.factor index 96900fb6e4..f7324acd05 100644 --- a/extra/serial/serial.factor +++ b/extra/io/serial/serial.factor @@ -3,22 +3,21 @@ USING: accessors alien.c-types assocs combinators destructors kernel math math.bitwise math.parser sequences summary system vocabs.loader ; -IN: serial +IN: io.serial TUPLE: serial stream path baud termios iflag oflag cflag lflag ; ERROR: invalid-baud baud ; M: invalid-baud summary ( invalid-baud -- string ) - "Baud rate " - swap baud>> number>string - " not supported" 3append ; + baud>> number>string + "Baud rate " " not supported" surround ; HOOK: lookup-baud os ( m -- n ) HOOK: open-serial os ( serial -- serial' ) M: serial dispose ( serial -- ) stream>> dispose ; { - { [ os unix? ] [ "serial.unix" ] } - { [ os windows? ] [ "serial.windows" ] } + { [ os unix? ] [ "io.serial.unix" ] } + { [ os windows? ] [ "io.serial.windows" ] } } cond require diff --git a/extra/serial/summary.txt b/extra/io/serial/summary.txt similarity index 100% rename from extra/serial/summary.txt rename to extra/io/serial/summary.txt diff --git a/extra/serial/tags.txt b/extra/io/serial/tags.txt similarity index 100% rename from extra/serial/tags.txt rename to extra/io/serial/tags.txt diff --git a/extra/serial/unix/bsd/bsd.factor b/extra/io/serial/unix/bsd/bsd.factor similarity index 96% rename from extra/serial/unix/bsd/bsd.factor rename to extra/io/serial/unix/bsd/bsd.factor index 22886ecb15..dbb013aca0 100644 --- a/extra/serial/unix/bsd/bsd.factor +++ b/extra/io/serial/unix/bsd/bsd.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax kernel math.bitwise sequences system serial ; -IN: serial.unix +USING: alien.syntax kernel math.bitwise sequences system io.serial ; +IN: io.serial.unix M: bsd lookup-baud ( m -- n ) dup { diff --git a/extra/serial/unix/bsd/tags.txt b/extra/io/serial/unix/bsd/tags.txt similarity index 100% rename from extra/serial/unix/bsd/tags.txt rename to extra/io/serial/unix/bsd/tags.txt diff --git a/extra/serial/unix/linux/linux.factor b/extra/io/serial/unix/linux/linux.factor similarity index 97% rename from extra/serial/unix/linux/linux.factor rename to extra/io/serial/unix/linux/linux.factor index 9511ec45bf..4d1878d2a9 100644 --- a/extra/serial/unix/linux/linux.factor +++ b/extra/io/serial/unix/linux/linux.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs alien.syntax kernel serial system unix ; -IN: serial.unix +USING: assocs alien.syntax kernel io.serial system unix ; +IN: io.serial.unix CONSTANT: TCSANOW 0 CONSTANT: TCSADRAIN 1 diff --git a/extra/serial/unix/linux/tags.txt b/extra/io/serial/unix/linux/tags.txt similarity index 100% rename from extra/serial/unix/linux/tags.txt rename to extra/io/serial/unix/linux/tags.txt diff --git a/extra/serial/unix/tags.txt b/extra/io/serial/unix/tags.txt similarity index 100% rename from extra/serial/unix/tags.txt rename to extra/io/serial/unix/tags.txt diff --git a/extra/serial/unix/termios/bsd/bsd.factor b/extra/io/serial/unix/termios/bsd/bsd.factor similarity index 95% rename from extra/serial/unix/termios/bsd/bsd.factor rename to extra/io/serial/unix/termios/bsd/bsd.factor index 87414089cc..63d0157780 100644 --- a/extra/serial/unix/termios/bsd/bsd.factor +++ b/extra/io/serial/unix/termios/bsd/bsd.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien.syntax kernel sequences system ; -IN: serial.unix.termios +IN: io.serial.unix.termios CONSTANT: NCCS 20 diff --git a/extra/serial/unix/termios/bsd/tags.txt b/extra/io/serial/unix/termios/bsd/tags.txt similarity index 100% rename from extra/serial/unix/termios/bsd/tags.txt rename to extra/io/serial/unix/termios/bsd/tags.txt diff --git a/extra/serial/unix/termios/linux/linux.factor b/extra/io/serial/unix/termios/linux/linux.factor similarity index 96% rename from extra/serial/unix/termios/linux/linux.factor rename to extra/io/serial/unix/termios/linux/linux.factor index 41df31db09..4b8c52c7fb 100644 --- a/extra/serial/unix/termios/linux/linux.factor +++ b/extra/io/serial/unix/termios/linux/linux.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien.syntax kernel system unix ; -IN: serial.unix.termios +IN: io.serial.unix.termios CONSTANT: NCCS 32 diff --git a/extra/serial/unix/termios/linux/tags.txt b/extra/io/serial/unix/termios/linux/tags.txt similarity index 100% rename from extra/serial/unix/termios/linux/tags.txt rename to extra/io/serial/unix/termios/linux/tags.txt diff --git a/extra/serial/unix/termios/tags.txt b/extra/io/serial/unix/termios/tags.txt similarity index 100% rename from extra/serial/unix/termios/tags.txt rename to extra/io/serial/unix/termios/tags.txt diff --git a/extra/serial/unix/termios/termios.factor b/extra/io/serial/unix/termios/termios.factor similarity index 52% rename from extra/serial/unix/termios/termios.factor rename to extra/io/serial/unix/termios/termios.factor index 901416d62c..e5ccd37e87 100644 --- a/extra/serial/unix/termios/termios.factor +++ b/extra/io/serial/unix/termios/termios.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: combinators system vocabs.loader ; -IN: serial.unix.termios +IN: io.serial.unix.termios { - { [ os linux? ] [ "serial.unix.termios.linux" ] } - { [ os bsd? ] [ "serial.unix.termios.bsd" ] } + { [ os linux? ] [ "io.serial.unix.termios.linux" ] } + { [ os bsd? ] [ "io.serial.unix.termios.bsd" ] } } cond require diff --git a/extra/serial/unix/unix-tests.factor b/extra/io/serial/unix/unix-tests.factor similarity index 84% rename from extra/serial/unix/unix-tests.factor rename to extra/io/serial/unix/unix-tests.factor index e9126a5961..e9b8d78e4b 100644 --- a/extra/serial/unix/unix-tests.factor +++ b/extra/io/serial/unix/unix-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel math.bitwise serial serial.unix ; -IN: serial.unix +USING: accessors kernel math.bitwise io.serial io.serial.unix ; +IN: io.serial.unix : serial-obj ( -- obj ) serial new diff --git a/extra/serial/unix/unix.factor b/extra/io/serial/unix/unix.factor similarity index 91% rename from extra/serial/unix/unix.factor rename to extra/io/serial/unix/unix.factor index ee320b0d2e..1ba8031dfc 100644 --- a/extra/serial/unix/unix.factor +++ b/extra/io/serial/unix/unix.factor @@ -2,12 +2,12 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types alien.syntax combinators io.ports io.streams.duplex system kernel math math.bitwise -vocabs.loader unix serial serial.unix.termios io.backend.unix ; -IN: serial.unix +vocabs.loader unix io.serial io.serial.unix.termios io.backend.unix ; +IN: io.serial.unix << { - { [ os linux? ] [ "serial.unix.linux" ] } - { [ os bsd? ] [ "serial.unix.bsd" ] } + { [ os linux? ] [ "io.serial.unix.linux" ] } + { [ os bsd? ] [ "io.serial.unix.bsd" ] } } cond require >> FUNCTION: speed_t cfgetispeed ( termios* t ) ; diff --git a/extra/serial/windows/authors.txt b/extra/io/serial/windows/authors.txt similarity index 100% rename from extra/serial/windows/authors.txt rename to extra/io/serial/windows/authors.txt diff --git a/extra/serial/windows/tags.txt b/extra/io/serial/windows/tags.txt similarity index 100% rename from extra/serial/windows/tags.txt rename to extra/io/serial/windows/tags.txt diff --git a/extra/serial/windows/windows.factor b/extra/io/serial/windows/windows.factor similarity index 96% rename from extra/serial/windows/windows.factor rename to extra/io/serial/windows/windows.factor index a80366cb9f..2d27a489ef 100755 --- a/extra/serial/windows/windows.factor +++ b/extra/io/serial/windows/windows.factor @@ -3,7 +3,7 @@ USING: io.files.windows io.streams.duplex kernel math math.bitwise windows.kernel32 accessors alien.c-types windows io.files.windows fry locals continuations ; -IN: serial.windows +IN: io.serial.windows : ( path encoding -- duplex ) [ open-r/w dup ] dip ; diff --git a/extra/serial/windows/windows-tests.factor b/extra/serial/windows/windows-tests.factor deleted file mode 100755 index bd67f77eae..0000000000 --- a/extra/serial/windows/windows-tests.factor +++ /dev/null @@ -1,4 +0,0 @@ -! Copyright (C) 2009 Your name. -! See http://factorcode.org/license.txt for BSD license. -USING: tools.test serial.windows ; -IN: serial.windows.tests From 59b7b95063ca00a2ba999e0ea81ea1f6500c36d8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 17:50:56 -0600 Subject: [PATCH 088/119] remove empty tests file --- extra/fuel/fuel-tests.factor | 4 ---- 1 file changed, 4 deletions(-) delete mode 100644 extra/fuel/fuel-tests.factor diff --git a/extra/fuel/fuel-tests.factor b/extra/fuel/fuel-tests.factor deleted file mode 100644 index 74bc5d4d45..0000000000 --- a/extra/fuel/fuel-tests.factor +++ /dev/null @@ -1,4 +0,0 @@ -! Copyright (C) 2008 Your name. -! See http://factorcode.org/license.txt for BSD license. -USING: tools.test fuel ; -IN: fuel.tests From 4b3f646cc0092bbe040c2756cbd414fc92ce71b8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 17:51:43 -0600 Subject: [PATCH 089/119] Your name -> his name --- extra/adsoda/combinators/combinators-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/adsoda/combinators/combinators-docs.factor b/extra/adsoda/combinators/combinators-docs.factor index 0121dce32b..5b540e7a7f 100755 --- a/extra/adsoda/combinators/combinators-docs.factor +++ b/extra/adsoda/combinators/combinators-docs.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008 Your name. +! Copyright (C) 2008 Jeff Bigot. ! See http://factorcode.org/license.txt for BSD license. USING: arrays help.markup help.syntax kernel sequences ; IN: adsoda.combinators From f7165e115e03a50b0c5e107759eb7133fb644e52 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 17:52:04 -0600 Subject: [PATCH 090/119] remove extra ?at definition --- extra/infix/infix.factor | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/extra/infix/infix.factor b/extra/infix/infix.factor index 3e2ba49e3c..d39c0b3c2d 100644 --- a/extra/infix/infix.factor +++ b/extra/infix/infix.factor @@ -14,11 +14,8 @@ ERROR: local-not-defined name ; M: local-not-defined summary drop "local is not defined" ; -: at? ( key assoc -- value/key ? ) - dupd at* [ nip t ] [ drop f ] if ; - : >local-word ( string -- word ) - locals get at? [ local-not-defined ] unless ; + locals get ?at [ local-not-defined ] unless ; : select-op ( string -- word ) { From 917296670df442e5c7a864fa7bf1770271393904 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 17:52:27 -0600 Subject: [PATCH 091/119] use CONSTANT: --- extra/iokit/hid/hid.factor | 188 ++++++++++++++++++------------------- 1 file changed, 94 insertions(+), 94 deletions(-) diff --git a/extra/iokit/hid/hid.factor b/extra/iokit/hid/hid.factor index 465c55c833..cd9eea1409 100644 --- a/extra/iokit/hid/hid.factor +++ b/extra/iokit/hid/hid.factor @@ -2,117 +2,117 @@ USING: iokit alien alien.syntax alien.c-types kernel system core-foundation ; IN: iokit.hid -: kIOHIDDeviceKey "IOHIDDevice" ; inline +CONSTANT: kIOHIDDeviceKey "IOHIDDevice" -: kIOHIDTransportKey "Transport" ; inline -: kIOHIDVendorIDKey "VendorID" ; inline -: kIOHIDVendorIDSourceKey "VendorIDSource" ; inline -: kIOHIDProductIDKey "ProductID" ; inline -: kIOHIDVersionNumberKey "VersionNumber" ; inline -: kIOHIDManufacturerKey "Manufacturer" ; inline -: kIOHIDProductKey "Product" ; inline -: kIOHIDSerialNumberKey "SerialNumber" ; inline -: kIOHIDCountryCodeKey "CountryCode" ; inline -: kIOHIDLocationIDKey "LocationID" ; inline -: kIOHIDDeviceUsageKey "DeviceUsage" ; inline -: kIOHIDDeviceUsagePageKey "DeviceUsagePage" ; inline -: kIOHIDDeviceUsagePairsKey "DeviceUsagePairs" ; inline -: kIOHIDPrimaryUsageKey "PrimaryUsage" ; inline -: kIOHIDPrimaryUsagePageKey "PrimaryUsagePage" ; inline -: kIOHIDMaxInputReportSizeKey "MaxInputReportSize" ; inline -: kIOHIDMaxOutputReportSizeKey "MaxOutputReportSize" ; inline -: kIOHIDMaxFeatureReportSizeKey "MaxFeatureReportSize" ; inline -: kIOHIDReportIntervalKey "ReportInterval" ; inline +CONSTANT: kIOHIDTransportKey "Transport" +CONSTANT: kIOHIDVendorIDKey "VendorID" +CONSTANT: kIOHIDVendorIDSourceKey "VendorIDSource" +CONSTANT: kIOHIDProductIDKey "ProductID" +CONSTANT: kIOHIDVersionNumberKey "VersionNumber" +CONSTANT: kIOHIDManufacturerKey "Manufacturer" +CONSTANT: kIOHIDProductKey "Product" +CONSTANT: kIOHIDSerialNumberKey "SerialNumber" +CONSTANT: kIOHIDCountryCodeKey "CountryCode" +CONSTANT: kIOHIDLocationIDKey "LocationID" +CONSTANT: kIOHIDDeviceUsageKey "DeviceUsage" +CONSTANT: kIOHIDDeviceUsagePageKey "DeviceUsagePage" +CONSTANT: kIOHIDDeviceUsagePairsKey "DeviceUsagePairs" +CONSTANT: kIOHIDPrimaryUsageKey "PrimaryUsage" +CONSTANT: kIOHIDPrimaryUsagePageKey "PrimaryUsagePage" +CONSTANT: kIOHIDMaxInputReportSizeKey "MaxInputReportSize" +CONSTANT: kIOHIDMaxOutputReportSizeKey "MaxOutputReportSize" +CONSTANT: kIOHIDMaxFeatureReportSizeKey "MaxFeatureReportSize" +CONSTANT: kIOHIDReportIntervalKey "ReportInterval" -: kIOHIDElementKey "Elements" ; inline +CONSTANT: kIOHIDElementKey "Elements" -: kIOHIDElementCookieKey "ElementCookie" ; inline -: kIOHIDElementTypeKey "Type" ; inline -: kIOHIDElementCollectionTypeKey "CollectionType" ; inline -: kIOHIDElementUsageKey "Usage" ; inline -: kIOHIDElementUsagePageKey "UsagePage" ; inline -: kIOHIDElementMinKey "Min" ; inline -: kIOHIDElementMaxKey "Max" ; inline -: kIOHIDElementScaledMinKey "ScaledMin" ; inline -: kIOHIDElementScaledMaxKey "ScaledMax" ; inline -: kIOHIDElementSizeKey "Size" ; inline -: kIOHIDElementReportSizeKey "ReportSize" ; inline -: kIOHIDElementReportCountKey "ReportCount" ; inline -: kIOHIDElementReportIDKey "ReportID" ; inline -: kIOHIDElementIsArrayKey "IsArray" ; inline -: kIOHIDElementIsRelativeKey "IsRelative" ; inline -: kIOHIDElementIsWrappingKey "IsWrapping" ; inline -: kIOHIDElementIsNonLinearKey "IsNonLinear" ; inline -: kIOHIDElementHasPreferredStateKey "HasPreferredState" ; inline -: kIOHIDElementHasNullStateKey "HasNullState" ; inline -: kIOHIDElementFlagsKey "Flags" ; inline -: kIOHIDElementUnitKey "Unit" ; inline -: kIOHIDElementUnitExponentKey "UnitExponent" ; inline -: kIOHIDElementNameKey "Name" ; inline -: kIOHIDElementValueLocationKey "ValueLocation" ; inline -: kIOHIDElementDuplicateIndexKey "DuplicateIndex" ; inline -: kIOHIDElementParentCollectionKey "ParentCollection" ; inline +CONSTANT: kIOHIDElementCookieKey "ElementCookie" +CONSTANT: kIOHIDElementTypeKey "Type" +CONSTANT: kIOHIDElementCollectionTypeKey "CollectionType" +CONSTANT: kIOHIDElementUsageKey "Usage" +CONSTANT: kIOHIDElementUsagePageKey "UsagePage" +CONSTANT: kIOHIDElementMinKey "Min" +CONSTANT: kIOHIDElementMaxKey "Max" +CONSTANT: kIOHIDElementScaledMinKey "ScaledMin" +CONSTANT: kIOHIDElementScaledMaxKey "ScaledMax" +CONSTANT: kIOHIDElementSizeKey "Size" +CONSTANT: kIOHIDElementReportSizeKey "ReportSize" +CONSTANT: kIOHIDElementReportCountKey "ReportCount" +CONSTANT: kIOHIDElementReportIDKey "ReportID" +CONSTANT: kIOHIDElementIsArrayKey "IsArray" +CONSTANT: kIOHIDElementIsRelativeKey "IsRelative" +CONSTANT: kIOHIDElementIsWrappingKey "IsWrapping" +CONSTANT: kIOHIDElementIsNonLinearKey "IsNonLinear" +CONSTANT: kIOHIDElementHasPreferredStateKey "HasPreferredState" +CONSTANT: kIOHIDElementHasNullStateKey "HasNullState" +CONSTANT: kIOHIDElementFlagsKey "Flags" +CONSTANT: kIOHIDElementUnitKey "Unit" +CONSTANT: kIOHIDElementUnitExponentKey "UnitExponent" +CONSTANT: kIOHIDElementNameKey "Name" +CONSTANT: kIOHIDElementValueLocationKey "ValueLocation" +CONSTANT: kIOHIDElementDuplicateIndexKey "DuplicateIndex" +CONSTANT: kIOHIDElementParentCollectionKey "ParentCollection" : kIOHIDElementVendorSpecificKey ( -- str ) cpu ppc? "VendorSpecifc" "VendorSpecific" ? ; inline -: kIOHIDElementCookieMinKey "ElementCookieMin" ; inline -: kIOHIDElementCookieMaxKey "ElementCookieMax" ; inline -: kIOHIDElementUsageMinKey "UsageMin" ; inline -: kIOHIDElementUsageMaxKey "UsageMax" ; inline +CONSTANT: kIOHIDElementCookieMinKey "ElementCookieMin" +CONSTANT: kIOHIDElementCookieMaxKey "ElementCookieMax" +CONSTANT: kIOHIDElementUsageMinKey "UsageMin" +CONSTANT: kIOHIDElementUsageMaxKey "UsageMax" -: kIOHIDElementCalibrationMinKey "CalibrationMin" ; inline -: kIOHIDElementCalibrationMaxKey "CalibrationMax" ; inline -: kIOHIDElementCalibrationSaturationMinKey "CalibrationSaturationMin" ; inline -: kIOHIDElementCalibrationSaturationMaxKey "CalibrationSaturationMax" ; inline -: kIOHIDElementCalibrationDeadZoneMinKey "CalibrationDeadZoneMin" ; inline -: kIOHIDElementCalibrationDeadZoneMaxKey "CalibrationDeadZoneMax" ; inline -: kIOHIDElementCalibrationGranularityKey "CalibrationGranularity" ; inline +CONSTANT: kIOHIDElementCalibrationMinKey "CalibrationMin" +CONSTANT: kIOHIDElementCalibrationMaxKey "CalibrationMax" +CONSTANT: kIOHIDElementCalibrationSaturationMinKey "CalibrationSaturationMin" +CONSTANT: kIOHIDElementCalibrationSaturationMaxKey "CalibrationSaturationMax" +CONSTANT: kIOHIDElementCalibrationDeadZoneMinKey "CalibrationDeadZoneMin" +CONSTANT: kIOHIDElementCalibrationDeadZoneMaxKey "CalibrationDeadZoneMax" +CONSTANT: kIOHIDElementCalibrationGranularityKey "CalibrationGranularity" -: kIOHIDElementTypeInput_Misc 1 ; inline -: kIOHIDElementTypeInput_Button 2 ; inline -: kIOHIDElementTypeInput_Axis 3 ; inline -: kIOHIDElementTypeInput_ScanCodes 4 ; inline -: kIOHIDElementTypeOutput 129 ; inline -: kIOHIDElementTypeFeature 257 ; inline -: kIOHIDElementTypeCollection 513 ; inline +CONSTANT: kIOHIDElementTypeInput_Misc 1 +CONSTANT: kIOHIDElementTypeInput_Button 2 +CONSTANT: kIOHIDElementTypeInput_Axis 3 +CONSTANT: kIOHIDElementTypeInput_ScanCodes 4 +CONSTANT: kIOHIDElementTypeOutput 129 +CONSTANT: kIOHIDElementTypeFeature 257 +CONSTANT: kIOHIDElementTypeCollection 513 -: kIOHIDElementCollectionTypePhysical HEX: 00 ; inline -: kIOHIDElementCollectionTypeApplication HEX: 01 ; inline -: kIOHIDElementCollectionTypeLogical HEX: 02 ; inline -: kIOHIDElementCollectionTypeReport HEX: 03 ; inline -: kIOHIDElementCollectionTypeNamedArray HEX: 04 ; inline -: kIOHIDElementCollectionTypeUsageSwitch HEX: 05 ; inline -: kIOHIDElementCollectionTypeUsageModifier HEX: 06 ; inline +CONSTANT: kIOHIDElementCollectionTypePhysical HEX: 00 +CONSTANT: kIOHIDElementCollectionTypeApplication HEX: 01 +CONSTANT: kIOHIDElementCollectionTypeLogical HEX: 02 +CONSTANT: kIOHIDElementCollectionTypeReport HEX: 03 +CONSTANT: kIOHIDElementCollectionTypeNamedArray HEX: 04 +CONSTANT: kIOHIDElementCollectionTypeUsageSwitch HEX: 05 +CONSTANT: kIOHIDElementCollectionTypeUsageModifier HEX: 06 -: kIOHIDReportTypeInput 0 ; inline -: kIOHIDReportTypeOutput 1 ; inline -: kIOHIDReportTypeFeature 2 ; inline -: kIOHIDReportTypeCount 3 ; inline +CONSTANT: kIOHIDReportTypeInput 0 +CONSTANT: kIOHIDReportTypeOutput 1 +CONSTANT: kIOHIDReportTypeFeature 2 +CONSTANT: kIOHIDReportTypeCount 3 -: kIOHIDOptionsTypeNone HEX: 00 ; inline -: kIOHIDOptionsTypeSeizeDevice HEX: 01 ; inline +CONSTANT: kIOHIDOptionsTypeNone HEX: 00 +CONSTANT: kIOHIDOptionsTypeSeizeDevice HEX: 01 -: kIOHIDQueueOptionsTypeNone HEX: 00 ; inline -: kIOHIDQueueOptionsTypeEnqueueAll HEX: 01 ; inline +CONSTANT: kIOHIDQueueOptionsTypeNone HEX: 00 +CONSTANT: kIOHIDQueueOptionsTypeEnqueueAll HEX: 01 -: kIOHIDElementFlagsConstantMask HEX: 0001 ; inline -: kIOHIDElementFlagsVariableMask HEX: 0002 ; inline -: kIOHIDElementFlagsRelativeMask HEX: 0004 ; inline -: kIOHIDElementFlagsWrapMask HEX: 0008 ; inline -: kIOHIDElementFlagsNonLinearMask HEX: 0010 ; inline -: kIOHIDElementFlagsNoPreferredMask HEX: 0020 ; inline -: kIOHIDElementFlagsNullStateMask HEX: 0040 ; inline -: kIOHIDElementFlagsVolativeMask HEX: 0080 ; inline -: kIOHIDElementFlagsBufferedByteMask HEX: 0100 ; inline +CONSTANT: kIOHIDElementFlagsConstantMask HEX: 0001 +CONSTANT: kIOHIDElementFlagsVariableMask HEX: 0002 +CONSTANT: kIOHIDElementFlagsRelativeMask HEX: 0004 +CONSTANT: kIOHIDElementFlagsWrapMask HEX: 0008 +CONSTANT: kIOHIDElementFlagsNonLinearMask HEX: 0010 +CONSTANT: kIOHIDElementFlagsNoPreferredMask HEX: 0020 +CONSTANT: kIOHIDElementFlagsNullStateMask HEX: 0040 +CONSTANT: kIOHIDElementFlagsVolativeMask HEX: 0080 +CONSTANT: kIOHIDElementFlagsBufferedByteMask HEX: 0100 -: kIOHIDValueScaleTypeCalibrated 0 ; inline -: kIOHIDValueScaleTypePhysical 1 ; inline +CONSTANT: kIOHIDValueScaleTypeCalibrated 0 +CONSTANT: kIOHIDValueScaleTypePhysical 1 -: kIOHIDTransactionDirectionTypeInput 0 ; inline -: kIOHIDTransactionDirectionTypeOutput 1 ; inline +CONSTANT: kIOHIDTransactionDirectionTypeInput 0 +CONSTANT: kIOHIDTransactionDirectionTypeOutput 1 -: kIOHIDTransactionOptionDefaultOutputValue 1 ; inline +CONSTANT: kIOHIDTransactionOptionDefaultOutputValue 1 TYPEDEF: ptrdiff_t IOHIDElementCookie TYPEDEF: int IOHIDElementType From 8b0b5878d23f2f95d38199ea69f63916fdef48ab Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 17:52:59 -0600 Subject: [PATCH 092/119] at* -> ?at in a couple places --- basis/help/topics/topics.factor | 2 +- basis/unix/groups/groups.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/help/topics/topics.factor b/basis/help/topics/topics.factor index 8c687eb1d5..9fba09913d 100644 --- a/basis/help/topics/topics.factor +++ b/basis/help/topics/topics.factor @@ -54,7 +54,7 @@ M: no-article summary drop "Help article does not exist" ; : article ( name -- article ) - dup articles get at* [ nip ] [ drop no-article ] if ; + articles get ?at [ no-article ] unless ; M: object article-name article article-name ; M: object article-title article article-title ; diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor index f4d91df245..b2a50b7374 100644 --- a/basis/unix/groups/groups.factor +++ b/basis/unix/groups/groups.factor @@ -46,7 +46,7 @@ PRIVATE> : group-name ( id -- string ) dup group-cache get [ - dupd at* [ name>> nip ] [ drop number>string ] if + ?at [ name>> ] [ number>string ] if ] [ group-struct [ group-gr_name ] [ f ] if* ] if* From 6282b552c1eeb3998ab880aa68a590c75f0f1b19 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 17:56:12 -0600 Subject: [PATCH 093/119] use CONSTANT: --- extra/iokit/iokit.factor | 134 +++++++++++++++++++-------------------- 1 file changed, 67 insertions(+), 67 deletions(-) diff --git a/extra/iokit/iokit.factor b/extra/iokit/iokit.factor index 2317d21ed5..3fb14e8ec5 100755 --- a/extra/iokit/iokit.factor +++ b/extra/iokit/iokit.factor @@ -9,95 +9,95 @@ IN: iokit when >> -: kIOKitBuildVersionKey "IOKitBuildVersion" ; inline -: kIOKitDiagnosticsKey "IOKitDiagnostics" ; inline +CONSTANT: kIOKitBuildVersionKey "IOKitBuildVersion" +CONSTANT: kIOKitDiagnosticsKey "IOKitDiagnostics" -: kIORegistryPlanesKey "IORegistryPlanes" ; inline -: kIOCatalogueKey "IOCatalogue" ; inline +CONSTANT: kIORegistryPlanesKey "IORegistryPlanes" +CONSTANT: kIOCatalogueKey "IOCatalogue" -: kIOServicePlane "IOService" ; inline -: kIOPowerPlane "IOPower" ; inline -: kIODeviceTreePlane "IODeviceTree" ; inline -: kIOAudioPlane "IOAudio" ; inline -: kIOFireWirePlane "IOFireWire" ; inline -: kIOUSBPlane "IOUSB" ; inline +CONSTANT: kIOServicePlane "IOService" +CONSTANT: kIOPowerPlane "IOPower" +CONSTANT: kIODeviceTreePlane "IODeviceTree" +CONSTANT: kIOAudioPlane "IOAudio" +CONSTANT: kIOFireWirePlane "IOFireWire" +CONSTANT: kIOUSBPlane "IOUSB" -: kIOServiceClass "IOService" ; inline +CONSTANT: kIOServiceClass "IOService" -: kIOResourcesClass "IOResources" ; inline +CONSTANT: kIOResourcesClass "IOResources" -: kIOClassKey "IOClass" ; inline -: kIOProbeScoreKey "IOProbeScore" ; inline -: kIOKitDebugKey "IOKitDebug" ; inline +CONSTANT: kIOClassKey "IOClass" +CONSTANT: kIOProbeScoreKey "IOProbeScore" +CONSTANT: kIOKitDebugKey "IOKitDebug" -: kIOProviderClassKey "IOProviderClass" ; inline -: kIONameMatchKey "IONameMatch" ; inline -: kIOPropertyMatchKey "IOPropertyMatch" ; inline -: kIOPathMatchKey "IOPathMatch" ; inline -: kIOLocationMatchKey "IOLocationMatch" ; inline -: kIOParentMatchKey "IOParentMatch" ; inline -: kIOResourceMatchKey "IOResourceMatch" ; inline -: kIOMatchedServiceCountKey "IOMatchedServiceCountMatch" ; inline +CONSTANT: kIOProviderClassKey "IOProviderClass" +CONSTANT: kIONameMatchKey "IONameMatch" +CONSTANT: kIOPropertyMatchKey "IOPropertyMatch" +CONSTANT: kIOPathMatchKey "IOPathMatch" +CONSTANT: kIOLocationMatchKey "IOLocationMatch" +CONSTANT: kIOParentMatchKey "IOParentMatch" +CONSTANT: kIOResourceMatchKey "IOResourceMatch" +CONSTANT: kIOMatchedServiceCountKey "IOMatchedServiceCountMatch" -: kIONameMatchedKey "IONameMatched" ; inline +CONSTANT: kIONameMatchedKey "IONameMatched" -: kIOMatchCategoryKey "IOMatchCategory" ; inline -: kIODefaultMatchCategoryKey "IODefaultMatchCategory" ; inline +CONSTANT: kIOMatchCategoryKey "IOMatchCategory" +CONSTANT: kIODefaultMatchCategoryKey "IODefaultMatchCategory" -: kIOUserClientClassKey "IOUserClientClass" ; inline +CONSTANT: kIOUserClientClassKey "IOUserClientClass" -: kIOUserClientCrossEndianKey "IOUserClientCrossEndian" ; inline -: kIOUserClientCrossEndianCompatibleKey "IOUserClientCrossEndianCompatible" ; inline -: kIOUserClientSharedInstanceKey "IOUserClientSharedInstance" ; inline +CONSTANT: kIOUserClientCrossEndianKey "IOUserClientCrossEndian" +CONSTANT: kIOUserClientCrossEndianCompatibleKey "IOUserClientCrossEndianCompatible" +CONSTANT: kIOUserClientSharedInstanceKey "IOUserClientSharedInstance" -: kIOPublishNotification "IOServicePublish" ; inline -: kIOFirstPublishNotification "IOServiceFirstPublish" ; inline -: kIOMatchedNotification "IOServiceMatched" ; inline -: kIOFirstMatchNotification "IOServiceFirstMatch" ; inline -: kIOTerminatedNotification "IOServiceTerminate" ; inline +CONSTANT: kIOPublishNotification "IOServicePublish" +CONSTANT: kIOFirstPublishNotification "IOServiceFirstPublish" +CONSTANT: kIOMatchedNotification "IOServiceMatched" +CONSTANT: kIOFirstMatchNotification "IOServiceFirstMatch" +CONSTANT: kIOTerminatedNotification "IOServiceTerminate" -: kIOGeneralInterest "IOGeneralInterest" ; inline -: kIOBusyInterest "IOBusyInterest" ; inline -: kIOAppPowerStateInterest "IOAppPowerStateInterest" ; inline -: kIOPriorityPowerStateInterest "IOPriorityPowerStateInterest" ; inline +CONSTANT: kIOGeneralInterest "IOGeneralInterest" +CONSTANT: kIOBusyInterest "IOBusyInterest" +CONSTANT: kIOAppPowerStateInterest "IOAppPowerStateInterest" +CONSTANT: kIOPriorityPowerStateInterest "IOPriorityPowerStateInterest" -: kIOPlatformDeviceMessageKey "IOPlatformDeviceMessage" ; inline +CONSTANT: kIOPlatformDeviceMessageKey "IOPlatformDeviceMessage" -: kIOCFPlugInTypesKey "IOCFPlugInTypes" ; inline +CONSTANT: kIOCFPlugInTypesKey "IOCFPlugInTypes" -: kIOCommandPoolSizeKey "IOCommandPoolSize" ; inline +CONSTANT: kIOCommandPoolSizeKey "IOCommandPoolSize" -: kIOMaximumBlockCountReadKey "IOMaximumBlockCountRead" ; inline -: kIOMaximumBlockCountWriteKey "IOMaximumBlockCountWrite" ; inline -: kIOMaximumByteCountReadKey "IOMaximumByteCountRead" ; inline -: kIOMaximumByteCountWriteKey "IOMaximumByteCountWrite" ; inline -: kIOMaximumSegmentCountReadKey "IOMaximumSegmentCountRead" ; inline -: kIOMaximumSegmentCountWriteKey "IOMaximumSegmentCountWrite" ; inline -: kIOMaximumSegmentByteCountReadKey "IOMaximumSegmentByteCountRead" ; inline -: kIOMaximumSegmentByteCountWriteKey "IOMaximumSegmentByteCountWrite" ; inline -: kIOMinimumSegmentAlignmentByteCountKey "IOMinimumSegmentAlignmentByteCount" ; inline -: kIOMaximumSegmentAddressableBitCountKey "IOMaximumSegmentAddressableBitCount" ; inline +CONSTANT: kIOMaximumBlockCountReadKey "IOMaximumBlockCountRead" +CONSTANT: kIOMaximumBlockCountWriteKey "IOMaximumBlockCountWrite" +CONSTANT: kIOMaximumByteCountReadKey "IOMaximumByteCountRead" +CONSTANT: kIOMaximumByteCountWriteKey "IOMaximumByteCountWrite" +CONSTANT: kIOMaximumSegmentCountReadKey "IOMaximumSegmentCountRead" +CONSTANT: kIOMaximumSegmentCountWriteKey "IOMaximumSegmentCountWrite" +CONSTANT: kIOMaximumSegmentByteCountReadKey "IOMaximumSegmentByteCountRead" +CONSTANT: kIOMaximumSegmentByteCountWriteKey "IOMaximumSegmentByteCountWrite" +CONSTANT: kIOMinimumSegmentAlignmentByteCountKey "IOMinimumSegmentAlignmentByteCount" +CONSTANT: kIOMaximumSegmentAddressableBitCountKey "IOMaximumSegmentAddressableBitCount" -: kIOIconKey "IOIcon" ; inline -: kIOBundleResourceFileKey "IOBundleResourceFile" ; inline +CONSTANT: kIOIconKey "IOIcon" +CONSTANT: kIOBundleResourceFileKey "IOBundleResourceFile" -: kIOBusBadgeKey "IOBusBadge" ; inline -: kIODeviceIconKey "IODeviceIcon" ; inline +CONSTANT: kIOBusBadgeKey "IOBusBadge" +CONSTANT: kIODeviceIconKey "IODeviceIcon" -: kIOPlatformSerialNumberKey "IOPlatformSerialNumber" ; inline +CONSTANT: kIOPlatformSerialNumberKey "IOPlatformSerialNumber" -: kIOPlatformUUIDKey "IOPlatformUUID" ; inline +CONSTANT: kIOPlatformUUIDKey "IOPlatformUUID" -: kIONVRAMDeletePropertyKey "IONVRAM-DELETE-PROPERTY" ; inline -: kIODTNVRAMPanicInfoKey "aapl,panic-info" ; inline +CONSTANT: kIONVRAMDeletePropertyKey "IONVRAM-DELETE-PROPERTY" +CONSTANT: kIODTNVRAMPanicInfoKey "aapl,panic-info" -: kIOBootDeviceKey "IOBootDevice" ; inline -: kIOBootDevicePathKey "IOBootDevicePath" ; inline -: kIOBootDeviceSizeKey "IOBootDeviceSize" ; inline +CONSTANT: kIOBootDeviceKey "IOBootDevice" +CONSTANT: kIOBootDevicePathKey "IOBootDevicePath" +CONSTANT: kIOBootDeviceSizeKey "IOBootDeviceSize" -: kOSBuildVersionKey "OS Build Version" ; inline +CONSTANT: kOSBuildVersionKey "OS Build Version" -: kNilOptions 0 ; inline +CONSTANT: kNilOptions 0 TYPEDEF: uint mach_port_t TYPEDEF: int kern_return_t @@ -112,8 +112,8 @@ TYPEDEF: kern_return_t IOReturn TYPEDEF: uint IOOptionBits -: MACH_PORT_NULL 0 ; inline -: KERN_SUCCESS 0 ; inline +CONSTANT: MACH_PORT_NULL 0 +CONSTANT: KERN_SUCCESS 0 FUNCTION: IOReturn IOMasterPort ( mach_port_t bootstrap, mach_port_t* master ) ; From e99dfc25e8695b673e19835791317d3917359873 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 17:57:31 -0600 Subject: [PATCH 094/119] use CONSTANT: --- extra/game-input/scancodes/scancodes.factor | 346 ++++++++++---------- 1 file changed, 173 insertions(+), 173 deletions(-) diff --git a/extra/game-input/scancodes/scancodes.factor b/extra/game-input/scancodes/scancodes.factor index 7b0e39ee9b..3303a51c6f 100644 --- a/extra/game-input/scancodes/scancodes.factor +++ b/extra/game-input/scancodes/scancodes.factor @@ -1,175 +1,175 @@ IN: game-input.scancodes -: key-undefined HEX: 0000 ; inline -: key-error-roll-over HEX: 0001 ; inline -: key-error-post-fail HEX: 0002 ; inline -: key-error-undefined HEX: 0003 ; inline -: key-a HEX: 0004 ; inline -: key-b HEX: 0005 ; inline -: key-c HEX: 0006 ; inline -: key-d HEX: 0007 ; inline -: key-e HEX: 0008 ; inline -: key-f HEX: 0009 ; inline -: key-g HEX: 000a ; inline -: key-h HEX: 000b ; inline -: key-i HEX: 000c ; inline -: key-j HEX: 000d ; inline -: key-k HEX: 000e ; inline -: key-l HEX: 000f ; inline -: key-m HEX: 0010 ; inline -: key-n HEX: 0011 ; inline -: key-o HEX: 0012 ; inline -: key-p HEX: 0013 ; inline -: key-q HEX: 0014 ; inline -: key-r HEX: 0015 ; inline -: key-s HEX: 0016 ; inline -: key-t HEX: 0017 ; inline -: key-u HEX: 0018 ; inline -: key-v HEX: 0019 ; inline -: key-w HEX: 001a ; inline -: key-x HEX: 001b ; inline -: key-y HEX: 001c ; inline -: key-z HEX: 001d ; inline -: key-1 HEX: 001e ; inline -: key-2 HEX: 001f ; inline -: key-3 HEX: 0020 ; inline -: key-4 HEX: 0021 ; inline -: key-5 HEX: 0022 ; inline -: key-6 HEX: 0023 ; inline -: key-7 HEX: 0024 ; inline -: key-8 HEX: 0025 ; inline -: key-9 HEX: 0026 ; inline -: key-0 HEX: 0027 ; inline -: key-return HEX: 0028 ; inline -: key-escape HEX: 0029 ; inline -: key-backspace HEX: 002a ; inline -: key-tab HEX: 002b ; inline -: key-space HEX: 002c ; inline -: key-- HEX: 002d ; inline -: key-= HEX: 002e ; inline -: key-[ HEX: 002f ; inline -: key-] HEX: 0030 ; inline -: key-\ HEX: 0031 ; inline -: key-#-non-us HEX: 0032 ; inline -: key-; HEX: 0033 ; inline -: key-' HEX: 0034 ; inline -: key-` HEX: 0035 ; inline -: key-, HEX: 0036 ; inline -: key-. HEX: 0037 ; inline -: key-/ HEX: 0038 ; inline -: key-caps-lock HEX: 0039 ; inline -: key-f1 HEX: 003a ; inline -: key-f2 HEX: 003b ; inline -: key-f3 HEX: 003c ; inline -: key-f4 HEX: 003d ; inline -: key-f5 HEX: 003e ; inline -: key-f6 HEX: 003f ; inline -: key-f7 HEX: 0040 ; inline -: key-f8 HEX: 0041 ; inline -: key-f9 HEX: 0042 ; inline -: key-f10 HEX: 0043 ; inline -: key-f11 HEX: 0044 ; inline -: key-f12 HEX: 0045 ; inline -: key-print-screen HEX: 0046 ; inline -: key-scroll-lock HEX: 0047 ; inline -: key-pause HEX: 0048 ; inline -: key-insert HEX: 0049 ; inline -: key-home HEX: 004a ; inline -: key-page-up HEX: 004b ; inline -: key-delete HEX: 004c ; inline -: key-end HEX: 004d ; inline -: key-page-down HEX: 004e ; inline -: key-right-arrow HEX: 004f ; inline -: key-left-arrow HEX: 0050 ; inline -: key-down-arrow HEX: 0051 ; inline -: key-up-arrow HEX: 0052 ; inline -: key-keypad-numlock HEX: 0053 ; inline -: key-keypad-/ HEX: 0054 ; inline -: key-keypad-* HEX: 0055 ; inline -: key-keypad-- HEX: 0056 ; inline -: key-keypad-+ HEX: 0057 ; inline -: key-keypad-enter HEX: 0058 ; inline -: key-keypad-1 HEX: 0059 ; inline -: key-keypad-2 HEX: 005a ; inline -: key-keypad-3 HEX: 005b ; inline -: key-keypad-4 HEX: 005c ; inline -: key-keypad-5 HEX: 005d ; inline -: key-keypad-6 HEX: 005e ; inline -: key-keypad-7 HEX: 005f ; inline -: key-keypad-8 HEX: 0060 ; inline -: key-keypad-9 HEX: 0061 ; inline -: key-keypad-0 HEX: 0062 ; inline -: key-keypad-. HEX: 0063 ; inline -: key-\-non-us HEX: 0064 ; inline -: key-application HEX: 0065 ; inline -: key-power HEX: 0066 ; inline -: key-keypad-= HEX: 0067 ; inline -: key-f13 HEX: 0068 ; inline -: key-f14 HEX: 0069 ; inline -: key-f15 HEX: 006a ; inline -: key-f16 HEX: 006b ; inline -: key-f17 HEX: 006c ; inline -: key-f18 HEX: 006d ; inline -: key-f19 HEX: 006e ; inline -: key-f20 HEX: 006f ; inline -: key-f21 HEX: 0070 ; inline -: key-f22 HEX: 0071 ; inline -: key-f23 HEX: 0072 ; inline -: key-f24 HEX: 0073 ; inline -: key-execute HEX: 0074 ; inline -: key-help HEX: 0075 ; inline -: key-menu HEX: 0076 ; inline -: key-select HEX: 0077 ; inline -: key-stop HEX: 0078 ; inline -: key-again HEX: 0079 ; inline -: key-undo HEX: 007a ; inline -: key-cut HEX: 007b ; inline -: key-copy HEX: 007c ; inline -: key-paste HEX: 007d ; inline -: key-find HEX: 007e ; inline -: key-mute HEX: 007f ; inline -: key-volume-up HEX: 0080 ; inline -: key-volume-down HEX: 0081 ; inline -: key-locking-caps-lock HEX: 0082 ; inline -: key-locking-num-lock HEX: 0083 ; inline -: key-locking-scroll-lock HEX: 0084 ; inline -: key-keypad-, HEX: 0085 ; inline -: key-keypad-=-as-400 HEX: 0086 ; inline -: key-international-1 HEX: 0087 ; inline -: key-international-2 HEX: 0088 ; inline -: key-international-3 HEX: 0089 ; inline -: key-international-4 HEX: 008a ; inline -: key-international-5 HEX: 008b ; inline -: key-international-6 HEX: 008c ; inline -: key-international-7 HEX: 008d ; inline -: key-international-8 HEX: 008e ; inline -: key-international-9 HEX: 008f ; inline -: key-lang-1 HEX: 0090 ; inline -: key-lang-2 HEX: 0091 ; inline -: key-lang-3 HEX: 0092 ; inline -: key-lang-4 HEX: 0093 ; inline -: key-lang-5 HEX: 0094 ; inline -: key-lang-6 HEX: 0095 ; inline -: key-lang-7 HEX: 0096 ; inline -: key-lang-8 HEX: 0097 ; inline -: key-lang-9 HEX: 0098 ; inline -: key-alternate-erase HEX: 0099 ; inline -: key-sysreq HEX: 009a ; inline -: key-cancel HEX: 009b ; inline -: key-clear HEX: 009c ; inline -: key-prior HEX: 009d ; inline -: key-enter HEX: 009e ; inline -: key-separator HEX: 009f ; inline -: key-out HEX: 00a0 ; inline -: key-oper HEX: 00a1 ; inline -: key-clear-again HEX: 00a2 ; inline -: key-crsel-props HEX: 00a3 ; inline -: key-exsel HEX: 00a4 ; inline -: key-left-control HEX: 00e0 ; inline -: key-left-shift HEX: 00e1 ; inline -: key-left-alt HEX: 00e2 ; inline -: key-left-gui HEX: 00e3 ; inline -: key-right-control HEX: 00e4 ; inline -: key-right-shift HEX: 00e5 ; inline -: key-right-alt HEX: 00e6 ; inline -: key-right-gui HEX: 00e7 ; inline +CONSTANT: key-undefined HEX: 0000 +CONSTANT: key-error-roll-over HEX: 0001 +CONSTANT: key-error-post-fail HEX: 0002 +CONSTANT: key-error-undefined HEX: 0003 +CONSTANT: key-a HEX: 0004 +CONSTANT: key-b HEX: 0005 +CONSTANT: key-c HEX: 0006 +CONSTANT: key-d HEX: 0007 +CONSTANT: key-e HEX: 0008 +CONSTANT: key-f HEX: 0009 +CONSTANT: key-g HEX: 000a +CONSTANT: key-h HEX: 000b +CONSTANT: key-i HEX: 000c +CONSTANT: key-j HEX: 000d +CONSTANT: key-k HEX: 000e +CONSTANT: key-l HEX: 000f +CONSTANT: key-m HEX: 0010 +CONSTANT: key-n HEX: 0011 +CONSTANT: key-o HEX: 0012 +CONSTANT: key-p HEX: 0013 +CONSTANT: key-q HEX: 0014 +CONSTANT: key-r HEX: 0015 +CONSTANT: key-s HEX: 0016 +CONSTANT: key-t HEX: 0017 +CONSTANT: key-u HEX: 0018 +CONSTANT: key-v HEX: 0019 +CONSTANT: key-w HEX: 001a +CONSTANT: key-x HEX: 001b +CONSTANT: key-y HEX: 001c +CONSTANT: key-z HEX: 001d +CONSTANT: key-1 HEX: 001e +CONSTANT: key-2 HEX: 001f +CONSTANT: key-3 HEX: 0020 +CONSTANT: key-4 HEX: 0021 +CONSTANT: key-5 HEX: 0022 +CONSTANT: key-6 HEX: 0023 +CONSTANT: key-7 HEX: 0024 +CONSTANT: key-8 HEX: 0025 +CONSTANT: key-9 HEX: 0026 +CONSTANT: key-0 HEX: 0027 +CONSTANT: key-return HEX: 0028 +CONSTANT: key-escape HEX: 0029 +CONSTANT: key-backspace HEX: 002a +CONSTANT: key-tab HEX: 002b +CONSTANT: key-space HEX: 002c +CONSTANT: key-- HEX: 002d +CONSTANT: key-= HEX: 002e +CONSTANT: key-[ HEX: 002f +CONSTANT: key-] HEX: 0030 +CONSTANT: key-\ HEX: 0031 +CONSTANT: key-#-non-us HEX: 0032 +CONSTANT: key-; HEX: 0033 +CONSTANT: key-' HEX: 0034 +CONSTANT: key-` HEX: 0035 +CONSTANT: key-, HEX: 0036 +CONSTANT: key-. HEX: 0037 +CONSTANT: key-/ HEX: 0038 +CONSTANT: key-caps-lock HEX: 0039 +CONSTANT: key-f1 HEX: 003a +CONSTANT: key-f2 HEX: 003b +CONSTANT: key-f3 HEX: 003c +CONSTANT: key-f4 HEX: 003d +CONSTANT: key-f5 HEX: 003e +CONSTANT: key-f6 HEX: 003f +CONSTANT: key-f7 HEX: 0040 +CONSTANT: key-f8 HEX: 0041 +CONSTANT: key-f9 HEX: 0042 +CONSTANT: key-f10 HEX: 0043 +CONSTANT: key-f11 HEX: 0044 +CONSTANT: key-f12 HEX: 0045 +CONSTANT: key-print-screen HEX: 0046 +CONSTANT: key-scroll-lock HEX: 0047 +CONSTANT: key-pause HEX: 0048 +CONSTANT: key-insert HEX: 0049 +CONSTANT: key-home HEX: 004a +CONSTANT: key-page-up HEX: 004b +CONSTANT: key-delete HEX: 004c +CONSTANT: key-end HEX: 004d +CONSTANT: key-page-down HEX: 004e +CONSTANT: key-right-arrow HEX: 004f +CONSTANT: key-left-arrow HEX: 0050 +CONSTANT: key-down-arrow HEX: 0051 +CONSTANT: key-up-arrow HEX: 0052 +CONSTANT: key-keypad-numlock HEX: 0053 +CONSTANT: key-keypad-/ HEX: 0054 +CONSTANT: key-keypad-* HEX: 0055 +CONSTANT: key-keypad-- HEX: 0056 +CONSTANT: key-keypad-+ HEX: 0057 +CONSTANT: key-keypad-enter HEX: 0058 +CONSTANT: key-keypad-1 HEX: 0059 +CONSTANT: key-keypad-2 HEX: 005a +CONSTANT: key-keypad-3 HEX: 005b +CONSTANT: key-keypad-4 HEX: 005c +CONSTANT: key-keypad-5 HEX: 005d +CONSTANT: key-keypad-6 HEX: 005e +CONSTANT: key-keypad-7 HEX: 005f +CONSTANT: key-keypad-8 HEX: 0060 +CONSTANT: key-keypad-9 HEX: 0061 +CONSTANT: key-keypad-0 HEX: 0062 +CONSTANT: key-keypad-. HEX: 0063 +CONSTANT: key-\-non-us HEX: 0064 +CONSTANT: key-application HEX: 0065 +CONSTANT: key-power HEX: 0066 +CONSTANT: key-keypad-= HEX: 0067 +CONSTANT: key-f13 HEX: 0068 +CONSTANT: key-f14 HEX: 0069 +CONSTANT: key-f15 HEX: 006a +CONSTANT: key-f16 HEX: 006b +CONSTANT: key-f17 HEX: 006c +CONSTANT: key-f18 HEX: 006d +CONSTANT: key-f19 HEX: 006e +CONSTANT: key-f20 HEX: 006f +CONSTANT: key-f21 HEX: 0070 +CONSTANT: key-f22 HEX: 0071 +CONSTANT: key-f23 HEX: 0072 +CONSTANT: key-f24 HEX: 0073 +CONSTANT: key-execute HEX: 0074 +CONSTANT: key-help HEX: 0075 +CONSTANT: key-menu HEX: 0076 +CONSTANT: key-select HEX: 0077 +CONSTANT: key-stop HEX: 0078 +CONSTANT: key-again HEX: 0079 +CONSTANT: key-undo HEX: 007a +CONSTANT: key-cut HEX: 007b +CONSTANT: key-copy HEX: 007c +CONSTANT: key-paste HEX: 007d +CONSTANT: key-find HEX: 007e +CONSTANT: key-mute HEX: 007f +CONSTANT: key-volume-up HEX: 0080 +CONSTANT: key-volume-down HEX: 0081 +CONSTANT: key-locking-caps-lock HEX: 0082 +CONSTANT: key-locking-num-lock HEX: 0083 +CONSTANT: key-locking-scroll-lock HEX: 0084 +CONSTANT: key-keypad-, HEX: 0085 +CONSTANT: key-keypad-=-as-400 HEX: 0086 +CONSTANT: key-international-1 HEX: 0087 +CONSTANT: key-international-2 HEX: 0088 +CONSTANT: key-international-3 HEX: 0089 +CONSTANT: key-international-4 HEX: 008a +CONSTANT: key-international-5 HEX: 008b +CONSTANT: key-international-6 HEX: 008c +CONSTANT: key-international-7 HEX: 008d +CONSTANT: key-international-8 HEX: 008e +CONSTANT: key-international-9 HEX: 008f +CONSTANT: key-lang-1 HEX: 0090 +CONSTANT: key-lang-2 HEX: 0091 +CONSTANT: key-lang-3 HEX: 0092 +CONSTANT: key-lang-4 HEX: 0093 +CONSTANT: key-lang-5 HEX: 0094 +CONSTANT: key-lang-6 HEX: 0095 +CONSTANT: key-lang-7 HEX: 0096 +CONSTANT: key-lang-8 HEX: 0097 +CONSTANT: key-lang-9 HEX: 0098 +CONSTANT: key-alternate-erase HEX: 0099 +CONSTANT: key-sysreq HEX: 009a +CONSTANT: key-cancel HEX: 009b +CONSTANT: key-clear HEX: 009c +CONSTANT: key-prior HEX: 009d +CONSTANT: key-enter HEX: 009e +CONSTANT: key-separator HEX: 009f +CONSTANT: key-out HEX: 00a0 +CONSTANT: key-oper HEX: 00a1 +CONSTANT: key-clear-again HEX: 00a2 +CONSTANT: key-crsel-props HEX: 00a3 +CONSTANT: key-exsel HEX: 00a4 +CONSTANT: key-left-control HEX: 00e0 +CONSTANT: key-left-shift HEX: 00e1 +CONSTANT: key-left-alt HEX: 00e2 +CONSTANT: key-left-gui HEX: 00e3 +CONSTANT: key-right-control HEX: 00e4 +CONSTANT: key-right-shift HEX: 00e5 +CONSTANT: key-right-alt HEX: 00e6 +CONSTANT: key-right-gui HEX: 00e7 From adf6e97e175c357a29ccfaa427df82761318b49b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 17:58:14 -0600 Subject: [PATCH 095/119] use CONSTANT: --- extra/asn1/ldap/ldap.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/asn1/ldap/ldap.factor b/extra/asn1/ldap/ldap.factor index 8e93b140bf..449c9dcbd0 100644 --- a/extra/asn1/ldap/ldap.factor +++ b/extra/asn1/ldap/ldap.factor @@ -3,9 +3,9 @@ IN: asn1.ldap -: SearchScope_BaseObject 0 ; inline -: SearchScope_SingleLevel 1 ; inline -: SearchScope_WholeSubtree 2 ; inline +CONSTANT: SearchScope_BaseObject 0 +CONSTANT: SearchScope_SingleLevel 1 +CONSTANT: SearchScope_WholeSubtree 2 : asn-syntax ( -- hashtable ) H{ From 7aa8e7320d1876ef86de87ea6fc79cf2bd2518e3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 18:00:43 -0600 Subject: [PATCH 096/119] use CONSTANT: --- extra/game-input/iokit/iokit.factor | 44 ++++++++++++++--------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/extra/game-input/iokit/iokit.factor b/extra/game-input/iokit/iokit.factor index 26f2c40464..8a10535306 100755 --- a/extra/game-input/iokit/iokit.factor +++ b/extra/game-input/iokit/iokit.factor @@ -21,33 +21,33 @@ iokit-game-input-backend game-input-backend set-global [ &CFRelease NSFastEnumeration>vector ] [ f ] if* ] with-destructors ; -: game-devices-matching-seq +CONSTANT: game-devices-matching-seq { H{ { "DeviceUsage" 4 } { "DeviceUsagePage" 1 } } ! joysticks H{ { "DeviceUsage" 5 } { "DeviceUsagePage" 1 } } ! gamepads H{ { "DeviceUsage" 6 } { "DeviceUsagePage" 1 } } ! keyboards - } ; inline + } -: buttons-matching-hash - H{ { "UsagePage" 9 } { "Type" 2 } } ; inline -: keys-matching-hash - H{ { "UsagePage" 7 } { "Type" 2 } } ; inline -: x-axis-matching-hash - H{ { "UsagePage" 1 } { "Usage" HEX: 30 } { "Type" 1 } } ; inline -: y-axis-matching-hash - H{ { "UsagePage" 1 } { "Usage" HEX: 31 } { "Type" 1 } } ; inline -: z-axis-matching-hash - H{ { "UsagePage" 1 } { "Usage" HEX: 32 } { "Type" 1 } } ; inline -: rx-axis-matching-hash - H{ { "UsagePage" 1 } { "Usage" HEX: 33 } { "Type" 1 } } ; inline -: ry-axis-matching-hash - H{ { "UsagePage" 1 } { "Usage" HEX: 34 } { "Type" 1 } } ; inline -: rz-axis-matching-hash - H{ { "UsagePage" 1 } { "Usage" HEX: 35 } { "Type" 1 } } ; inline -: slider-matching-hash - H{ { "UsagePage" 1 } { "Usage" HEX: 36 } { "Type" 1 } } ; inline -: hat-switch-matching-hash - H{ { "UsagePage" 1 } { "Usage" HEX: 39 } { "Type" 1 } } ; inline +CONSTANT: buttons-matching-hash + H{ { "UsagePage" 9 } { "Type" 2 } } +CONSTANT: keys-matching-hash + H{ { "UsagePage" 7 } { "Type" 2 } } +CONSTANT: x-axis-matching-hash + H{ { "UsagePage" 1 } { "Usage" HEX: 30 } { "Type" 1 } } +CONSTANT: y-axis-matching-hash + H{ { "UsagePage" 1 } { "Usage" HEX: 31 } { "Type" 1 } } +CONSTANT: z-axis-matching-hash + H{ { "UsagePage" 1 } { "Usage" HEX: 32 } { "Type" 1 } } +CONSTANT: rx-axis-matching-hash + H{ { "UsagePage" 1 } { "Usage" HEX: 33 } { "Type" 1 } } +CONSTANT: ry-axis-matching-hash + H{ { "UsagePage" 1 } { "Usage" HEX: 34 } { "Type" 1 } } +CONSTANT: rz-axis-matching-hash + H{ { "UsagePage" 1 } { "Usage" HEX: 35 } { "Type" 1 } } +CONSTANT: slider-matching-hash + H{ { "UsagePage" 1 } { "Usage" HEX: 36 } { "Type" 1 } } +CONSTANT: hat-switch-matching-hash + H{ { "UsagePage" 1 } { "Usage" HEX: 39 } { "Type" 1 } } : device-elements-matching ( device matching-hash -- vector ) [ From 0e91003e19316533c39d8ebb1dd5381663b91474 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 18:04:52 -0600 Subject: [PATCH 097/119] use CONSTANT: --- basis/x11/xlib/xlib.factor | 424 ++++++++++++++++++------------------- 1 file changed, 212 insertions(+), 212 deletions(-) diff --git a/basis/x11/xlib/xlib.factor b/basis/x11/xlib/xlib.factor index f86c24b845..d9a7380593 100644 --- a/basis/x11/xlib/xlib.factor +++ b/basis/x11/xlib/xlib.factor @@ -131,19 +131,19 @@ C-STRUCT: XSetWindowAttributes { "Colormap" "colormap" } { "Cursor" "cursor" } ; -: UnmapGravity 0 ; inline +CONSTANT: UnmapGravity 0 -: ForgetGravity 0 ; inline -: NorthWestGravity 1 ; inline -: NorthGravity 2 ; inline -: NorthEastGravity 3 ; inline -: WestGravity 4 ; inline -: CenterGravity 5 ; inline -: EastGravity 6 ; inline -: SouthWestGravity 7 ; inline -: SouthGravity 8 ; inline -: SouthEastGravity 9 ; inline -: StaticGravity 10 ; inline +CONSTANT: ForgetGravity 0 +CONSTANT: NorthWestGravity 1 +CONSTANT: NorthGravity 2 +CONSTANT: NorthEastGravity 3 +CONSTANT: WestGravity 4 +CONSTANT: CenterGravity 5 +CONSTANT: EastGravity 6 +CONSTANT: SouthWestGravity 7 +CONSTANT: SouthGravity 8 +CONSTANT: SouthEastGravity 9 +CONSTANT: StaticGravity 10 ! 3.3 - Creating Windows @@ -238,9 +238,9 @@ C-STRUCT: XWindowAttributes FUNCTION: Status XGetWindowAttributes ( Display* display, Window w, XWindowAttributes* attr ) ; -: IsUnmapped 0 ; inline -: IsUnviewable 1 ; inline -: IsViewable 2 ; inline +CONSTANT: IsUnmapped 0 +CONSTANT: IsUnviewable 1 +CONSTANT: IsViewable 2 FUNCTION: Status XGetGeometry ( Display* display, @@ -336,22 +336,22 @@ FUNCTION: Colormap XCreateColormap ( Display* display, Window w, Visual* visual, : GCDashList ( -- n ) 21 2^ ; inline : GCArcMode ( -- n ) 22 2^ ; inline -: GXclear HEX: 0 ; inline -: GXand HEX: 1 ; inline -: GXandReverse HEX: 2 ; inline -: GXcopy HEX: 3 ; inline -: GXandInverted HEX: 4 ; inline -: GXnoop HEX: 5 ; inline -: GXxor HEX: 6 ; inline -: GXor HEX: 7 ; inline -: GXnor HEX: 8 ; inline -: GXequiv HEX: 9 ; inline -: GXinvert HEX: a ; inline -: GXorReverse HEX: b ; inline -: GXcopyInverted HEX: c ; inline -: GXorInverted HEX: d ; inline -: GXnand HEX: e ; inline -: GXset HEX: f ; inline +CONSTANT: GXclear HEX: 0 +CONSTANT: GXand HEX: 1 +CONSTANT: GXandReverse HEX: 2 +CONSTANT: GXcopy HEX: 3 +CONSTANT: GXandInverted HEX: 4 +CONSTANT: GXnoop HEX: 5 +CONSTANT: GXxor HEX: 6 +CONSTANT: GXor HEX: 7 +CONSTANT: GXnor HEX: 8 +CONSTANT: GXequiv HEX: 9 +CONSTANT: GXinvert HEX: a +CONSTANT: GXorReverse HEX: b +CONSTANT: GXcopyInverted HEX: c +CONSTANT: GXorInverted HEX: d +CONSTANT: GXnand HEX: e +CONSTANT: GXset HEX: f C-STRUCT: XGCValues { "int" "function" } @@ -532,40 +532,40 @@ FUNCTION: Status XKillClient ( Display* display, XID resource ) ; : ColormapChangeMask ( -- n ) 23 2^ ; inline : OwnerGrabButtonMask ( -- n ) 24 2^ ; inline -: KeyPress 2 ; inline -: KeyRelease 3 ; inline -: ButtonPress 4 ; inline -: ButtonRelease 5 ; inline -: MotionNotify 6 ; inline -: EnterNotify 7 ; inline -: LeaveNotify 8 ; inline -: FocusIn 9 ; inline -: FocusOut 10 ; inline -: KeymapNotify 11 ; inline -: Expose 12 ; inline -: GraphicsExpose 13 ; inline -: NoExpose 14 ; inline -: VisibilityNotify 15 ; inline -: CreateNotify 16 ; inline -: DestroyNotify 17 ; inline -: UnmapNotify 18 ; inline -: MapNotify 19 ; inline -: MapRequest 20 ; inline -: ReparentNotify 21 ; inline -: ConfigureNotify 22 ; inline -: ConfigureRequest 23 ; inline -: GravityNotify 24 ; inline -: ResizeRequest 25 ; inline -: CirculateNotify 26 ; inline -: CirculateRequest 27 ; inline -: PropertyNotify 28 ; inline -: SelectionClear 29 ; inline -: SelectionRequest 30 ; inline -: SelectionNotify 31 ; inline -: ColormapNotify 32 ; inline -: ClientMessage 33 ; inline -: MappingNotify 34 ; inline -: LASTEvent 35 ; inline +CONSTANT: KeyPress 2 +CONSTANT: KeyRelease 3 +CONSTANT: ButtonPress 4 +CONSTANT: ButtonRelease 5 +CONSTANT: MotionNotify 6 +CONSTANT: EnterNotify 7 +CONSTANT: LeaveNotify 8 +CONSTANT: FocusIn 9 +CONSTANT: FocusOut 10 +CONSTANT: KeymapNotify 11 +CONSTANT: Expose 12 +CONSTANT: GraphicsExpose 13 +CONSTANT: NoExpose 14 +CONSTANT: VisibilityNotify 15 +CONSTANT: CreateNotify 16 +CONSTANT: DestroyNotify 17 +CONSTANT: UnmapNotify 18 +CONSTANT: MapNotify 19 +CONSTANT: MapRequest 20 +CONSTANT: ReparentNotify 21 +CONSTANT: ConfigureNotify 22 +CONSTANT: ConfigureRequest 23 +CONSTANT: GravityNotify 24 +CONSTANT: ResizeRequest 25 +CONSTANT: CirculateNotify 26 +CONSTANT: CirculateRequest 27 +CONSTANT: PropertyNotify 28 +CONSTANT: SelectionClear 29 +CONSTANT: SelectionRequest 30 +CONSTANT: SelectionNotify 31 +CONSTANT: ColormapNotify 32 +CONSTANT: ClientMessage 33 +CONSTANT: MappingNotify 34 +CONSTANT: LASTEvent 35 C-STRUCT: XAnyEvent { "int" "type" } @@ -578,11 +578,11 @@ C-STRUCT: XAnyEvent ! 10.5 Keyboard and Pointer Events -: Button1 1 ; inline -: Button2 2 ; inline -: Button3 3 ; inline -: Button4 4 ; inline -: Button5 5 ; inline +CONSTANT: Button1 1 +CONSTANT: Button2 2 +CONSTANT: Button3 3 +CONSTANT: Button4 4 +CONSTANT: Button5 5 : Button1Mask ( -- n ) 1 8 shift ; inline : Button2Mask ( -- n ) 1 9 shift ; inline @@ -1199,17 +1199,17 @@ FUNCTION: int XLookupString ( ! 16.7 Determining the Appropriate Visual Type -: VisualNoMask HEX: 0 ; inline -: VisualIDMask HEX: 1 ; inline -: VisualScreenMask HEX: 2 ; inline -: VisualDepthMask HEX: 4 ; inline -: VisualClassMask HEX: 8 ; inline -: VisualRedMaskMask HEX: 10 ; inline -: VisualGreenMaskMask HEX: 20 ; inline -: VisualBlueMaskMask HEX: 40 ; inline -: VisualColormapSizeMask HEX: 80 ; inline -: VisualBitsPerRGBMask HEX: 100 ; inline -: VisualAllMask HEX: 1FF ; inline +CONSTANT: VisualNoMask HEX: 0 +CONSTANT: VisualIDMask HEX: 1 +CONSTANT: VisualScreenMask HEX: 2 +CONSTANT: VisualDepthMask HEX: 4 +CONSTANT: VisualClassMask HEX: 8 +CONSTANT: VisualRedMaskMask HEX: 10 +CONSTANT: VisualGreenMaskMask HEX: 20 +CONSTANT: VisualBlueMaskMask HEX: 40 +CONSTANT: VisualColormapSizeMask HEX: 80 +CONSTANT: VisualBitsPerRGBMask HEX: 100 +CONSTANT: VisualAllMask HEX: 1FF C-STRUCT: XVisualInfo { "Visual*" "visual" } @@ -1239,76 +1239,76 @@ FUNCTION: Status XSetStandardProperties ( ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: XA_PRIMARY 1 ; inline -: XA_SECONDARY 2 ; inline -: XA_ARC 3 ; inline -: XA_ATOM 4 ; inline -: XA_BITMAP 5 ; inline -: XA_CARDINAL 6 ; inline -: XA_COLORMAP 7 ; inline -: XA_CURSOR 8 ; inline -: XA_CUT_BUFFER0 9 ; inline -: XA_CUT_BUFFER1 10 ; inline -: XA_CUT_BUFFER2 11 ; inline -: XA_CUT_BUFFER3 12 ; inline -: XA_CUT_BUFFER4 13 ; inline -: XA_CUT_BUFFER5 14 ; inline -: XA_CUT_BUFFER6 15 ; inline -: XA_CUT_BUFFER7 16 ; inline -: XA_DRAWABLE 17 ; inline -: XA_FONT 18 ; inline -: XA_INTEGER 19 ; inline -: XA_PIXMAP 20 ; inline -: XA_POINT 21 ; inline -: XA_RECTANGLE 22 ; inline -: XA_RESOURCE_MANAGER 23 ; inline -: XA_RGB_COLOR_MAP 24 ; inline -: XA_RGB_BEST_MAP 25 ; inline -: XA_RGB_BLUE_MAP 26 ; inline -: XA_RGB_DEFAULT_MAP 27 ; inline -: XA_RGB_GRAY_MAP 28 ; inline -: XA_RGB_GREEN_MAP 29 ; inline -: XA_RGB_RED_MAP 30 ; inline -: XA_STRING 31 ; inline -: XA_VISUALID 32 ; inline -: XA_WINDOW 33 ; inline -: XA_WM_COMMAND 34 ; inline -: XA_WM_HINTS 35 ; inline -: XA_WM_CLIENT_MACHINE 36 ; inline -: XA_WM_ICON_NAME 37 ; inline -: XA_WM_ICON_SIZE 38 ; inline -: XA_WM_NAME 39 ; inline -: XA_WM_NORMAL_HINTS 40 ; inline -: XA_WM_SIZE_HINTS 41 ; inline -: XA_WM_ZOOM_HINTS 42 ; inline -: XA_MIN_SPACE 43 ; inline -: XA_NORM_SPACE 44 ; inline -: XA_MAX_SPACE 45 ; inline -: XA_END_SPACE 46 ; inline -: XA_SUPERSCRIPT_X 47 ; inline -: XA_SUPERSCRIPT_Y 48 ; inline -: XA_SUBSCRIPT_X 49 ; inline -: XA_SUBSCRIPT_Y 50 ; inline -: XA_UNDERLINE_POSITION 51 ; inline -: XA_UNDERLINE_THICKNESS 52 ; inline -: XA_STRIKEOUT_ASCENT 53 ; inline -: XA_STRIKEOUT_DESCENT 54 ; inline -: XA_ITALIC_ANGLE 55 ; inline -: XA_X_HEIGHT 56 ; inline -: XA_QUAD_WIDTH 57 ; inline -: XA_WEIGHT 58 ; inline -: XA_POINT_SIZE 59 ; inline -: XA_RESOLUTION 60 ; inline -: XA_COPYRIGHT 61 ; inline -: XA_NOTICE 62 ; inline -: XA_FONT_NAME 63 ; inline -: XA_FAMILY_NAME 64 ; inline -: XA_FULL_NAME 65 ; inline -: XA_CAP_HEIGHT 66 ; inline -: XA_WM_CLASS 67 ; inline -: XA_WM_TRANSIENT_FOR 68 ; inline +CONSTANT: XA_PRIMARY 1 +CONSTANT: XA_SECONDARY 2 +CONSTANT: XA_ARC 3 +CONSTANT: XA_ATOM 4 +CONSTANT: XA_BITMAP 5 +CONSTANT: XA_CARDINAL 6 +CONSTANT: XA_COLORMAP 7 +CONSTANT: XA_CURSOR 8 +CONSTANT: XA_CUT_BUFFER0 9 +CONSTANT: XA_CUT_BUFFER1 10 +CONSTANT: XA_CUT_BUFFER2 11 +CONSTANT: XA_CUT_BUFFER3 12 +CONSTANT: XA_CUT_BUFFER4 13 +CONSTANT: XA_CUT_BUFFER5 14 +CONSTANT: XA_CUT_BUFFER6 15 +CONSTANT: XA_CUT_BUFFER7 16 +CONSTANT: XA_DRAWABLE 17 +CONSTANT: XA_FONT 18 +CONSTANT: XA_INTEGER 19 +CONSTANT: XA_PIXMAP 20 +CONSTANT: XA_POINT 21 +CONSTANT: XA_RECTANGLE 22 +CONSTANT: XA_RESOURCE_MANAGER 23 +CONSTANT: XA_RGB_COLOR_MAP 24 +CONSTANT: XA_RGB_BEST_MAP 25 +CONSTANT: XA_RGB_BLUE_MAP 26 +CONSTANT: XA_RGB_DEFAULT_MAP 27 +CONSTANT: XA_RGB_GRAY_MAP 28 +CONSTANT: XA_RGB_GREEN_MAP 29 +CONSTANT: XA_RGB_RED_MAP 30 +CONSTANT: XA_STRING 31 +CONSTANT: XA_VISUALID 32 +CONSTANT: XA_WINDOW 33 +CONSTANT: XA_WM_COMMAND 34 +CONSTANT: XA_WM_HINTS 35 +CONSTANT: XA_WM_CLIENT_MACHINE 36 +CONSTANT: XA_WM_ICON_NAME 37 +CONSTANT: XA_WM_ICON_SIZE 38 +CONSTANT: XA_WM_NAME 39 +CONSTANT: XA_WM_NORMAL_HINTS 40 +CONSTANT: XA_WM_SIZE_HINTS 41 +CONSTANT: XA_WM_ZOOM_HINTS 42 +CONSTANT: XA_MIN_SPACE 43 +CONSTANT: XA_NORM_SPACE 44 +CONSTANT: XA_MAX_SPACE 45 +CONSTANT: XA_END_SPACE 46 +CONSTANT: XA_SUPERSCRIPT_X 47 +CONSTANT: XA_SUPERSCRIPT_Y 48 +CONSTANT: XA_SUBSCRIPT_X 49 +CONSTANT: XA_SUBSCRIPT_Y 50 +CONSTANT: XA_UNDERLINE_POSITION 51 +CONSTANT: XA_UNDERLINE_THICKNESS 52 +CONSTANT: XA_STRIKEOUT_ASCENT 53 +CONSTANT: XA_STRIKEOUT_DESCENT 54 +CONSTANT: XA_ITALIC_ANGLE 55 +CONSTANT: XA_X_HEIGHT 56 +CONSTANT: XA_QUAD_WIDTH 57 +CONSTANT: XA_WEIGHT 58 +CONSTANT: XA_POINT_SIZE 59 +CONSTANT: XA_RESOLUTION 60 +CONSTANT: XA_COPYRIGHT 61 +CONSTANT: XA_NOTICE 62 +CONSTANT: XA_FONT_NAME 63 +CONSTANT: XA_FAMILY_NAME 64 +CONSTANT: XA_FULL_NAME 65 +CONSTANT: XA_CAP_HEIGHT 66 +CONSTANT: XA_WM_CLASS 67 +CONSTANT: XA_WM_TRANSIENT_FOR 68 -: XA_LAST_PREDEFINED 68 ; inline +CONSTANT: XA_LAST_PREDEFINED 68 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! The rest of the stuff is not from the book. @@ -1321,65 +1321,65 @@ FUNCTION: int XBell ( Display* display, int percent ) ; ! !!! INPUT METHODS -: XIMPreeditArea HEX: 0001 ; inline -: XIMPreeditCallbacks HEX: 0002 ; inline -: XIMPreeditPosition HEX: 0004 ; inline -: XIMPreeditNothing HEX: 0008 ; inline -: XIMPreeditNone HEX: 0010 ; inline -: XIMStatusArea HEX: 0100 ; inline -: XIMStatusCallbacks HEX: 0200 ; inline -: XIMStatusNothing HEX: 0400 ; inline -: XIMStatusNone HEX: 0800 ; inline +CONSTANT: XIMPreeditArea HEX: 0001 +CONSTANT: XIMPreeditCallbacks HEX: 0002 +CONSTANT: XIMPreeditPosition HEX: 0004 +CONSTANT: XIMPreeditNothing HEX: 0008 +CONSTANT: XIMPreeditNone HEX: 0010 +CONSTANT: XIMStatusArea HEX: 0100 +CONSTANT: XIMStatusCallbacks HEX: 0200 +CONSTANT: XIMStatusNothing HEX: 0400 +CONSTANT: XIMStatusNone HEX: 0800 -: XNVaNestedList "XNVaNestedList" ; -: XNQueryInputStyle "queryInputStyle" ; -: XNClientWindow "clientWindow" ; -: XNInputStyle "inputStyle" ; -: XNFocusWindow "focusWindow" ; -: XNResourceName "resourceName" ; -: XNResourceClass "resourceClass" ; -: XNGeometryCallback "geometryCallback" ; -: XNDestroyCallback "destroyCallback" ; -: XNFilterEvents "filterEvents" ; -: XNPreeditStartCallback "preeditStartCallback" ; -: XNPreeditDoneCallback "preeditDoneCallback" ; -: XNPreeditDrawCallback "preeditDrawCallback" ; -: XNPreeditCaretCallback "preeditCaretCallback" ; -: XNPreeditStateNotifyCallback "preeditStateNotifyCallback" ; -: XNPreeditAttributes "preeditAttributes" ; -: XNStatusStartCallback "statusStartCallback" ; -: XNStatusDoneCallback "statusDoneCallback" ; -: XNStatusDrawCallback "statusDrawCallback" ; -: XNStatusAttributes "statusAttributes" ; -: XNArea "area" ; -: XNAreaNeeded "areaNeeded" ; -: XNSpotLocation "spotLocation" ; -: XNColormap "colorMap" ; -: XNStdColormap "stdColorMap" ; -: XNForeground "foreground" ; -: XNBackground "background" ; -: XNBackgroundPixmap "backgroundPixmap" ; -: XNFontSet "fontSet" ; -: XNLineSpace "lineSpace" ; -: XNCursor "cursor" ; +CONSTANT: XNVaNestedList "XNVaNestedList" +CONSTANT: XNQueryInputStyle "queryInputStyle" +CONSTANT: XNClientWindow "clientWindow" +CONSTANT: XNInputStyle "inputStyle" +CONSTANT: XNFocusWindow "focusWindow" +CONSTANT: XNResourceName "resourceName" +CONSTANT: XNResourceClass "resourceClass" +CONSTANT: XNGeometryCallback "geometryCallback" +CONSTANT: XNDestroyCallback "destroyCallback" +CONSTANT: XNFilterEvents "filterEvents" +CONSTANT: XNPreeditStartCallback "preeditStartCallback" +CONSTANT: XNPreeditDoneCallback "preeditDoneCallback" +CONSTANT: XNPreeditDrawCallback "preeditDrawCallback" +CONSTANT: XNPreeditCaretCallback "preeditCaretCallback" +CONSTANT: XNPreeditStateNotifyCallback "preeditStateNotifyCallback" +CONSTANT: XNPreeditAttributes "preeditAttributes" +CONSTANT: XNStatusStartCallback "statusStartCallback" +CONSTANT: XNStatusDoneCallback "statusDoneCallback" +CONSTANT: XNStatusDrawCallback "statusDrawCallback" +CONSTANT: XNStatusAttributes "statusAttributes" +CONSTANT: XNArea "area" +CONSTANT: XNAreaNeeded "areaNeeded" +CONSTANT: XNSpotLocation "spotLocation" +CONSTANT: XNColormap "colorMap" +CONSTANT: XNStdColormap "stdColorMap" +CONSTANT: XNForeground "foreground" +CONSTANT: XNBackground "background" +CONSTANT: XNBackgroundPixmap "backgroundPixmap" +CONSTANT: XNFontSet "fontSet" +CONSTANT: XNLineSpace "lineSpace" +CONSTANT: XNCursor "cursor" -: XNQueryIMValuesList "queryIMValuesList" ; -: XNQueryICValuesList "queryICValuesList" ; -: XNVisiblePosition "visiblePosition" ; -: XNR6PreeditCallback "r6PreeditCallback" ; -: XNStringConversionCallback "stringConversionCallback" ; -: XNStringConversion "stringConversion" ; -: XNResetState "resetState" ; -: XNHotKey "hotKey" ; -: XNHotKeyState "hotKeyState" ; -: XNPreeditState "preeditState" ; -: XNSeparatorofNestedList "separatorofNestedList" ; +CONSTANT: XNQueryIMValuesList "queryIMValuesList" +CONSTANT: XNQueryICValuesList "queryICValuesList" +CONSTANT: XNVisiblePosition "visiblePosition" +CONSTANT: XNR6PreeditCallback "r6PreeditCallback" +CONSTANT: XNStringConversionCallback "stringConversionCallback" +CONSTANT: XNStringConversion "stringConversion" +CONSTANT: XNResetState "resetState" +CONSTANT: XNHotKey "hotKey" +CONSTANT: XNHotKeyState "hotKeyState" +CONSTANT: XNPreeditState "preeditState" +CONSTANT: XNSeparatorofNestedList "separatorofNestedList" -: XBufferOverflow -1 ; -: XLookupNone 1 ; -: XLookupChars 2 ; -: XLookupKeySym 3 ; -: XLookupBoth 4 ; +CONSTANT: XBufferOverflow -1 +CONSTANT: XLookupNone 1 +CONSTANT: XLookupChars 2 +CONSTANT: XLookupKeySym 3 +CONSTANT: XLookupBoth 4 FUNCTION: Bool XFilterEvent ( XEvent* event, Window w ) ; @@ -1400,12 +1400,12 @@ FUNCTION: int XwcLookupString ( XIC ic, XKeyPressedEvent* event, ulong* buffer_r FUNCTION: int Xutf8LookupString ( XIC ic, XKeyPressedEvent* event, char* buffer_return, int bytes_buffer, KeySym* keysym_return, Status* status_return ) ; ! !!! category of setlocale -: LC_ALL 0 ; inline -: LC_COLLATE 1 ; inline -: LC_CTYPE 2 ; inline -: LC_MONETARY 3 ; inline -: LC_NUMERIC 4 ; inline -: LC_TIME 5 ; inline +CONSTANT: LC_ALL 0 +CONSTANT: LC_COLLATE 1 +CONSTANT: LC_CTYPE 2 +CONSTANT: LC_MONETARY 3 +CONSTANT: LC_NUMERIC 4 +CONSTANT: LC_TIME 5 FUNCTION: char* setlocale ( int category, char* name ) ; From 58abcec1276319a449f38a93747d0a3a4155241c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 18:09:10 -0600 Subject: [PATCH 098/119] use CONSTANT: in win32 bindings --- basis/windows/user32/user32.factor | 605 ++++++++++++++--------------- 1 file changed, 302 insertions(+), 303 deletions(-) diff --git a/basis/windows/user32/user32.factor b/basis/windows/user32/user32.factor index e2e2c7e150..9daac21697 100644 --- a/basis/windows/user32/user32.factor +++ b/basis/windows/user32/user32.factor @@ -150,377 +150,377 @@ CONSTANT: PM_NOYIELD 2 ! ! Standard Cursor IDs ! -: IDC_ARROW 32512 ; inline -: IDC_IBEAM 32513 ; inline -: IDC_WAIT 32514 ; inline -: IDC_CROSS 32515 ; inline -: IDC_UPARROW 32516 ; inline -: IDC_SIZE 32640 ; inline ! OBSOLETE: use IDC_SIZEALL -: IDC_ICON 32641 ; inline ! OBSOLETE: use IDC_ARROW -: IDC_SIZENWSE 32642 ; inline -: IDC_SIZENESW 32643 ; inline -: IDC_SIZEWE 32644 ; inline -: IDC_SIZENS 32645 ; inline -: IDC_SIZEALL 32646 ; inline -: IDC_NO 32648 ; inline ! not in win3.1 -: IDC_HAND 32649 ; inline -: IDC_APPSTARTING 32650 ; inline ! not in win3.1 -: IDC_HELP 32651 ; inline +CONSTANT: IDC_ARROW 32512 +CONSTANT: IDC_IBEAM 32513 +CONSTANT: IDC_WAIT 32514 +CONSTANT: IDC_CROSS 32515 +CONSTANT: IDC_UPARROW 32516 +CONSTANT: IDC_SIZE 32640 ! OBSOLETE: use IDC_SIZEALL +CONSTANT: IDC_ICON 32641 ! OBSOLETE: use IDC_ARROW +CONSTANT: IDC_SIZENWSE 32642 +CONSTANT: IDC_SIZENESW 32643 +CONSTANT: IDC_SIZEWE 32644 +CONSTANT: IDC_SIZENS 32645 +CONSTANT: IDC_SIZEALL 32646 +CONSTANT: IDC_NO 32648 ! not in win3.1 +CONSTANT: IDC_HAND 32649 +CONSTANT: IDC_APPSTARTING 32650 ! not in win3.1 +CONSTANT: IDC_HELP 32651 ! Predefined Clipboard Formats -: CF_TEXT 1 ; inline -: CF_BITMAP 2 ; inline -: CF_METAFILEPICT 3 ; inline -: CF_SYLK 4 ; inline -: CF_DIF 5 ; inline -: CF_TIFF 6 ; inline -: CF_OEMTEXT 7 ; inline -: CF_DIB 8 ; inline -: CF_PALETTE 9 ; inline -: CF_PENDATA 10 ; inline -: CF_RIFF 11 ; inline -: CF_WAVE 12 ; inline -: CF_UNICODETEXT 13 ; inline -: CF_ENHMETAFILE 14 ; inline -: CF_HDROP 15 ; inline -: CF_LOCALE 16 ; inline -: CF_DIBV5 17 ; inline -: CF_MAX 18 ; inline +CONSTANT: CF_TEXT 1 +CONSTANT: CF_BITMAP 2 +CONSTANT: CF_METAFILEPICT 3 +CONSTANT: CF_SYLK 4 +CONSTANT: CF_DIF 5 +CONSTANT: CF_TIFF 6 +CONSTANT: CF_OEMTEXT 7 +CONSTANT: CF_DIB 8 +CONSTANT: CF_PALETTE 9 +CONSTANT: CF_PENDATA 10 +CONSTANT: CF_RIFF 11 +CONSTANT: CF_WAVE 12 +CONSTANT: CF_UNICODETEXT 13 +CONSTANT: CF_ENHMETAFILE 14 +CONSTANT: CF_HDROP 15 +CONSTANT: CF_LOCALE 16 +CONSTANT: CF_DIBV5 17 +CONSTANT: CF_MAX 18 -: CF_OWNERDISPLAY HEX: 0080 ; inline -: CF_DSPTEXT HEX: 0081 ; inline -: CF_DSPBITMAP HEX: 0082 ; inline -: CF_DSPMETAFILEPICT HEX: 0083 ; inline -: CF_DSPENHMETAFILE HEX: 008E ; inline +CONSTANT: CF_OWNERDISPLAY HEX: 0080 +CONSTANT: CF_DSPTEXT HEX: 0081 +CONSTANT: CF_DSPBITMAP HEX: 0082 +CONSTANT: CF_DSPMETAFILEPICT HEX: 0083 +CONSTANT: CF_DSPENHMETAFILE HEX: 008E ! "Private" formats don't get GlobalFree()'d -: CF_PRIVATEFIRST HEX: 200 ; inline -: CF_PRIVATELAST HEX: 2FF ; inline +CONSTANT: CF_PRIVATEFIRST HEX: 200 +CONSTANT: CF_PRIVATELAST HEX: 2FF ! "GDIOBJ" formats do get DeleteObject()'d -: CF_GDIOBJFIRST HEX: 300 ; inline -: CF_GDIOBJLAST HEX: 3FF ; inline +CONSTANT: CF_GDIOBJFIRST HEX: 300 +CONSTANT: CF_GDIOBJLAST HEX: 3FF ! Virtual Keys, Standard Set -: VK_LBUTTON HEX: 01 ; inline -: VK_RBUTTON HEX: 02 ; inline -: VK_CANCEL HEX: 03 ; inline -: VK_MBUTTON HEX: 04 ; inline ! NOT contiguous with L & RBUTTON -: VK_XBUTTON1 HEX: 05 ; inline ! NOT contiguous with L & RBUTTON -: VK_XBUTTON2 HEX: 06 ; inline ! NOT contiguous with L & RBUTTON +CONSTANT: VK_LBUTTON HEX: 01 +CONSTANT: VK_RBUTTON HEX: 02 +CONSTANT: VK_CANCEL HEX: 03 +CONSTANT: VK_MBUTTON HEX: 04 ! NOT contiguous with L & RBUTTON +CONSTANT: VK_XBUTTON1 HEX: 05 ! NOT contiguous with L & RBUTTON +CONSTANT: VK_XBUTTON2 HEX: 06 ! NOT contiguous with L & RBUTTON ! 0x07 : unassigned -: VK_BACK HEX: 08 ; inline -: VK_TAB HEX: 09 ; inline +CONSTANT: VK_BACK HEX: 08 +CONSTANT: VK_TAB HEX: 09 ! 0x0A - 0x0B : reserved -: VK_CLEAR HEX: 0C ; inline -: VK_RETURN HEX: 0D ; inline +CONSTANT: VK_CLEAR HEX: 0C +CONSTANT: VK_RETURN HEX: 0D -: VK_SHIFT HEX: 10 ; inline -: VK_CONTROL HEX: 11 ; inline -: VK_MENU HEX: 12 ; inline -: VK_PAUSE HEX: 13 ; inline -: VK_CAPITAL HEX: 14 ; inline +CONSTANT: VK_SHIFT HEX: 10 +CONSTANT: VK_CONTROL HEX: 11 +CONSTANT: VK_MENU HEX: 12 +CONSTANT: VK_PAUSE HEX: 13 +CONSTANT: VK_CAPITAL HEX: 14 -: VK_KANA HEX: 15 ; inline -: VK_HANGEUL HEX: 15 ; inline ! old name - here for compatibility -: VK_HANGUL HEX: 15 ; inline -: VK_JUNJA HEX: 17 ; inline -: VK_FINAL HEX: 18 ; inline -: VK_HANJA HEX: 19 ; inline -: VK_KANJI HEX: 19 ; inline +CONSTANT: VK_KANA HEX: 15 +CONSTANT: VK_HANGEUL HEX: 15 ! old name - here for compatibility +CONSTANT: VK_HANGUL HEX: 15 +CONSTANT: VK_JUNJA HEX: 17 +CONSTANT: VK_FINAL HEX: 18 +CONSTANT: VK_HANJA HEX: 19 +CONSTANT: VK_KANJI HEX: 19 -: VK_ESCAPE HEX: 1B ; inline +CONSTANT: VK_ESCAPE HEX: 1B -: VK_CONVERT HEX: 1C ; inline -: VK_NONCONVERT HEX: 1D ; inline -: VK_ACCEPT HEX: 1E ; inline -: VK_MODECHANGE HEX: 1F ; inline +CONSTANT: VK_CONVERT HEX: 1C +CONSTANT: VK_NONCONVERT HEX: 1D +CONSTANT: VK_ACCEPT HEX: 1E +CONSTANT: VK_MODECHANGE HEX: 1F -: VK_SPACE HEX: 20 ; inline -: VK_PRIOR HEX: 21 ; inline -: VK_NEXT HEX: 22 ; inline -: VK_END HEX: 23 ; inline -: VK_HOME HEX: 24 ; inline -: VK_LEFT HEX: 25 ; inline -: VK_UP HEX: 26 ; inline -: VK_RIGHT HEX: 27 ; inline -: VK_DOWN HEX: 28 ; inline -: VK_SELECT HEX: 29 ; inline -: VK_PRINT HEX: 2A ; inline -: VK_EXECUTE HEX: 2B ; inline -: VK_SNAPSHOT HEX: 2C ; inline -: VK_INSERT HEX: 2D ; inline -: VK_DELETE HEX: 2E ; inline -: VK_HELP HEX: 2F ; inline +CONSTANT: VK_SPACE HEX: 20 +CONSTANT: VK_PRIOR HEX: 21 +CONSTANT: VK_NEXT HEX: 22 +CONSTANT: VK_END HEX: 23 +CONSTANT: VK_HOME HEX: 24 +CONSTANT: VK_LEFT HEX: 25 +CONSTANT: VK_UP HEX: 26 +CONSTANT: VK_RIGHT HEX: 27 +CONSTANT: VK_DOWN HEX: 28 +CONSTANT: VK_SELECT HEX: 29 +CONSTANT: VK_PRINT HEX: 2A +CONSTANT: VK_EXECUTE HEX: 2B +CONSTANT: VK_SNAPSHOT HEX: 2C +CONSTANT: VK_INSERT HEX: 2D +CONSTANT: VK_DELETE HEX: 2E +CONSTANT: VK_HELP HEX: 2F -: VK_0 CHAR: 0 ; inline -: VK_1 CHAR: 1 ; inline -: VK_2 CHAR: 2 ; inline -: VK_3 CHAR: 3 ; inline -: VK_4 CHAR: 4 ; inline -: VK_5 CHAR: 5 ; inline -: VK_6 CHAR: 6 ; inline -: VK_7 CHAR: 7 ; inline -: VK_8 CHAR: 8 ; inline -: VK_9 CHAR: 9 ; inline +CONSTANT: VK_0 CHAR: 0 +CONSTANT: VK_1 CHAR: 1 +CONSTANT: VK_2 CHAR: 2 +CONSTANT: VK_3 CHAR: 3 +CONSTANT: VK_4 CHAR: 4 +CONSTANT: VK_5 CHAR: 5 +CONSTANT: VK_6 CHAR: 6 +CONSTANT: VK_7 CHAR: 7 +CONSTANT: VK_8 CHAR: 8 +CONSTANT: VK_9 CHAR: 9 -: VK_A CHAR: A ; inline -: VK_B CHAR: B ; inline -: VK_C CHAR: C ; inline -: VK_D CHAR: D ; inline -: VK_E CHAR: E ; inline -: VK_F CHAR: F ; inline -: VK_G CHAR: G ; inline -: VK_H CHAR: H ; inline -: VK_I CHAR: I ; inline -: VK_J CHAR: J ; inline -: VK_K CHAR: K ; inline -: VK_L CHAR: L ; inline -: VK_M CHAR: M ; inline -: VK_N CHAR: N ; inline -: VK_O CHAR: O ; inline -: VK_P CHAR: P ; inline -: VK_Q CHAR: Q ; inline -: VK_R CHAR: R ; inline -: VK_S CHAR: S ; inline -: VK_T CHAR: T ; inline -: VK_U CHAR: U ; inline -: VK_V CHAR: V ; inline -: VK_W CHAR: W ; inline -: VK_X CHAR: X ; inline -: VK_Y CHAR: Y ; inline -: VK_Z CHAR: Z ; inline +CONSTANT: VK_A CHAR: A +CONSTANT: VK_B CHAR: B +CONSTANT: VK_C CHAR: C +CONSTANT: VK_D CHAR: D +CONSTANT: VK_E CHAR: E +CONSTANT: VK_F CHAR: F +CONSTANT: VK_G CHAR: G +CONSTANT: VK_H CHAR: H +CONSTANT: VK_I CHAR: I +CONSTANT: VK_J CHAR: J +CONSTANT: VK_K CHAR: K +CONSTANT: VK_L CHAR: L +CONSTANT: VK_M CHAR: M +CONSTANT: VK_N CHAR: N +CONSTANT: VK_O CHAR: O +CONSTANT: VK_P CHAR: P +CONSTANT: VK_Q CHAR: Q +CONSTANT: VK_R CHAR: R +CONSTANT: VK_S CHAR: S +CONSTANT: VK_T CHAR: T +CONSTANT: VK_U CHAR: U +CONSTANT: VK_V CHAR: V +CONSTANT: VK_W CHAR: W +CONSTANT: VK_X CHAR: X +CONSTANT: VK_Y CHAR: Y +CONSTANT: VK_Z CHAR: Z -: VK_LWIN HEX: 5B ; inline -: VK_RWIN HEX: 5C ; inline -: VK_APPS HEX: 5D ; inline +CONSTANT: VK_LWIN HEX: 5B +CONSTANT: VK_RWIN HEX: 5C +CONSTANT: VK_APPS HEX: 5D ! 0x5E : reserved -: VK_SLEEP HEX: 5F ; inline +CONSTANT: VK_SLEEP HEX: 5F -: VK_NUMPAD0 HEX: 60 ; inline -: VK_NUMPAD1 HEX: 61 ; inline -: VK_NUMPAD2 HEX: 62 ; inline -: VK_NUMPAD3 HEX: 63 ; inline -: VK_NUMPAD4 HEX: 64 ; inline -: VK_NUMPAD5 HEX: 65 ; inline -: VK_NUMPAD6 HEX: 66 ; inline -: VK_NUMPAD7 HEX: 67 ; inline -: VK_NUMPAD8 HEX: 68 ; inline -: VK_NUMPAD9 HEX: 69 ; inline -: VK_MULTIPLY HEX: 6A ; inline -: VK_ADD HEX: 6B ; inline -: VK_SEPARATOR HEX: 6C ; inline -: VK_SUBTRACT HEX: 6D ; inline -: VK_DECIMAL HEX: 6E ; inline -: VK_DIVIDE HEX: 6F ; inline -: VK_F1 HEX: 70 ; inline -: VK_F2 HEX: 71 ; inline -: VK_F3 HEX: 72 ; inline -: VK_F4 HEX: 73 ; inline -: VK_F5 HEX: 74 ; inline -: VK_F6 HEX: 75 ; inline -: VK_F7 HEX: 76 ; inline -: VK_F8 HEX: 77 ; inline -: VK_F9 HEX: 78 ; inline -: VK_F10 HEX: 79 ; inline -: VK_F11 HEX: 7A ; inline -: VK_F12 HEX: 7B ; inline -: VK_F13 HEX: 7C ; inline -: VK_F14 HEX: 7D ; inline -: VK_F15 HEX: 7E ; inline -: VK_F16 HEX: 7F ; inline -: VK_F17 HEX: 80 ; inline -: VK_F18 HEX: 81 ; inline -: VK_F19 HEX: 82 ; inline -: VK_F20 HEX: 83 ; inline -: VK_F21 HEX: 84 ; inline -: VK_F22 HEX: 85 ; inline -: VK_F23 HEX: 86 ; inline -: VK_F24 HEX: 87 ; inline +CONSTANT: VK_NUMPAD0 HEX: 60 +CONSTANT: VK_NUMPAD1 HEX: 61 +CONSTANT: VK_NUMPAD2 HEX: 62 +CONSTANT: VK_NUMPAD3 HEX: 63 +CONSTANT: VK_NUMPAD4 HEX: 64 +CONSTANT: VK_NUMPAD5 HEX: 65 +CONSTANT: VK_NUMPAD6 HEX: 66 +CONSTANT: VK_NUMPAD7 HEX: 67 +CONSTANT: VK_NUMPAD8 HEX: 68 +CONSTANT: VK_NUMPAD9 HEX: 69 +CONSTANT: VK_MULTIPLY HEX: 6A +CONSTANT: VK_ADD HEX: 6B +CONSTANT: VK_SEPARATOR HEX: 6C +CONSTANT: VK_SUBTRACT HEX: 6D +CONSTANT: VK_DECIMAL HEX: 6E +CONSTANT: VK_DIVIDE HEX: 6F +CONSTANT: VK_F1 HEX: 70 +CONSTANT: VK_F2 HEX: 71 +CONSTANT: VK_F3 HEX: 72 +CONSTANT: VK_F4 HEX: 73 +CONSTANT: VK_F5 HEX: 74 +CONSTANT: VK_F6 HEX: 75 +CONSTANT: VK_F7 HEX: 76 +CONSTANT: VK_F8 HEX: 77 +CONSTANT: VK_F9 HEX: 78 +CONSTANT: VK_F10 HEX: 79 +CONSTANT: VK_F11 HEX: 7A +CONSTANT: VK_F12 HEX: 7B +CONSTANT: VK_F13 HEX: 7C +CONSTANT: VK_F14 HEX: 7D +CONSTANT: VK_F15 HEX: 7E +CONSTANT: VK_F16 HEX: 7F +CONSTANT: VK_F17 HEX: 80 +CONSTANT: VK_F18 HEX: 81 +CONSTANT: VK_F19 HEX: 82 +CONSTANT: VK_F20 HEX: 83 +CONSTANT: VK_F21 HEX: 84 +CONSTANT: VK_F22 HEX: 85 +CONSTANT: VK_F23 HEX: 86 +CONSTANT: VK_F24 HEX: 87 ! 0x88 - 0x8F : unassigned -: VK_NUMLOCK HEX: 90 ; inline -: VK_SCROLL HEX: 91 ; inline +CONSTANT: VK_NUMLOCK HEX: 90 +CONSTANT: VK_SCROLL HEX: 91 ! NEC PC-9800 kbd definitions -: VK_OEM_NEC_EQUAL HEX: 92 ; inline ! '=' key on numpad +CONSTANT: VK_OEM_NEC_EQUAL HEX: 92 ! '=' key on numpad ! Fujitsu/OASYS kbd definitions -: VK_OEM_FJ_JISHO HEX: 92 ; inline ! 'Dictionary' key -: VK_OEM_FJ_MASSHOU HEX: 93 ; inline ! 'Unregister word' key -: VK_OEM_FJ_TOUROKU HEX: 94 ; inline ! 'Register word' key -: VK_OEM_FJ_LOYA HEX: 95 ; inline ! 'Left OYAYUBI' key -: VK_OEM_FJ_ROYA HEX: 96 ; inline ! 'Right OYAYUBI' key +CONSTANT: VK_OEM_FJ_JISHO HEX: 92 ! 'Dictionary' key +CONSTANT: VK_OEM_FJ_MASSHOU HEX: 93 ! 'Unregister word' key +CONSTANT: VK_OEM_FJ_TOUROKU HEX: 94 ! 'Register word' key +CONSTANT: VK_OEM_FJ_LOYA HEX: 95 ! 'Left OYAYUBI' key +CONSTANT: VK_OEM_FJ_ROYA HEX: 96 ! 'Right OYAYUBI' key ! 0x97 - 0x9F : unassigned ! VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys. ! Used only as parameters to GetAsyncKeyState() and GetKeyState(). ! No other API or message will distinguish left and right keys in this way. -: VK_LSHIFT HEX: A0 ; inline -: VK_RSHIFT HEX: A1 ; inline -: VK_LCONTROL HEX: A2 ; inline -: VK_RCONTROL HEX: A3 ; inline -: VK_LMENU HEX: A4 ; inline -: VK_RMENU HEX: A5 ; inline +CONSTANT: VK_LSHIFT HEX: A0 +CONSTANT: VK_RSHIFT HEX: A1 +CONSTANT: VK_LCONTROL HEX: A2 +CONSTANT: VK_RCONTROL HEX: A3 +CONSTANT: VK_LMENU HEX: A4 +CONSTANT: VK_RMENU HEX: A5 -: VK_BROWSER_BACK HEX: A6 ; inline -: VK_BROWSER_FORWARD HEX: A7 ; inline -: VK_BROWSER_REFRESH HEX: A8 ; inline -: VK_BROWSER_STOP HEX: A9 ; inline -: VK_BROWSER_SEARCH HEX: AA ; inline -: VK_BROWSER_FAVORITES HEX: AB ; inline -: VK_BROWSER_HOME HEX: AC ; inline +CONSTANT: VK_BROWSER_BACK HEX: A6 +CONSTANT: VK_BROWSER_FORWARD HEX: A7 +CONSTANT: VK_BROWSER_REFRESH HEX: A8 +CONSTANT: VK_BROWSER_STOP HEX: A9 +CONSTANT: VK_BROWSER_SEARCH HEX: AA +CONSTANT: VK_BROWSER_FAVORITES HEX: AB +CONSTANT: VK_BROWSER_HOME HEX: AC -: VK_VOLUME_MUTE HEX: AD ; inline -: VK_VOLUME_DOWN HEX: AE ; inline -: VK_VOLUME_UP HEX: AF ; inline -: VK_MEDIA_NEXT_TRACK HEX: B0 ; inline -: VK_MEDIA_PREV_TRACK HEX: B1 ; inline -: VK_MEDIA_STOP HEX: B2 ; inline -: VK_MEDIA_PLAY_PAUSE HEX: B3 ; inline -: VK_LAUNCH_MAIL HEX: B4 ; inline -: VK_LAUNCH_MEDIA_SELECT HEX: B5 ; inline -: VK_LAUNCH_APP1 HEX: B6 ; inline -: VK_LAUNCH_APP2 HEX: B7 ; inline +CONSTANT: VK_VOLUME_MUTE HEX: AD +CONSTANT: VK_VOLUME_DOWN HEX: AE +CONSTANT: VK_VOLUME_UP HEX: AF +CONSTANT: VK_MEDIA_NEXT_TRACK HEX: B0 +CONSTANT: VK_MEDIA_PREV_TRACK HEX: B1 +CONSTANT: VK_MEDIA_STOP HEX: B2 +CONSTANT: VK_MEDIA_PLAY_PAUSE HEX: B3 +CONSTANT: VK_LAUNCH_MAIL HEX: B4 +CONSTANT: VK_LAUNCH_MEDIA_SELECT HEX: B5 +CONSTANT: VK_LAUNCH_APP1 HEX: B6 +CONSTANT: VK_LAUNCH_APP2 HEX: B7 ! 0xB8 - 0xB9 : reserved -: VK_OEM_1 HEX: BA ; inline ! ';:' for US -: VK_OEM_PLUS HEX: BB ; inline ! '+' any country -: VK_OEM_COMMA HEX: BC ; inline ! ',' any country -: VK_OEM_MINUS HEX: BD ; inline ! '-' any country -: VK_OEM_PERIOD HEX: BE ; inline ! '.' any country -: VK_OEM_2 HEX: BF ; inline ! '/?' for US -: VK_OEM_3 HEX: C0 ; inline ! '`~' for US +CONSTANT: VK_OEM_1 HEX: BA ! ';:' for US +CONSTANT: VK_OEM_PLUS HEX: BB ! '+' any country +CONSTANT: VK_OEM_COMMA HEX: BC ! ',' any country +CONSTANT: VK_OEM_MINUS HEX: BD ! '-' any country +CONSTANT: VK_OEM_PERIOD HEX: BE ! '.' any country +CONSTANT: VK_OEM_2 HEX: BF ! '/?' for US +CONSTANT: VK_OEM_3 HEX: C0 ! '`~' for US ! 0xC1 - 0xD7 : reserved ! 0xD8 - 0xDA : unassigned -: VK_OEM_4 HEX: DB ; inline ! '[{' for US -: VK_OEM_5 HEX: DC ; inline ! '\|' for US -: VK_OEM_6 HEX: DD ; inline ! ']}' for US -: VK_OEM_7 HEX: DE ; inline ! ''"' for US -: VK_OEM_8 HEX: DF ; inline +CONSTANT: VK_OEM_4 HEX: DB ! '[{' for US +CONSTANT: VK_OEM_5 HEX: DC ! '\|' for US +CONSTANT: VK_OEM_6 HEX: DD ! ']}' for US +CONSTANT: VK_OEM_7 HEX: DE ! ''"' for US +CONSTANT: VK_OEM_8 HEX: DF ! 0xE0 : reserved ! Various extended or enhanced keyboards -: VK_OEM_AX HEX: E1 ; inline ! 'AX' key on Japanese AX kbd -: VK_OEM_102 HEX: E2 ; inline ! "<>" or "\|" on RT 102-key kbd. -: VK_ICO_HELP HEX: E3 ; inline ! Help key on ICO -: VK_ICO_00 HEX: E4 ; inline ! 00 key on ICO +CONSTANT: VK_OEM_AX HEX: E1 ! 'AX' key on Japanese AX kbd +CONSTANT: VK_OEM_102 HEX: E2 ! "<>" or "\|" on RT 102-key kbd. +CONSTANT: VK_ICO_HELP HEX: E3 ! Help key on ICO +CONSTANT: VK_ICO_00 HEX: E4 ! 00 key on ICO -: VK_PROCESSKEY HEX: E5 ; inline +CONSTANT: VK_PROCESSKEY HEX: E5 -: VK_ICO_CLEAR HEX: E6 ; inline +CONSTANT: VK_ICO_CLEAR HEX: E6 -: VK_PACKET HEX: E7 ; inline +CONSTANT: VK_PACKET HEX: E7 ! 0xE8 : unassigned ! Nokia/Ericsson definitions -: VK_OEM_RESET HEX: E9 ; inline -: VK_OEM_JUMP HEX: EA ; inline -: VK_OEM_PA1 HEX: EB ; inline -: VK_OEM_PA2 HEX: EC ; inline -: VK_OEM_PA3 HEX: ED ; inline -: VK_OEM_WSCTRL HEX: EE ; inline -: VK_OEM_CUSEL HEX: EF ; inline -: VK_OEM_ATTN HEX: F0 ; inline -: VK_OEM_FINISH HEX: F1 ; inline -: VK_OEM_COPY HEX: F2 ; inline -: VK_OEM_AUTO HEX: F3 ; inline -: VK_OEM_ENLW HEX: F4 ; inline -: VK_OEM_BACKTAB HEX: F5 ; inline +CONSTANT: VK_OEM_RESET HEX: E9 +CONSTANT: VK_OEM_JUMP HEX: EA +CONSTANT: VK_OEM_PA1 HEX: EB +CONSTANT: VK_OEM_PA2 HEX: EC +CONSTANT: VK_OEM_PA3 HEX: ED +CONSTANT: VK_OEM_WSCTRL HEX: EE +CONSTANT: VK_OEM_CUSEL HEX: EF +CONSTANT: VK_OEM_ATTN HEX: F0 +CONSTANT: VK_OEM_FINISH HEX: F1 +CONSTANT: VK_OEM_COPY HEX: F2 +CONSTANT: VK_OEM_AUTO HEX: F3 +CONSTANT: VK_OEM_ENLW HEX: F4 +CONSTANT: VK_OEM_BACKTAB HEX: F5 -: VK_ATTN HEX: F6 ; inline -: VK_CRSEL HEX: F7 ; inline -: VK_EXSEL HEX: F8 ; inline -: VK_EREOF HEX: F9 ; inline -: VK_PLAY HEX: FA ; inline -: VK_ZOOM HEX: FB ; inline -: VK_NONAME HEX: FC ; inline -: VK_PA1 HEX: FD ; inline -: VK_OEM_CLEAR HEX: FE ; inline +CONSTANT: VK_ATTN HEX: F6 +CONSTANT: VK_CRSEL HEX: F7 +CONSTANT: VK_EXSEL HEX: F8 +CONSTANT: VK_EREOF HEX: F9 +CONSTANT: VK_PLAY HEX: FA +CONSTANT: VK_ZOOM HEX: FB +CONSTANT: VK_NONAME HEX: FC +CONSTANT: VK_PA1 HEX: FD +CONSTANT: VK_OEM_CLEAR HEX: FE ! 0xFF : reserved ! Key State Masks for Mouse Messages -: MK_LBUTTON HEX: 0001 ; inline -: MK_RBUTTON HEX: 0002 ; inline -: MK_SHIFT HEX: 0004 ; inline -: MK_CONTROL HEX: 0008 ; inline -: MK_MBUTTON HEX: 0010 ; inline -: MK_XBUTTON1 HEX: 0020 ; inline -: MK_XBUTTON2 HEX: 0040 ; inline +CONSTANT: MK_LBUTTON HEX: 0001 +CONSTANT: MK_RBUTTON HEX: 0002 +CONSTANT: MK_SHIFT HEX: 0004 +CONSTANT: MK_CONTROL HEX: 0008 +CONSTANT: MK_MBUTTON HEX: 0010 +CONSTANT: MK_XBUTTON1 HEX: 0020 +CONSTANT: MK_XBUTTON2 HEX: 0040 ! Some fields are not defined for win64 ! Window field offsets for GetWindowLong() -: GWL_WNDPROC -4 ; inline -: GWL_HINSTANCE -6 ; inline -: GWL_HWNDPARENT -8 ; inline -: GWL_USERDATA -21 ; inline -: GWL_ID -12 ; inline +CONSTANT: GWL_WNDPROC -4 +CONSTANT: GWL_HINSTANCE -6 +CONSTANT: GWL_HWNDPARENT -8 +CONSTANT: GWL_USERDATA -21 +CONSTANT: GWL_ID -12 -: GWL_STYLE -16 ; inline -: GWL_EXSTYLE -20 ; inline +CONSTANT: GWL_STYLE -16 +CONSTANT: GWL_EXSTYLE -20 -: GWLP_WNDPROC -4 ; inline -: GWLP_HINSTANCE -6 ; inline -: GWLP_HWNDPARENT -8 ; inline -: GWLP_USERDATA -21 ; inline -: GWLP_ID -12 ; inline +CONSTANT: GWLP_WNDPROC -4 +CONSTANT: GWLP_HINSTANCE -6 +CONSTANT: GWLP_HWNDPARENT -8 +CONSTANT: GWLP_USERDATA -21 +CONSTANT: GWLP_ID -12 ! Class field offsets for GetClassLong() -: GCL_MENUNAME -8 ; inline -: GCL_HBRBACKGROUND -10 ; inline -: GCL_HCURSOR -12 ; inline -: GCL_HICON -14 ; inline -: GCL_HMODULE -16 ; inline -: GCL_WNDPROC -24 ; inline -: GCL_HICONSM -34 ; inline -: GCL_CBWNDEXTRA -18 ; inline -: GCL_CBCLSEXTRA -20 ; inline -: GCL_STYLE -26 ; inline -: GCW_ATOM -32 ; inline +CONSTANT: GCL_MENUNAME -8 +CONSTANT: GCL_HBRBACKGROUND -10 +CONSTANT: GCL_HCURSOR -12 +CONSTANT: GCL_HICON -14 +CONSTANT: GCL_HMODULE -16 +CONSTANT: GCL_WNDPROC -24 +CONSTANT: GCL_HICONSM -34 +CONSTANT: GCL_CBWNDEXTRA -18 +CONSTANT: GCL_CBCLSEXTRA -20 +CONSTANT: GCL_STYLE -26 +CONSTANT: GCW_ATOM -32 -: GCLP_MENUNAME -8 ; inline -: GCLP_HBRBACKGROUND -10 ; inline -: GCLP_HCURSOR -12 ; inline -: GCLP_HICON -14 ; inline -: GCLP_HMODULE -16 ; inline -: GCLP_WNDPROC -24 ; inline -: GCLP_HICONSM -34 ; inline +CONSTANT: GCLP_MENUNAME -8 +CONSTANT: GCLP_HBRBACKGROUND -10 +CONSTANT: GCLP_HCURSOR -12 +CONSTANT: GCLP_HICON -14 +CONSTANT: GCLP_HMODULE -16 +CONSTANT: GCLP_WNDPROC -24 +CONSTANT: GCLP_HICONSM -34 -: MB_ICONASTERISK HEX: 00000040 ; inline -: MB_ICONEXCLAMATION HEX: 00000030 ; inline -: MB_ICONHAND HEX: 00000010 ; inline -: MB_ICONQUESTION HEX: 00000020 ; inline -: MB_OK HEX: 00000000 ; inline +CONSTANT: MB_ICONASTERISK HEX: 00000040 +CONSTANT: MB_ICONEXCLAMATION HEX: 00000030 +CONSTANT: MB_ICONHAND HEX: 00000010 +CONSTANT: MB_ICONQUESTION HEX: 00000020 +CONSTANT: MB_OK HEX: 00000000 ALIAS: FVIRTKEY TRUE -: FNOINVERT 2 ; inline -: FSHIFT 4 ; inline -: FCONTROL 8 ; inline -: FALT 16 ; inline +CONSTANT: FNOINVERT 2 +CONSTANT: FSHIFT 4 +CONSTANT: FCONTROL 8 +CONSTANT: FALT 16 -: MAPVK_VK_TO_VSC 0 ; inline -: MAPVK_VSC_TO_VK 1 ; inline -: MAPVK_VK_TO_CHAR 2 ; inline -: MAPVK_VSC_TO_VK_EX 3 ; inline -: MAPVK_VK_TO_VSC_EX 3 ; inline +CONSTANT: MAPVK_VK_TO_VSC 0 +CONSTANT: MAPVK_VSC_TO_VK 1 +CONSTANT: MAPVK_VK_TO_CHAR 2 +CONSTANT: MAPVK_VSC_TO_VK_EX 3 +CONSTANT: MAPVK_VK_TO_VSC_EX 3 -: TME_HOVER 1 ; inline -: TME_LEAVE 2 ; inline -: TME_NONCLIENT 16 ; inline -: TME_QUERY HEX: 40000000 ; inline -: TME_CANCEL HEX: 80000000 ; inline -: HOVER_DEFAULT HEX: ffffffff ; inline +CONSTANT: TME_HOVER 1 +CONSTANT: TME_LEAVE 2 +CONSTANT: TME_NONCLIENT 16 +CONSTANT: TME_QUERY HEX: 40000000 +CONSTANT: TME_CANCEL HEX: 80000000 +CONSTANT: HOVER_DEFAULT HEX: ffffffff C-STRUCT: TRACKMOUSEEVENT { "DWORD" "cbSize" } { "DWORD" "dwFlags" } @@ -528,15 +528,15 @@ C-STRUCT: TRACKMOUSEEVENT { "DWORD" "dwHoverTime" } ; TYPEDEF: TRACKMOUSEEVENT* LPTRACKMOUSEEVENT -: DBT_DEVICEARRIVAL HEX: 8000 ; inline -: DBT_DEVICEREMOVECOMPLETE HEX: 8004 ; inline +CONSTANT: DBT_DEVICEARRIVAL HEX: 8000 +CONSTANT: DBT_DEVICEREMOVECOMPLETE HEX: 8004 -: DBT_DEVTYP_DEVICEINTERFACE 5 ; inline +CONSTANT: DBT_DEVTYP_DEVICEINTERFACE 5 -: DEVICE_NOTIFY_WINDOW_HANDLE 0 ; inline -: DEVICE_NOTIFY_SERVICE_HANDLE 1 ; inline +CONSTANT: DEVICE_NOTIFY_WINDOW_HANDLE 0 +CONSTANT: DEVICE_NOTIFY_SERVICE_HANDLE 1 -: DEVICE_NOTIFY_ALL_INTERFACE_CLASSES 4 ; inline +CONSTANT: DEVICE_NOTIFY_ALL_INTERFACE_CLASSES 4 C-STRUCT: DEV_BROADCAST_HDR { "DWORD" "dbch_size" } @@ -672,7 +672,6 @@ ALIAS: CreateWindowEx CreateWindowExW : CreateWindow ( a b c d e f g h i j k -- hwnd ) 0 12 -nrot CreateWindowEx ; inline - ! FUNCTION: CreateWindowStationA ! FUNCTION: CreateWindowStationW ! FUNCTION: CsrBroadcastSystemMessageExW From 2f868b38c2796031c9bb2794b4db519288ef100d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 18:12:54 -0600 Subject: [PATCH 099/119] more CONSTANT: usage --- basis/windows/kernel32/kernel32.factor | 2 +- basis/windows/ole32/ole32.factor | 108 ++++++++++++------------ basis/windows/opengl32/opengl32.factor | 110 ++++++++++++------------- basis/windows/shell32/shell32.factor | 6 +- basis/windows/types/types.factor | 6 +- basis/windows/windows.factor | 2 +- 6 files changed, 117 insertions(+), 117 deletions(-) diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index 3494e83e83..8a271f7210 100755 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -1226,7 +1226,7 @@ FUNCTION: BOOL GetExitCodeProcess ( HANDLE hProcess, LPDWORD lpExitCode ) ; FUNCTION: DWORD GetFileAttributesW ( LPCTSTR lpFileName ) ; ! FUNCTION: GetFileAttributesExA -: GetFileExInfoStandard 0 ; inline +CONSTANT: GetFileExInfoStandard 0 FUNCTION: BOOL GetFileAttributesExW ( LPCTSTR lpFileName, GET_FILEEX_INFO_LEVELS fInfoLevelId, LPVOID lpFileInformation ) ; diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor index 3d080817bf..e69a9213b0 100755 --- a/basis/windows/ole32/ole32.factor +++ b/basis/windows/ole32/ole32.factor @@ -20,61 +20,61 @@ FUNCTION: BOOL IsEqualGUID ( REFGUID rguid1, REFGUID rguid2 ) ; FUNCTION: int StringFromGUID2 ( REFGUID rguid, LPOLESTR lpsz, int cchMax ) ; FUNCTION: HRESULT CLSIDFromString ( LPOLESTR lpsz, REFGUID out_rguid ) ; -: S_OK 0 ; inline -: S_FALSE 1 ; inline -: E_NOINTERFACE HEX: 80004002 ; inline -: E_FAIL HEX: 80004005 ; inline -: E_INVALIDARG HEX: 80070057 ; inline +CONSTANT: S_OK 0 +CONSTANT: S_FALSE 1 +CONSTANT: E_NOINTERFACE HEX: 80004002 +CONSTANT: E_FAIL HEX: 80004005 +CONSTANT: E_INVALIDARG HEX: 80070057 -: MK_ALT HEX: 20 ; inline -: DROPEFFECT_NONE 0 ; inline -: DROPEFFECT_COPY 1 ; inline -: DROPEFFECT_MOVE 2 ; inline -: DROPEFFECT_LINK 4 ; inline -: DROPEFFECT_SCROLL HEX: 80000000 ; inline -: DD_DEFSCROLLINSET 11 ; inline -: DD_DEFSCROLLDELAY 50 ; inline -: DD_DEFSCROLLINTERVAL 50 ; inline -: DD_DEFDRAGDELAY 200 ; inline -: DD_DEFDRAGMINDIST 2 ; inline +CONSTANT: MK_ALT HEX: 20 +CONSTANT: DROPEFFECT_NONE 0 +CONSTANT: DROPEFFECT_COPY 1 +CONSTANT: DROPEFFECT_MOVE 2 +CONSTANT: DROPEFFECT_LINK 4 +CONSTANT: DROPEFFECT_SCROLL HEX: 80000000 +CONSTANT: DD_DEFSCROLLINSET 11 +CONSTANT: DD_DEFSCROLLDELAY 50 +CONSTANT: DD_DEFSCROLLINTERVAL 50 +CONSTANT: DD_DEFDRAGDELAY 200 +CONSTANT: DD_DEFDRAGMINDIST 2 -: CF_TEXT 1 ; inline -: CF_BITMAP 2 ; inline -: CF_METAFILEPICT 3 ; inline -: CF_SYLK 4 ; inline -: CF_DIF 5 ; inline -: CF_TIFF 6 ; inline -: CF_OEMTEXT 7 ; inline -: CF_DIB 8 ; inline -: CF_PALETTE 9 ; inline -: CF_PENDATA 10 ; inline -: CF_RIFF 11 ; inline -: CF_WAVE 12 ; inline -: CF_UNICODETEXT 13 ; inline -: CF_ENHMETAFILE 14 ; inline -: CF_HDROP 15 ; inline -: CF_LOCALE 16 ; inline -: CF_MAX 17 ; inline +CONSTANT: CF_TEXT 1 +CONSTANT: CF_BITMAP 2 +CONSTANT: CF_METAFILEPICT 3 +CONSTANT: CF_SYLK 4 +CONSTANT: CF_DIF 5 +CONSTANT: CF_TIFF 6 +CONSTANT: CF_OEMTEXT 7 +CONSTANT: CF_DIB 8 +CONSTANT: CF_PALETTE 9 +CONSTANT: CF_PENDATA 10 +CONSTANT: CF_RIFF 11 +CONSTANT: CF_WAVE 12 +CONSTANT: CF_UNICODETEXT 13 +CONSTANT: CF_ENHMETAFILE 14 +CONSTANT: CF_HDROP 15 +CONSTANT: CF_LOCALE 16 +CONSTANT: CF_MAX 17 -: CF_OWNERDISPLAY HEX: 0080 ; inline -: CF_DSPTEXT HEX: 0081 ; inline -: CF_DSPBITMAP HEX: 0082 ; inline -: CF_DSPMETAFILEPICT HEX: 0083 ; inline -: CF_DSPENHMETAFILE HEX: 008E ; inline +CONSTANT: CF_OWNERDISPLAY HEX: 0080 +CONSTANT: CF_DSPTEXT HEX: 0081 +CONSTANT: CF_DSPBITMAP HEX: 0082 +CONSTANT: CF_DSPMETAFILEPICT HEX: 0083 +CONSTANT: CF_DSPENHMETAFILE HEX: 008E -: DVASPECT_CONTENT 1 ; inline -: DVASPECT_THUMBNAIL 2 ; inline -: DVASPECT_ICON 4 ; inline -: DVASPECT_DOCPRINT 8 ; inline +CONSTANT: DVASPECT_CONTENT 1 +CONSTANT: DVASPECT_THUMBNAIL 2 +CONSTANT: DVASPECT_ICON 4 +CONSTANT: DVASPECT_DOCPRINT 8 -: TYMED_HGLOBAL 1 ; inline -: TYMED_FILE 2 ; inline -: TYMED_ISTREAM 4 ; inline -: TYMED_ISTORAGE 8 ; inline -: TYMED_GDI 16 ; inline -: TYMED_MFPICT 32 ; inline -: TYMED_ENHMF 64 ; inline -: TYMED_NULL 0 ; inline +CONSTANT: TYMED_HGLOBAL 1 +CONSTANT: TYMED_FILE 2 +CONSTANT: TYMED_ISTREAM 4 +CONSTANT: TYMED_ISTORAGE 8 +CONSTANT: TYMED_GDI 16 +CONSTANT: TYMED_MFPICT 32 +CONSTANT: TYMED_ENHMF 64 +CONSTANT: TYMED_NULL 0 C-STRUCT: DVTARGETDEVICE { "DWORD" "tdSize" } @@ -101,10 +101,10 @@ C-STRUCT: STGMEDIUM { "LPUNKNOWN" "punkForRelease" } ; TYPEDEF: STGMEDIUM* LPSTGMEDIUM -: COINIT_MULTITHREADED 0 ; inline -: COINIT_APARTMENTTHREADED 2 ; inline -: COINIT_DISABLE_OLE1DDE 4 ; inline -: COINIT_SPEED_OVER_MEMORY 8 ; inline +CONSTANT: COINIT_MULTITHREADED 0 +CONSTANT: COINIT_APARTMENTTHREADED 2 +CONSTANT: COINIT_DISABLE_OLE1DDE 4 +CONSTANT: COINIT_SPEED_OVER_MEMORY 8 FUNCTION: HRESULT OleInitialize ( void* reserved ) ; FUNCTION: HRESULT CoInitializeEx ( void* reserved, DWORD dwCoInit ) ; diff --git a/basis/windows/opengl32/opengl32.factor b/basis/windows/opengl32/opengl32.factor index 63384e8858..d0b396eba2 100755 --- a/basis/windows/opengl32/opengl32.factor +++ b/basis/windows/opengl32/opengl32.factor @@ -6,70 +6,70 @@ sequences libc ; IN: windows.opengl32 ! PIXELFORMATDESCRIPTOR flags -: PFD_DOUBLEBUFFER HEX: 00000001 ; inline -: PFD_STEREO HEX: 00000002 ; inline -: PFD_DRAW_TO_WINDOW HEX: 00000004 ; inline -: PFD_DRAW_TO_BITMAP HEX: 00000008 ; inline -: PFD_SUPPORT_GDI HEX: 00000010 ; inline -: PFD_SUPPORT_OPENGL HEX: 00000020 ; inline -: PFD_GENERIC_FORMAT HEX: 00000040 ; inline -: PFD_NEED_PALETTE HEX: 00000080 ; inline -: PFD_NEED_SYSTEM_PALETTE HEX: 00000100 ; inline -: PFD_SWAP_EXCHANGE HEX: 00000200 ; inline -: PFD_SWAP_COPY HEX: 00000400 ; inline -: PFD_SWAP_LAYER_BUFFERS HEX: 00000800 ; inline -: PFD_GENERIC_ACCELERATED HEX: 00001000 ; inline -: PFD_SUPPORT_DIRECTDRAW HEX: 00002000 ; inline +CONSTANT: PFD_DOUBLEBUFFER HEX: 00000001 +CONSTANT: PFD_STEREO HEX: 00000002 +CONSTANT: PFD_DRAW_TO_WINDOW HEX: 00000004 +CONSTANT: PFD_DRAW_TO_BITMAP HEX: 00000008 +CONSTANT: PFD_SUPPORT_GDI HEX: 00000010 +CONSTANT: PFD_SUPPORT_OPENGL HEX: 00000020 +CONSTANT: PFD_GENERIC_FORMAT HEX: 00000040 +CONSTANT: PFD_NEED_PALETTE HEX: 00000080 +CONSTANT: PFD_NEED_SYSTEM_PALETTE HEX: 00000100 +CONSTANT: PFD_SWAP_EXCHANGE HEX: 00000200 +CONSTANT: PFD_SWAP_COPY HEX: 00000400 +CONSTANT: PFD_SWAP_LAYER_BUFFERS HEX: 00000800 +CONSTANT: PFD_GENERIC_ACCELERATED HEX: 00001000 +CONSTANT: PFD_SUPPORT_DIRECTDRAW HEX: 00002000 ! PIXELFORMATDESCRIPTOR flags for use in ChoosePixelFormat only -: PFD_DEPTH_DONTCARE HEX: 20000000 ; inline -: PFD_DOUBLEBUFFER_DONTCARE HEX: 40000000 ; inline -: PFD_STEREO_DONTCARE HEX: 80000000 ; inline +CONSTANT: PFD_DEPTH_DONTCARE HEX: 20000000 +CONSTANT: PFD_DOUBLEBUFFER_DONTCARE HEX: 40000000 +CONSTANT: PFD_STEREO_DONTCARE HEX: 80000000 ! pixel types -: PFD_TYPE_RGBA 0 ; inline -: PFD_TYPE_COLORINDEX 1 ; inline +CONSTANT: PFD_TYPE_RGBA 0 +CONSTANT: PFD_TYPE_COLORINDEX 1 ! layer types -: PFD_MAIN_PLANE 0 ; inline -: PFD_OVERLAY_PLANE 1 ; inline -: PFD_UNDERLAY_PLANE -1 ; inline +CONSTANT: PFD_MAIN_PLANE 0 +CONSTANT: PFD_OVERLAY_PLANE 1 +CONSTANT: PFD_UNDERLAY_PLANE -1 -: LPD_TYPE_RGBA 0 ; inline -: LPD_TYPE_COLORINDEX 1 ; inline +CONSTANT: LPD_TYPE_RGBA 0 +CONSTANT: LPD_TYPE_COLORINDEX 1 ! wglSwapLayerBuffers flags -: WGL_SWAP_MAIN_PLANE HEX: 00000001 ; inline -: WGL_SWAP_OVERLAY1 HEX: 00000002 ; inline -: WGL_SWAP_OVERLAY2 HEX: 00000004 ; inline -: WGL_SWAP_OVERLAY3 HEX: 00000008 ; inline -: WGL_SWAP_OVERLAY4 HEX: 00000010 ; inline -: WGL_SWAP_OVERLAY5 HEX: 00000020 ; inline -: WGL_SWAP_OVERLAY6 HEX: 00000040 ; inline -: WGL_SWAP_OVERLAY7 HEX: 00000080 ; inline -: WGL_SWAP_OVERLAY8 HEX: 00000100 ; inline -: WGL_SWAP_OVERLAY9 HEX: 00000200 ; inline -: WGL_SWAP_OVERLAY10 HEX: 00000400 ; inline -: WGL_SWAP_OVERLAY11 HEX: 00000800 ; inline -: WGL_SWAP_OVERLAY12 HEX: 00001000 ; inline -: WGL_SWAP_OVERLAY13 HEX: 00002000 ; inline -: WGL_SWAP_OVERLAY14 HEX: 00004000 ; inline -: WGL_SWAP_OVERLAY15 HEX: 00008000 ; inline -: WGL_SWAP_UNDERLAY1 HEX: 00010000 ; inline -: WGL_SWAP_UNDERLAY2 HEX: 00020000 ; inline -: WGL_SWAP_UNDERLAY3 HEX: 00040000 ; inline -: WGL_SWAP_UNDERLAY4 HEX: 00080000 ; inline -: WGL_SWAP_UNDERLAY5 HEX: 00100000 ; inline -: WGL_SWAP_UNDERLAY6 HEX: 00200000 ; inline -: WGL_SWAP_UNDERLAY7 HEX: 00400000 ; inline -: WGL_SWAP_UNDERLAY8 HEX: 00800000 ; inline -: WGL_SWAP_UNDERLAY9 HEX: 01000000 ; inline -: WGL_SWAP_UNDERLAY10 HEX: 02000000 ; inline -: WGL_SWAP_UNDERLAY11 HEX: 04000000 ; inline -: WGL_SWAP_UNDERLAY12 HEX: 08000000 ; inline -: WGL_SWAP_UNDERLAY13 HEX: 10000000 ; inline -: WGL_SWAP_UNDERLAY14 HEX: 20000000 ; inline -: WGL_SWAP_UNDERLAY15 HEX: 40000000 ; inline +CONSTANT: WGL_SWAP_MAIN_PLANE HEX: 00000001 +CONSTANT: WGL_SWAP_OVERLAY1 HEX: 00000002 +CONSTANT: WGL_SWAP_OVERLAY2 HEX: 00000004 +CONSTANT: WGL_SWAP_OVERLAY3 HEX: 00000008 +CONSTANT: WGL_SWAP_OVERLAY4 HEX: 00000010 +CONSTANT: WGL_SWAP_OVERLAY5 HEX: 00000020 +CONSTANT: WGL_SWAP_OVERLAY6 HEX: 00000040 +CONSTANT: WGL_SWAP_OVERLAY7 HEX: 00000080 +CONSTANT: WGL_SWAP_OVERLAY8 HEX: 00000100 +CONSTANT: WGL_SWAP_OVERLAY9 HEX: 00000200 +CONSTANT: WGL_SWAP_OVERLAY10 HEX: 00000400 +CONSTANT: WGL_SWAP_OVERLAY11 HEX: 00000800 +CONSTANT: WGL_SWAP_OVERLAY12 HEX: 00001000 +CONSTANT: WGL_SWAP_OVERLAY13 HEX: 00002000 +CONSTANT: WGL_SWAP_OVERLAY14 HEX: 00004000 +CONSTANT: WGL_SWAP_OVERLAY15 HEX: 00008000 +CONSTANT: WGL_SWAP_UNDERLAY1 HEX: 00010000 +CONSTANT: WGL_SWAP_UNDERLAY2 HEX: 00020000 +CONSTANT: WGL_SWAP_UNDERLAY3 HEX: 00040000 +CONSTANT: WGL_SWAP_UNDERLAY4 HEX: 00080000 +CONSTANT: WGL_SWAP_UNDERLAY5 HEX: 00100000 +CONSTANT: WGL_SWAP_UNDERLAY6 HEX: 00200000 +CONSTANT: WGL_SWAP_UNDERLAY7 HEX: 00400000 +CONSTANT: WGL_SWAP_UNDERLAY8 HEX: 00800000 +CONSTANT: WGL_SWAP_UNDERLAY9 HEX: 01000000 +CONSTANT: WGL_SWAP_UNDERLAY10 HEX: 02000000 +CONSTANT: WGL_SWAP_UNDERLAY11 HEX: 04000000 +CONSTANT: WGL_SWAP_UNDERLAY12 HEX: 08000000 +CONSTANT: WGL_SWAP_UNDERLAY13 HEX: 10000000 +CONSTANT: WGL_SWAP_UNDERLAY14 HEX: 20000000 +CONSTANT: WGL_SWAP_UNDERLAY15 HEX: 40000000 : windowed-pfd-dwFlags ( -- n ) { PFD_DRAW_TO_WINDOW PFD_SUPPORT_OPENGL PFD_DOUBLEBUFFER } flags ; diff --git a/basis/windows/shell32/shell32.factor b/basis/windows/shell32/shell32.factor index c8dbe4b91c..7802ceb297 100644 --- a/basis/windows/shell32/shell32.factor +++ b/basis/windows/shell32/shell32.factor @@ -190,9 +190,9 @@ TYPEDEF: ITEMIDLIST ITEMID_CHILD TYPEDEF: ITEMID_CHILD* PITEMID_CHILD TYPEDEF: ITEMID_CHILD* PCUITEMID_CHILD -: STRRET_WSTR 0 ; inline -: STRRET_OFFSET 1 ; inline -: STRRET_CSTR 2 ; inline +CONSTANT: STRRET_WSTR 0 +CONSTANT: STRRET_OFFSET 1 +CONSTANT: STRRET_CSTR 2 C-UNION: STRRET-union "LPWSTR" "LPSTR" "UINT" "char[260]" ; C-STRUCT: STRRET diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor index 8cc18d4039..ee74e47fea 100755 --- a/basis/windows/types/types.factor +++ b/basis/windows/types/types.factor @@ -205,10 +205,10 @@ TYPEDEF: size_t socklen_t TYPEDEF: void* WNDPROC -: FALSE 0 ; inline -: TRUE 1 ; inline +CONSTANT: FALSE 0 +CONSTANT: TRUE 1 -: >BOOLEAN ( ? -- 1/0 ) 1 0 ? ; inline +: >BOOLEAN ( ? -- 1/0 ) TRUE FALSE ? ; inline ! typedef LRESULT (CALLBACK* WNDPROC)(HWND, UINT, WPARAM, LPARAM); diff --git a/basis/windows/windows.factor b/basis/windows/windows.factor index d2250d6f7e..44db355c99 100644 --- a/basis/windows/windows.factor +++ b/basis/windows/windows.factor @@ -8,7 +8,7 @@ IN: windows : lo-word ( wparam -- lo ) *short ; inline : hi-word ( wparam -- hi ) -16 shift lo-word ; inline -: MAX_UNICODE_PATH 32768 ; inline +CONSTANT: MAX_UNICODE_PATH 32768 ! You must LocalFree the return value! FUNCTION: void* error_message ( DWORD id ) ; From e026b554a99628682b50857b4fcc9e22ecae719d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 19:08:45 -0600 Subject: [PATCH 100/119] use CONSTANT: in extra --- extra/benchmark/binary-trees/binary-trees.factor | 2 +- extra/benchmark/fasta/fasta.factor | 12 ++++++------ extra/benchmark/mandel/colors/colors.factor | 4 ++-- extra/benchmark/mandel/params/params.factor | 12 ++++++------ extra/benchmark/nbody/nbody.factor | 2 +- extra/benchmark/raytracer/raytracer.factor | 10 +++++----- extra/crypto/aes/aes.factor | 2 +- extra/crypto/rsa/rsa.factor | 2 +- extra/curses/curses.factor | 6 +++--- extra/curses/ffi/ffi.factor | 2 +- extra/math/analysis/analysis.factor | 2 +- extra/opengl/demo-support/demo-support.factor | 4 ++-- extra/tetris/game/game.factor | 4 ++-- 13 files changed, 32 insertions(+), 32 deletions(-) diff --git a/extra/benchmark/binary-trees/binary-trees.factor b/extra/benchmark/binary-trees/binary-trees.factor index 8e3918656a..21ff7fbbef 100644 --- a/extra/benchmark/binary-trees/binary-trees.factor +++ b/extra/benchmark/binary-trees/binary-trees.factor @@ -23,7 +23,7 @@ M: tree-node item-check M: f item-check drop 0 ; -: min-depth 4 ; inline +CONSTANT: min-depth 4 : stretch-tree ( max-depth -- ) 1 + 0 over bottom-up-tree item-check diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor index 32d3534920..61d9e9fd43 100755 --- a/extra/benchmark/fasta/fasta.factor +++ b/extra/benchmark/fasta/fasta.factor @@ -4,11 +4,11 @@ sequences.private benchmark.reverse-complement hints io.encodings.ascii byte-arrays specialized-arrays.double ; IN: benchmark.fasta -: IM 139968 ; inline -: IA 3877 ; inline -: IC 29573 ; inline -: initial-seed 42 ; inline -: line-length 60 ; inline +CONSTANT: IM 139968 +CONSTANT: IA 3877 +CONSTANT: IC 29573 +CONSTANT: initial-seed 42 +CONSTANT: line-length 60 USE: math.private @@ -17,7 +17,7 @@ USE: math.private HINTS: random fixnum ; -: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA" ; inline +CONSTANT: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA" : IUB { diff --git a/extra/benchmark/mandel/colors/colors.factor b/extra/benchmark/mandel/colors/colors.factor index edc848a0ca..9e0f2472e2 100644 --- a/extra/benchmark/mandel/colors/colors.factor +++ b/extra/benchmark/mandel/colors/colors.factor @@ -7,8 +7,8 @@ IN: benchmark.mandel.colors : scale-rgb ( rgba -- n ) [ red>> scale ] [ green>> scale ] [ blue>> scale ] tri 3byte-array ; -: sat 0.85 ; inline -: val 0.85 ; inline +CONSTANT: sat 0.85 +CONSTANT: val 0.85 : ( nb-cols -- map ) dup [ diff --git a/extra/benchmark/mandel/params/params.factor b/extra/benchmark/mandel/params/params.factor index c40d3c1f2d..8a19180d73 100644 --- a/extra/benchmark/mandel/params/params.factor +++ b/extra/benchmark/mandel/params/params.factor @@ -1,8 +1,8 @@ IN: benchmark.mandel.params -: max-color 360 ; inline -: zoom-fact 0.8 ; inline -: width 640 ; inline -: height 480 ; inline -: max-iterations 40 ; inline -: center -0.65 ; inline +CONSTANT: max-color 360 +CONSTANT: zoom-fact 0.8 +CONSTANT: width 640 +CONSTANT: height 480 +CONSTANT: max-iterations 40 +CONSTANT: center -0.65 diff --git a/extra/benchmark/nbody/nbody.factor b/extra/benchmark/nbody/nbody.factor index 37c4fc43c5..f72ceb4629 100644 --- a/extra/benchmark/nbody/nbody.factor +++ b/extra/benchmark/nbody/nbody.factor @@ -6,7 +6,7 @@ sequences hints arrays ; IN: benchmark.nbody : solar-mass ( -- x ) 4 pi sq * ; inline -: days-per-year 365.24 ; inline +CONSTANT: days-per-year 365.24 TUPLE: body { location double-array } diff --git a/extra/benchmark/raytracer/raytracer.factor b/extra/benchmark/raytracer/raytracer.factor index c16e47846e..8d07ae1c65 100755 --- a/extra/benchmark/raytracer/raytracer.factor +++ b/extra/benchmark/raytracer/raytracer.factor @@ -16,13 +16,13 @@ IN: benchmark.raytracer 0.5345224838248488 } ; inline -: oversampling 4 ; inline +CONSTANT: oversampling 4 -: levels 3 ; inline +CONSTANT: levels 3 -: size 200 ; inline +CONSTANT: size 200 -: delta 1.4901161193847656E-8 ; inline +CONSTANT: delta 1.4901161193847656E-8 TUPLE: ray { orig double-array read-only } { dir double-array read-only } ; @@ -88,7 +88,7 @@ TUPLE: group < sphere { objs array read-only } ; M: group intersect-scene ( hit ray group -- hit ) [ drop objs>> [ intersect-scene ] with each ] if-ray-sphere ; -: initial-hit T{ hit f double-array{ 0.0 0.0 0.0 } 1/0. } ; inline +CONSTANT: initial-hit T{ hit f double-array{ 0.0 0.0 0.0 } 1/0. } : initial-intersect ( ray scene -- hit ) [ initial-hit ] 2dip intersect-scene ; inline diff --git a/extra/crypto/aes/aes.factor b/extra/crypto/aes/aes.factor index cacfc5971a..0807420266 100644 --- a/extra/crypto/aes/aes.factor +++ b/extra/crypto/aes/aes.factor @@ -4,7 +4,7 @@ USING: arrays kernel math memoize sequences math.bitwise locals ; IN: crypto.aes -: AES_BLOCK_SIZE 16 ; inline +CONSTANT: AES_BLOCK_SIZE 16 : sbox ( -- array ) { diff --git a/extra/crypto/rsa/rsa.factor b/extra/crypto/rsa/rsa.factor index b1eb907547..373dd9637c 100644 --- a/extra/crypto/rsa/rsa.factor +++ b/extra/crypto/rsa/rsa.factor @@ -18,7 +18,7 @@ C: rsa BOOLEAN ( n -- TRUE/FALSE ) >boolean TRUE FALSE ? ; inline ERROR: duplicate-window window ; diff --git a/extra/curses/ffi/ffi.factor b/extra/curses/ffi/ffi.factor index 8d4a7ddb4b..b1c481a576 100644 --- a/extra/curses/ffi/ffi.factor +++ b/extra/curses/ffi/ffi.factor @@ -18,7 +18,7 @@ TYPEDEF: chtype attr_t TYPEDEF: short NCURSES_SIZE_T TYPEDEF: ushort wchar_t -: CCHARW_MAX 5 ; inline +CONSTANT: CCHARW_MAX 5 C-STRUCT: cchar_t { "attr_t" "attr" } diff --git a/extra/math/analysis/analysis.factor b/extra/math/analysis/analysis.factor index b5f6a547ba..9c773f748e 100755 --- a/extra/math/analysis/analysis.factor +++ b/extra/math/analysis/analysis.factor @@ -9,7 +9,7 @@ IN: math.analysis ! http://www.rskey.org/gamma.htm "Lanczos Approximation" ! n=6: error ~ 3 x 10^-11 -: gamma-g6 5.15 ; inline +CONSTANT: gamma-g6 5.15 : gamma-p6 { diff --git a/extra/opengl/demo-support/demo-support.factor b/extra/opengl/demo-support/demo-support.factor index c8fe2b4882..9f05482b30 100755 --- a/extra/opengl/demo-support/demo-support.factor +++ b/extra/opengl/demo-support/demo-support.factor @@ -4,8 +4,8 @@ ui.render accessors combinators ; IN: opengl.demo-support : FOV ( -- x ) 2.0 sqrt 1+ ; inline -: MOUSE-MOTION-SCALE 0.5 ; inline -: KEY-ROTATE-STEP 10.0 ; inline +CONSTANT: MOUSE-MOTION-SCALE 0.5 +CONSTANT: KEY-ROTATE-STEP 10.0 SYMBOL: last-drag-loc diff --git a/extra/tetris/game/game.factor b/extra/tetris/game/game.factor index ef5ffcc344..00b5bb6c41 100644 --- a/extra/tetris/game/game.factor +++ b/extra/tetris/game/game.factor @@ -12,8 +12,8 @@ TUPLE: tetris { paused? initial: f } { running? initial: t } ; -: default-width 10 ; inline -: default-height 20 ; inline +CONSTANT: default-width 10 +CONSTANT: default-height 20 : ( width height -- tetris ) dupd swap From a6b40707df0466d51464d3587ac608d9bba02dfd Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 19:09:49 -0600 Subject: [PATCH 101/119] use CONSTANT: in core/ --- core/checksums/crc32/crc32.factor | 4 ++-- core/combinators/combinators-tests.factor | 4 ++-- core/io/encodings/encodings.factor | 2 +- core/words/words.factor | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/core/checksums/crc32/crc32.factor b/core/checksums/crc32/crc32.factor index d373a96f39..7ea2964411 100644 --- a/core/checksums/crc32/crc32.factor +++ b/core/checksums/crc32/crc32.factor @@ -5,9 +5,9 @@ words io io.binary io.files io.streams.string quotations definitions checksums ; IN: checksums.crc32 -: crc32-polynomial HEX: edb88320 ; inline +CONSTANT: crc32-polynomial HEX: edb88320 -: crc32-table V{ } ; inline +CONSTANT: crc32-table V{ } 256 [ 8 [ diff --git a/core/combinators/combinators-tests.factor b/core/combinators/combinators-tests.factor index beb50f1162..1ee3a4e3ed 100644 --- a/core/combinators/combinators-tests.factor +++ b/core/combinators/combinators-tests.factor @@ -176,8 +176,8 @@ IN: combinators.tests [ "an array" ] [ { 1 2 3 } case-test-3 ] unit-test -: case-const-1 1 ; -: case-const-2 2 ; inline +CONSTANT: case-const-1 1 +CONSTANT: case-const-2 2 ! Compiled : case-test-4 ( obj -- str ) diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 94d2115478..e8735afa6a 100644 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -14,7 +14,7 @@ GENERIC: encode-char ( char stream encoding -- ) GENERIC: ( stream encoding -- newstream ) -: replacement-char HEX: fffd ; inline +CONSTANT: replacement-char HEX: fffd TUPLE: decoder stream code cr ; diff --git a/core/words/words.factor b/core/words/words.factor index 8648664031..4a3c1b2d52 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -134,7 +134,7 @@ compiled-generic-crossref [ H{ } clone ] initialize SYMBOL: visited -: reset-on-redefine { "inferred-effect" "cannot-infer" } ; inline +CONSTANT: reset-on-redefine { "inferred-effect" "cannot-infer" } : (redefined) ( word -- ) dup visited get key? [ drop ] [ From 990513db600192f44c01a2ea0f5d9b205e2aeb3e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 19:13:08 -0600 Subject: [PATCH 102/119] use CONSTANT: in basis --- basis/bootstrap/image/image.factor | 20 +++++----- basis/calendar/calendar.factor | 2 +- basis/checksums/adler-32/adler-32.factor | 2 +- basis/checksums/sha2/sha2.factor | 16 ++++---- basis/cocoa/enumeration/enumeration.factor | 2 +- basis/cocoa/windows/windows.factor | 16 ++++---- basis/colors/colors.factor | 26 ++++++------ basis/compiler/constants/constants.factor | 38 +++++++++--------- .../tree/propagation/info/info.factor | 4 +- basis/core-foundation/core-foundation.factor | 2 +- basis/core-foundation/data/data.factor | 40 +++++++++---------- .../file-descriptors/file-descriptors.factor | 4 +- .../core-foundation/fsevents/fsevents.factor | 22 +++++----- .../core-foundation/run-loop/run-loop.factor | 8 ++-- basis/core-foundation/urls/urls.factor | 2 +- basis/cpu/ppc/ppc.factor | 8 ++-- basis/io/files/info/unix/unix.factor | 30 +++++++------- basis/io/sockets/unix/unix.factor | 2 +- basis/math/bitwise/bitwise-tests.factor | 4 +- basis/openssl/libcrypto/libcrypto.factor | 12 +++--- basis/persistent/vectors/vectors.factor | 2 +- .../mersenne-twister/mersenne-twister.factor | 6 +-- .../transforms/transforms.factor | 2 +- basis/tools/disassembler/udis/udis.factor | 8 ++-- basis/unix/stat/netbsd/netbsd.factor | 4 +- basis/unrolled-lists/unrolled-lists.factor | 2 +- basis/x11/xlib/xlib.factor | 16 ++++---- 27 files changed, 150 insertions(+), 150 deletions(-) diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index 221ffffb91..10cde266cc 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -77,20 +77,20 @@ SYMBOL: objects ! Constants -: image-magic HEX: 0f0e0d0c ; inline -: image-version 4 ; inline +CONSTANT: image-magic HEX: 0f0e0d0c +CONSTANT: image-version 4 -: data-base 1024 ; inline +CONSTANT: data-base 1024 -: userenv-size 70 ; inline +CONSTANT: userenv-size 70 -: header-size 10 ; inline +CONSTANT: header-size 10 -: data-heap-size-offset 3 ; inline -: t-offset 6 ; inline -: 0-offset 7 ; inline -: 1-offset 8 ; inline -: -1-offset 9 ; inline +CONSTANT: data-heap-size-offset 3 +CONSTANT: t-offset 6 +CONSTANT: 0-offset 7 +CONSTANT: 1-offset 8 +CONSTANT: -1-offset 9 SYMBOL: sub-primitives diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index 522e0c52f3..dc9442259b 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -61,7 +61,7 @@ PRIVATE> : month-abbreviation ( n -- string ) check-month 1- month-abbreviations nth ; -: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ; inline +CONSTANT: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } : day-names ( -- array ) { diff --git a/basis/checksums/adler-32/adler-32.factor b/basis/checksums/adler-32/adler-32.factor index 1be4bfb584..d5e153ba99 100644 --- a/basis/checksums/adler-32/adler-32.factor +++ b/basis/checksums/adler-32/adler-32.factor @@ -6,7 +6,7 @@ IN: checksums.adler-32 SINGLETON: adler-32 -: adler-32-modulus 65521 ; inline +CONSTANT: adler-32-modulus 65521 M: adler-32 checksum-bytes ( bytes checksum -- value ) drop diff --git a/basis/checksums/sha2/sha2.factor b/basis/checksums/sha2/sha2.factor index 026c4d6f27..3b092a78de 100644 --- a/basis/checksums/sha2/sha2.factor +++ b/basis/checksums/sha2/sha2.factor @@ -9,14 +9,14 @@ IN: checksums.sha2 SYMBOLS: vars M K H S0 S1 process-M word-size block-size ; -: a 0 ; inline -: b 1 ; inline -: c 2 ; inline -: d 3 ; inline -: e 4 ; inline -: f 5 ; inline -: g 6 ; inline -: h 7 ; inline +CONSTANT: a 0 +CONSTANT: b 1 +CONSTANT: c 2 +CONSTANT: d 3 +CONSTANT: e 4 +CONSTANT: f 5 +CONSTANT: g 6 +CONSTANT: h 7 : initial-H-256 ( -- seq ) { diff --git a/basis/cocoa/enumeration/enumeration.factor b/basis/cocoa/enumeration/enumeration.factor index 7f5b777283..919e8f86c5 100644 --- a/basis/cocoa/enumeration/enumeration.factor +++ b/basis/cocoa/enumeration/enumeration.factor @@ -5,7 +5,7 @@ sequences vectors fry libc destructors specialized-arrays.direct.alien ; IN: cocoa.enumeration -: NS-EACH-BUFFER-SIZE 16 ; inline +CONSTANT: NS-EACH-BUFFER-SIZE 16 : with-enumeration-buffers ( quot -- ) [ diff --git a/basis/cocoa/windows/windows.factor b/basis/cocoa/windows/windows.factor index 51f692d02d..4e0f768b96 100644 --- a/basis/cocoa/windows/windows.factor +++ b/basis/cocoa/windows/windows.factor @@ -4,15 +4,15 @@ USING: arrays kernel math cocoa cocoa.messages cocoa.classes sequences math.bitwise ; IN: cocoa.windows -: NSBorderlessWindowMask 0 ; inline -: NSTitledWindowMask 1 ; inline -: NSClosableWindowMask 2 ; inline -: NSMiniaturizableWindowMask 4 ; inline -: NSResizableWindowMask 8 ; inline +CONSTANT: NSBorderlessWindowMask 0 +CONSTANT: NSTitledWindowMask 1 +CONSTANT: NSClosableWindowMask 2 +CONSTANT: NSMiniaturizableWindowMask 4 +CONSTANT: NSResizableWindowMask 8 -: NSBackingStoreRetained 0 ; inline -: NSBackingStoreNonretained 1 ; inline -: NSBackingStoreBuffered 2 ; inline +CONSTANT: NSBackingStoreRetained 0 +CONSTANT: NSBackingStoreNonretained 1 +CONSTANT: NSBackingStoreBuffered 2 : standard-window-type ( -- n ) { diff --git a/basis/colors/colors.factor b/basis/colors/colors.factor index 1183c2e46c..9c55b1f29a 100644 --- a/basis/colors/colors.factor +++ b/basis/colors/colors.factor @@ -18,16 +18,16 @@ M: color red>> ( color -- red ) >rgba red>> ; M: color green>> ( color -- green ) >rgba green>> ; M: color blue>> ( color -- blue ) >rgba blue>> ; -: black T{ rgba f 0.0 0.0 0.0 1.0 } ; inline -: blue T{ rgba f 0.0 0.0 1.0 1.0 } ; inline -: cyan T{ rgba f 0 0.941 0.941 1 } ; inline -: gray T{ rgba f 0.6 0.6 0.6 1.0 } ; inline -: green T{ rgba f 0.0 1.0 0.0 1.0 } ; inline -: light-gray T{ rgba f 0.95 0.95 0.95 0.95 } ; inline -: light-purple T{ rgba f 0.8 0.8 1.0 1.0 } ; inline -: magenta T{ rgba f 0.941 0 0.941 1 } ; inline -: orange T{ rgba f 0.941 0.627 0 1 } ; inline -: purple T{ rgba f 0.627 0 0.941 1 } ; inline -: red T{ rgba f 1.0 0.0 0.0 1.0 } ; inline -: white T{ rgba f 1.0 1.0 1.0 1.0 } ; inline -: yellow T{ rgba f 1.0 1.0 0.0 1.0 } ; inline +CONSTANT: black T{ rgba f 0.0 0.0 0.0 1.0 } +CONSTANT: blue T{ rgba f 0.0 0.0 1.0 1.0 } +CONSTANT: cyan T{ rgba f 0 0.941 0.941 1 } +CONSTANT: gray T{ rgba f 0.6 0.6 0.6 1.0 } +CONSTANT: green T{ rgba f 0.0 1.0 0.0 1.0 } +CONSTANT: light-gray T{ rgba f 0.95 0.95 0.95 0.95 } +CONSTANT: light-purple T{ rgba f 0.8 0.8 1.0 1.0 } +CONSTANT: magenta T{ rgba f 0.941 0 0.941 1 } +CONSTANT: orange T{ rgba f 0.941 0.627 0 1 } +CONSTANT: purple T{ rgba f 0.627 0 0.941 1 } +CONSTANT: red T{ rgba f 1.0 0.0 0.0 1.0 } +CONSTANT: white T{ rgba f 1.0 1.0 1.0 1.0 } +CONSTANT: yellow T{ rgba f 1.0 1.0 0.0 1.0 } diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor index 48ea958818..e03c062e9e 100644 --- a/basis/compiler/constants/constants.factor +++ b/basis/compiler/constants/constants.factor @@ -4,8 +4,8 @@ USING: math kernel layouts system strings ; IN: compiler.constants ! These constants must match vm/memory.h -: card-bits 8 ; inline -: deck-bits 18 ; inline +CONSTANT: card-bits 8 +CONSTANT: deck-bits 18 : card-mark ( -- n ) HEX: 40 HEX: 80 bitor ; inline ! These constants must match vm/layouts.h @@ -26,25 +26,25 @@ IN: compiler.constants : compiled-header-size ( -- n ) 4 bootstrap-cells ; inline ! Relocation classes -: rc-absolute-cell 0 ; inline -: rc-absolute 1 ; inline -: rc-relative 2 ; inline -: rc-absolute-ppc-2/2 3 ; inline -: rc-relative-ppc-2 4 ; inline -: rc-relative-ppc-3 5 ; inline -: rc-relative-arm-3 6 ; inline -: rc-indirect-arm 7 ; inline -: rc-indirect-arm-pc 8 ; inline +CONSTANT: rc-absolute-cell 0 +CONSTANT: rc-absolute 1 +CONSTANT: rc-relative 2 +CONSTANT: rc-absolute-ppc-2/2 3 +CONSTANT: rc-relative-ppc-2 4 +CONSTANT: rc-relative-ppc-3 5 +CONSTANT: rc-relative-arm-3 6 +CONSTANT: rc-indirect-arm 7 +CONSTANT: rc-indirect-arm-pc 8 ! Relocation types -: rt-primitive 0 ; inline -: rt-dlsym 1 ; inline -: rt-dispatch 2 ; inline -: rt-xt 3 ; inline -: rt-here 4 ; inline -: rt-label 5 ; inline -: rt-immediate 6 ; inline -: rt-stack-chain 7 ; inline +CONSTANT: rt-primitive 0 +CONSTANT: rt-dlsym 1 +CONSTANT: rt-dispatch 2 +CONSTANT: rt-xt 3 +CONSTANT: rt-here 4 +CONSTANT: rt-label 5 +CONSTANT: rt-immediate 6 +CONSTANT: rt-stack-chain 7 : rc-absolute? ( n -- ? ) [ rc-absolute-ppc-2/2 = ] diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index 771d3800df..7b1723620b 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/basis/compiler/tree/propagation/info/info.factor @@ -32,9 +32,9 @@ literal? length slots ; -: null-info T{ value-info f null empty-interval } ; inline +CONSTANT: null-info T{ value-info f null empty-interval } -: object-info T{ value-info f object full-interval } ; inline +CONSTANT: object-info T{ value-info f object full-interval } : class-interval ( class -- interval ) dup real class<= diff --git a/basis/core-foundation/core-foundation.factor b/basis/core-foundation/core-foundation.factor index ec83ba7a8b..40269ae3be 100644 --- a/basis/core-foundation/core-foundation.factor +++ b/basis/core-foundation/core-foundation.factor @@ -6,7 +6,7 @@ IN: core-foundation TYPEDEF: void* CFTypeRef TYPEDEF: void* CFAllocatorRef -: kCFAllocatorDefault f ; inline +CONSTANT: kCFAllocatorDefault f TYPEDEF: bool Boolean TYPEDEF: long CFIndex diff --git a/basis/core-foundation/data/data.factor b/basis/core-foundation/data/data.factor index f4d2babca7..fb5ecaa043 100644 --- a/basis/core-foundation/data/data.factor +++ b/basis/core-foundation/data/data.factor @@ -10,28 +10,28 @@ TYPEDEF: void* CFNumberRef TYPEDEF: void* CFSetRef TYPEDEF: int CFNumberType -: kCFNumberSInt8Type 1 ; inline -: kCFNumberSInt16Type 2 ; inline -: kCFNumberSInt32Type 3 ; inline -: kCFNumberSInt64Type 4 ; inline -: kCFNumberFloat32Type 5 ; inline -: kCFNumberFloat64Type 6 ; inline -: kCFNumberCharType 7 ; inline -: kCFNumberShortType 8 ; inline -: kCFNumberIntType 9 ; inline -: kCFNumberLongType 10 ; inline -: kCFNumberLongLongType 11 ; inline -: kCFNumberFloatType 12 ; inline -: kCFNumberDoubleType 13 ; inline -: kCFNumberCFIndexType 14 ; inline -: kCFNumberNSIntegerType 15 ; inline -: kCFNumberCGFloatType 16 ; inline -: kCFNumberMaxType 16 ; inline +CONSTANT: kCFNumberSInt8Type 1 +CONSTANT: kCFNumberSInt16Type 2 +CONSTANT: kCFNumberSInt32Type 3 +CONSTANT: kCFNumberSInt64Type 4 +CONSTANT: kCFNumberFloat32Type 5 +CONSTANT: kCFNumberFloat64Type 6 +CONSTANT: kCFNumberCharType 7 +CONSTANT: kCFNumberShortType 8 +CONSTANT: kCFNumberIntType 9 +CONSTANT: kCFNumberLongType 10 +CONSTANT: kCFNumberLongLongType 11 +CONSTANT: kCFNumberFloatType 12 +CONSTANT: kCFNumberDoubleType 13 +CONSTANT: kCFNumberCFIndexType 14 +CONSTANT: kCFNumberNSIntegerType 15 +CONSTANT: kCFNumberCGFloatType 16 +CONSTANT: kCFNumberMaxType 16 TYPEDEF: int CFPropertyListMutabilityOptions -: kCFPropertyListImmutable 0 ; inline -: kCFPropertyListMutableContainers 1 ; inline -: kCFPropertyListMutableContainersAndLeaves 2 ; inline +CONSTANT: kCFPropertyListImmutable 0 +CONSTANT: kCFPropertyListMutableContainers 1 +CONSTANT: kCFPropertyListMutableContainersAndLeaves 2 FUNCTION: CFNumberRef CFNumberCreate ( CFAllocatorRef allocator, CFNumberType theType, void* valuePtr ) ; diff --git a/basis/core-foundation/file-descriptors/file-descriptors.factor b/basis/core-foundation/file-descriptors/file-descriptors.factor index 29c4219678..c9fe3131b1 100644 --- a/basis/core-foundation/file-descriptors/file-descriptors.factor +++ b/basis/core-foundation/file-descriptors/file-descriptors.factor @@ -15,8 +15,8 @@ FUNCTION: CFFileDescriptorRef CFFileDescriptorCreate ( CFFileDescriptorContext* context ) ; -: kCFFileDescriptorReadCallBack 1 ; inline -: kCFFileDescriptorWriteCallBack 2 ; inline +CONSTANT: kCFFileDescriptorReadCallBack 1 +CONSTANT: kCFFileDescriptorWriteCallBack 2 FUNCTION: void CFFileDescriptorEnableCallBacks ( CFFileDescriptorRef f, diff --git a/basis/core-foundation/fsevents/fsevents.factor b/basis/core-foundation/fsevents/fsevents.factor index b0c299a831..06b9c6407b 100644 --- a/basis/core-foundation/fsevents/fsevents.factor +++ b/basis/core-foundation/fsevents/fsevents.factor @@ -9,17 +9,17 @@ core-foundation core-foundation.run-loop core-foundation.strings core-foundation.time ; IN: core-foundation.fsevents -: kFSEventStreamCreateFlagUseCFTypes 2 ; inline -: kFSEventStreamCreateFlagWatchRoot 4 ; inline +CONSTANT: kFSEventStreamCreateFlagUseCFTypes 2 +CONSTANT: kFSEventStreamCreateFlagWatchRoot 4 -: kFSEventStreamEventFlagMustScanSubDirs 1 ; inline -: kFSEventStreamEventFlagUserDropped 2 ; inline -: kFSEventStreamEventFlagKernelDropped 4 ; inline -: kFSEventStreamEventFlagEventIdsWrapped 8 ; inline -: kFSEventStreamEventFlagHistoryDone 16 ; inline -: kFSEventStreamEventFlagRootChanged 32 ; inline -: kFSEventStreamEventFlagMount 64 ; inline -: kFSEventStreamEventFlagUnmount 128 ; inline +CONSTANT: kFSEventStreamEventFlagMustScanSubDirs 1 +CONSTANT: kFSEventStreamEventFlagUserDropped 2 +CONSTANT: kFSEventStreamEventFlagKernelDropped 4 +CONSTANT: kFSEventStreamEventFlagEventIdsWrapped 8 +CONSTANT: kFSEventStreamEventFlagHistoryDone 16 +CONSTANT: kFSEventStreamEventFlagRootChanged 32 +CONSTANT: kFSEventStreamEventFlagMount 64 +CONSTANT: kFSEventStreamEventFlagUnmount 128 TYPEDEF: int FSEventStreamCreateFlags TYPEDEF: int FSEventStreamEventFlags @@ -36,7 +36,7 @@ C-STRUCT: FSEventStreamContext ! callback(FSEventStreamRef streamRef, void *clientCallBackInfo, size_t numEvents, void *eventPaths, const FSEventStreamEventFlags eventFlags[], const FSEventStreamEventId eventIds[]); TYPEDEF: void* FSEventStreamCallback -: FSEventStreamEventIdSinceNow HEX: FFFFFFFFFFFFFFFF ; inline +CONSTANT: FSEventStreamEventIdSinceNow HEX: FFFFFFFFFFFFFFFF FUNCTION: FSEventStreamRef FSEventStreamCreate ( CFAllocatorRef allocator, diff --git a/basis/core-foundation/run-loop/run-loop.factor b/basis/core-foundation/run-loop/run-loop.factor index 4b98e9a410..8bdce2ec37 100644 --- a/basis/core-foundation/run-loop/run-loop.factor +++ b/basis/core-foundation/run-loop/run-loop.factor @@ -7,10 +7,10 @@ core-foundation.file-descriptors core-foundation.timers core-foundation.time ; IN: core-foundation.run-loop -: kCFRunLoopRunFinished 1 ; inline -: kCFRunLoopRunStopped 2 ; inline -: kCFRunLoopRunTimedOut 3 ; inline -: kCFRunLoopRunHandledSource 4 ; inline +CONSTANT: kCFRunLoopRunFinished 1 +CONSTANT: kCFRunLoopRunStopped 2 +CONSTANT: kCFRunLoopRunTimedOut 3 +CONSTANT: kCFRunLoopRunHandledSource 4 TYPEDEF: void* CFRunLoopRef TYPEDEF: void* CFRunLoopSourceRef diff --git a/basis/core-foundation/urls/urls.factor b/basis/core-foundation/urls/urls.factor index 9f9d3a67cb..7ffef498b6 100644 --- a/basis/core-foundation/urls/urls.factor +++ b/basis/core-foundation/urls/urls.factor @@ -4,7 +4,7 @@ USING: alien.syntax kernel core-foundation.strings core-foundation ; IN: core-foundation.urls -: kCFURLPOSIXPathStyle 0 ; inline +CONSTANT: kCFURLPOSIXPathStyle 0 TYPEDEF: void* CFURLRef diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index f245bcb7e1..8b6b4fbb11 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -27,8 +27,8 @@ M: ppc machine-registers { double-float-regs T{ range f 0 29 1 } } } ; -: scratch-reg 28 ; inline -: fp-scratch-reg 30 ; inline +CONSTANT: scratch-reg 28 +CONSTANT: fp-scratch-reg 30 M: ppc two-operand? f ; @@ -40,8 +40,8 @@ M: ppc %load-reference ( reg obj -- ) M: ppc %alien-global ( register symbol dll -- ) [ 0 swap LOAD32 ] 2dip rc-absolute-ppc-2/2 rel-dlsym ; -: ds-reg 29 ; inline -: rs-reg 30 ; inline +CONSTANT: ds-reg 29 +CONSTANT: rs-reg 30 GENERIC: loc-reg ( loc -- reg ) diff --git a/basis/io/files/info/unix/unix.factor b/basis/io/files/info/unix/unix.factor index b7edc14c2c..616f70cccc 100644 --- a/basis/io/files/info/unix/unix.factor +++ b/basis/io/files/info/unix/unix.factor @@ -114,21 +114,21 @@ M: file-info file-mode? [ permissions>> ] dip mask? ; PRIVATE> -: UID OCT: 0004000 ; inline -: GID OCT: 0002000 ; inline -: STICKY OCT: 0001000 ; inline -: USER-ALL OCT: 0000700 ; inline -: USER-READ OCT: 0000400 ; inline -: USER-WRITE OCT: 0000200 ; inline -: USER-EXECUTE OCT: 0000100 ; inline -: GROUP-ALL OCT: 0000070 ; inline -: GROUP-READ OCT: 0000040 ; inline -: GROUP-WRITE OCT: 0000020 ; inline -: GROUP-EXECUTE OCT: 0000010 ; inline -: OTHER-ALL OCT: 0000007 ; inline -: OTHER-READ OCT: 0000004 ; inline -: OTHER-WRITE OCT: 0000002 ; inline -: OTHER-EXECUTE OCT: 0000001 ; inline +CONSTANT: UID OCT: 0004000 +CONSTANT: GID OCT: 0002000 +CONSTANT: STICKY OCT: 0001000 +CONSTANT: USER-ALL OCT: 0000700 +CONSTANT: USER-READ OCT: 0000400 +CONSTANT: USER-WRITE OCT: 0000200 +CONSTANT: USER-EXECUTE OCT: 0000100 +CONSTANT: GROUP-ALL OCT: 0000070 +CONSTANT: GROUP-READ OCT: 0000040 +CONSTANT: GROUP-WRITE OCT: 0000020 +CONSTANT: GROUP-EXECUTE OCT: 0000010 +CONSTANT: OTHER-ALL OCT: 0000007 +CONSTANT: OTHER-READ OCT: 0000004 +CONSTANT: OTHER-WRITE OCT: 0000002 +CONSTANT: OTHER-EXECUTE OCT: 0000001 : uid? ( obj -- ? ) UID file-mode? ; : gid? ( obj -- ? ) GID file-mode? ; diff --git a/basis/io/sockets/unix/unix.factor b/basis/io/sockets/unix/unix.factor index e701874afd..799dfa78d5 100644 --- a/basis/io/sockets/unix/unix.factor +++ b/basis/io/sockets/unix/unix.factor @@ -94,7 +94,7 @@ M: unix (datagram) SYMBOL: receive-buffer -: packet-size 65536 ; inline +CONSTANT: packet-size 65536 [ packet-size malloc receive-buffer set-global ] "io.sockets.unix" add-init-hook diff --git a/basis/math/bitwise/bitwise-tests.factor b/basis/math/bitwise/bitwise-tests.factor index 40eb20642c..7698760f84 100644 --- a/basis/math/bitwise/bitwise-tests.factor +++ b/basis/math/bitwise/bitwise-tests.factor @@ -19,8 +19,8 @@ IN: math.bitwise.tests [ 268 ] [ 1 { 8 { 3 2 } } bitfield ] unit-test [ 512 ] [ 1 { { 1+ 8 } } bitfield ] unit-test -: a 1 ; inline -: b 2 ; inline +CONSTANT: a 1 +CONSTANT: b 2 : foo ( -- flags ) { a b } flags ; diff --git a/basis/openssl/libcrypto/libcrypto.factor b/basis/openssl/libcrypto/libcrypto.factor index 80bf3b1772..3204b83bbb 100644 --- a/basis/openssl/libcrypto/libcrypto.factor +++ b/basis/openssl/libcrypto/libcrypto.factor @@ -48,14 +48,14 @@ C-STRUCT: bio { "void*" "crypto-ex-data-stack" } { "int" "crypto-ex-data-dummy" } ; -: BIO_NOCLOSE HEX: 00 ; inline -: BIO_CLOSE HEX: 01 ; inline +CONSTANT: BIO_NOCLOSE HEX: 00 +CONSTANT: BIO_CLOSE HEX: 01 -: RSA_3 HEX: 3 ; inline -: RSA_F4 HEX: 10001 ; inline +CONSTANT: RSA_3 HEX: 3 +CONSTANT: RSA_F4 HEX: 10001 -: BIO_C_SET_SSL 109 ; inline -: BIO_C_GET_SSL 110 ; inline +CONSTANT: BIO_C_SET_SSL 109 +CONSTANT: BIO_C_GET_SSL 110 LIBRARY: libcrypto diff --git a/basis/persistent/vectors/vectors.factor b/basis/persistent/vectors/vectors.factor index 554db08e70..478fc0ad25 100644 --- a/basis/persistent/vectors/vectors.factor +++ b/basis/persistent/vectors/vectors.factor @@ -20,7 +20,7 @@ TUPLE: persistent-vector M: persistent-vector length count>> ; -: node-size 32 ; inline +CONSTANT: node-size 32 : node-mask ( m -- n ) node-size mod ; inline diff --git a/basis/random/mersenne-twister/mersenne-twister.factor b/basis/random/mersenne-twister/mersenne-twister.factor index 67b0fa23e7..361ba7719e 100644 --- a/basis/random/mersenne-twister/mersenne-twister.factor +++ b/basis/random/mersenne-twister/mersenne-twister.factor @@ -11,9 +11,9 @@ IN: random.mersenne-twister TUPLE: mersenne-twister { seq uint-array } { i fixnum } ; -: n 624 ; inline -: m 397 ; inline -: a uint-array{ 0 HEX: 9908b0df } ; inline +CONSTANT: n 624 +CONSTANT: m 397 +CONSTANT: a uint-array{ 0 HEX: 9908b0df } : y ( n seq -- y ) [ nth-unsafe 31 mask-bit ] diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor index a2f616480a..afb7e0843c 100755 --- a/basis/stack-checker/transforms/transforms.factor +++ b/basis/stack-checker/transforms/transforms.factor @@ -105,7 +105,7 @@ IN: stack-checker.transforms ] 1 define-transform ! Membership testing -: bit-member-n 256 ; inline +CONSTANT: bit-member-n 256 : bit-member? ( seq -- ? ) #! Can we use a fast byte array test here? diff --git a/basis/tools/disassembler/udis/udis.factor b/basis/tools/disassembler/udis/udis.factor index cfa2483c7e..8f99e4f440 100644 --- a/basis/tools/disassembler/udis/udis.factor +++ b/basis/tools/disassembler/udis/udis.factor @@ -24,10 +24,10 @@ FUNCTION: void ud_translate_att ( ud* u ) ; : UD_SYN_INTEL ( -- addr ) &: ud_translate_intel ; inline : UD_SYN_ATT ( -- addr ) &: ud_translate_att ; inline -: UD_EOI -1 ; inline -: UD_INP_CACHE_SZ 32 ; inline -: UD_VENDOR_AMD 0 ; inline -: UD_VENDOR_INTEL 1 ; inline +CONSTANT: UD_EOI -1 +CONSTANT: UD_INP_CACHE_SZ 32 +CONSTANT: UD_VENDOR_AMD 0 +CONSTANT: UD_VENDOR_INTEL 1 FUNCTION: void ud_init ( ud* u ) ; FUNCTION: void ud_set_mode ( ud* u, uint8_t mode ) ; diff --git a/basis/unix/stat/netbsd/netbsd.factor b/basis/unix/stat/netbsd/netbsd.factor index 0bcb886417..b60a0b1adc 100644 --- a/basis/unix/stat/netbsd/netbsd.factor +++ b/basis/unix/stat/netbsd/netbsd.factor @@ -6,8 +6,8 @@ cell-bits { { 64 [ "unix.stat.netbsd.64" require ] } } case -: _VFS_NAMELEN 32 ; inline -: _VFS_MNAMELEN 1024 ; inline +CONSTANT: _VFS_NAMELEN 32 +CONSTANT: _VFS_MNAMELEN 1024 C-STRUCT: statvfs { "ulong" "f_flag" } diff --git a/basis/unrolled-lists/unrolled-lists.factor b/basis/unrolled-lists/unrolled-lists.factor index d434632abd..bd4a2c1114 100644 --- a/basis/unrolled-lists/unrolled-lists.factor +++ b/basis/unrolled-lists/unrolled-lists.factor @@ -4,7 +4,7 @@ USING: arrays math kernel accessors sequences sequences.private deques search-deques hashtables ; IN: unrolled-lists -: unroll-factor 32 ; inline +CONSTANT: unroll-factor 32 Date: Sun, 22 Feb 2009 19:20:28 -0600 Subject: [PATCH 103/119] use ?at instead of at* --- basis/alien/fortran/fortran.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/alien/fortran/fortran.factor b/basis/alien/fortran/fortran.factor index 915b7d3d4f..5e3dc24476 100644 --- a/basis/alien/fortran/fortran.factor +++ b/basis/alien/fortran/fortran.factor @@ -170,8 +170,8 @@ M: character-type (fortran-type>c-type) : (parse-fortran-type) ( fortran-type-string -- type ) parse-out swap parse-dims swap parse-size swap - dup >lower fortran>c-types at* - [ nip new-fortran-type ] [ drop misc-type boa ] if ; + >lower fortran>c-types ?at + [ new-fortran-type ] [ misc-type boa ] if ; : parse-fortran-type ( fortran-type-string/f -- type/f ) dup [ (parse-fortran-type) ] when ; From 127f9b357854626e8263b1b00898128dfee4ddc1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Feb 2009 19:41:47 -0600 Subject: [PATCH 104/119] Add unit tests for bignum bug --- basis/math/bits/bits-tests.factor | 17 ++++++++++++++++- basis/math/functions/functions-tests.factor | 14 ++++++++++++++ .../math/miller-rabin/miller-rabin-tests.factor | 3 ++- core/math/integers/integers-tests.factor | 2 ++ 4 files changed, 34 insertions(+), 2 deletions(-) diff --git a/basis/math/bits/bits-tests.factor b/basis/math/bits/bits-tests.factor index 0503d27f33..ed4e8419c9 100644 --- a/basis/math/bits/bits-tests.factor +++ b/basis/math/bits/bits-tests.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: tools.test math.bits sequences arrays ; +USING: tools.test math math.bits sequences arrays ; IN: math.bits.tests [ t ] [ BIN: 111111 3 second ] unit-test @@ -14,3 +14,18 @@ IN: math.bits.tests [ 2 ] [ -3 make-bits length ] unit-test [ 1 ] [ 1 make-bits length ] unit-test [ 1 ] [ -1 make-bits length ] unit-test + +! Odd bug +[ t ] [ + 1067811677921310779 make-bits + 1067811677921310779 >bignum make-bits + sequence= +] unit-test + +[ t ] [ + 1067811677921310779 make-bits peek +] unit-test + +[ t ] [ + 1067811677921310779 >bignum make-bits peek +] unit-test \ No newline at end of file diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor index cf0ce5f0bb..9f5ce36be1 100644 --- a/basis/math/functions/functions-tests.factor +++ b/basis/math/functions/functions-tests.factor @@ -137,3 +137,17 @@ IN: math.functions.tests [ 6 59967 ] [ 3837888 factor-2s ] unit-test [ 6 -59967 ] [ -3837888 factor-2s ] unit-test + +[ 1 ] [ + 183009416410801897 + 1067811677921310779 + 2135623355842621559 + ^mod +] unit-test + +[ 1 ] [ + 183009416410801897 + 1067811677921310779 + 2135623355842621559 + [ >bignum ] tri@ ^mod +] unit-test \ No newline at end of file diff --git a/basis/math/miller-rabin/miller-rabin-tests.factor b/basis/math/miller-rabin/miller-rabin-tests.factor index 9ca85ea72c..5f1b9835e4 100644 --- a/basis/math/miller-rabin/miller-rabin-tests.factor +++ b/basis/math/miller-rabin/miller-rabin-tests.factor @@ -7,4 +7,5 @@ IN: math.miller-rabin.tests [ f ] [ 36 miller-rabin ] unit-test [ t ] [ 37 miller-rabin ] unit-test [ 101 ] [ 100 next-prime ] unit-test -[ 100000000000031 ] [ 100000000000000 next-prime ] unit-test +[ t ] [ 2135623355842621559 miller-rabin ] unit-test +[ 100000000000031 ] [ 100000000000000 next-prime ] unit-test \ No newline at end of file diff --git a/core/math/integers/integers-tests.factor b/core/math/integers/integers-tests.factor index 5a649120a0..6bd3e9b094 100644 --- a/core/math/integers/integers-tests.factor +++ b/core/math/integers/integers-tests.factor @@ -91,6 +91,8 @@ unit-test [ f ] [ BIN: -1101 >bignum 3 bit? ] unit-test [ t ] [ BIN: -1101 >bignum 4 bit? ] unit-test +[ t ] [ 1067811677921310779 >bignum 59 bit? ] unit-test + [ 2 ] [ 0 next-power-of-2 ] unit-test [ 2 ] [ 1 next-power-of-2 ] unit-test [ 2 ] [ 2 next-power-of-2 ] unit-test From 4257cd55e0ea37f1e279dd2f8c5abe2996284cca Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Feb 2009 19:45:05 -0600 Subject: [PATCH 105/119] fix problem with bignum-bit? -- return value would be truncated if sizeof(int) != sizeof(bignum_digit_type) --- vm/bignum.c | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/vm/bignum.c b/vm/bignum.c index 1f4bc3ce76..497a4bbf62 100644 --- a/vm/bignum.c +++ b/vm/bignum.c @@ -1827,14 +1827,13 @@ int bignum_unsigned_logbitp(int shift, bignum_type bignum) { bignum_length_type len = (BIGNUM_LENGTH (bignum)); - bignum_digit_type digit; int index = shift / BIGNUM_DIGIT_LENGTH; - int p; if (index >= len) return 0; - digit = (BIGNUM_REF (bignum, index)); - p = shift % BIGNUM_DIGIT_LENGTH; - return digit & (1 << p); + bignum_digit_type digit = (BIGNUM_REF (bignum, index)); + int p = shift % BIGNUM_DIGIT_LENGTH; + bignum_digit_type mask = ((F_FIXNUM)1) << p; + return (digit & mask) ? 1 : 0; } /* Allocates memory */ From 2dcbd5b3db15e16464f4057dc5578900216dd056 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Feb 2009 21:26:16 -0600 Subject: [PATCH 106/119] fix docs for a word --- core/io/encodings/encodings-docs.factor | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/core/io/encodings/encodings-docs.factor b/core/io/encodings/encodings-docs.factor index 509757c68a..e13e05bf40 100644 --- a/core/io/encodings/encodings-docs.factor +++ b/core/io/encodings/encodings-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax io quotations ; +USING: help.markup help.syntax io quotations math ; IN: io.encodings HELP: @@ -71,6 +71,9 @@ HELP: with-encoded-output { $description "Creates a new encoder with the given encoding descriptor and calls the quotation using this encoder. The original encoder object is restored after the quotation returns and the stream is kept open for future output operations." } ; HELP: replacement-char +{ $values + { "value" integer } +} { $description "A code point that replaces input that could not be decoded. The presence of this character in the decoded data usually signifies an error." } ; ARTICLE: "encodings-descriptors" "Encoding descriptors" From a4817a0e1712f0b1c521dc3a22de84f45493398c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 23 Feb 2009 08:37:38 -0600 Subject: [PATCH 107/119] dont run postgresql tests on win64 --- basis/db/errors/postgresql/postgresql-tests.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/db/errors/postgresql/postgresql-tests.factor b/basis/db/errors/postgresql/postgresql-tests.factor index 9dbebe0712..f6668031e5 100644 --- a/basis/db/errors/postgresql/postgresql-tests.factor +++ b/basis/db/errors/postgresql/postgresql-tests.factor @@ -5,7 +5,7 @@ db.errors.postgresql db.postgresql io.files.unique kernel namespaces tools.test db.tester continuations ; IN: db.errors.postgresql.tests -postgresql-test-db [ +[ [ "drop table foo;" sql-command ] ignore-errors [ "drop table ship;" sql-command ] ignore-errors @@ -29,4 +29,4 @@ postgresql-test-db [ sql-syntax-error? ] must-fail-with -] with-db +] test-postgresql From c3ef25f81c1a8b0a11b8ad5ac5c214f482a30dfd Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 23 Feb 2009 10:35:42 -0600 Subject: [PATCH 108/119] made editors.emacs load windows file on windows --- basis/editors/emacs/emacs.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/basis/editors/emacs/emacs.factor b/basis/editors/emacs/emacs.factor index fa717a70fa..05b879770e 100644 --- a/basis/editors/emacs/emacs.factor +++ b/basis/editors/emacs/emacs.factor @@ -1,6 +1,6 @@ USING: definitions io.launcher kernel parser words sequences math math.parser namespaces editors make system combinators.short-circuit -fry threads ; +fry threads vocabs.loader ; IN: editors.emacs SYMBOL: emacsclient-path @@ -22,3 +22,5 @@ M: object default-emacsclient ( -- path ) "emacsclient" ; where first2 emacsclient ; [ emacsclient ] edit-hook set-global + +os windows? [ "editors.emacs.windows" require ] when From ea851e3a3281db27f60ef3b1653738147435f7e4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 23 Feb 2009 16:47:07 -0600 Subject: [PATCH 109/119] refactor cairo-demo a bit --- extra/cairo-demo/cairo-demo.factor | 66 +++++++++++++++++------------- 1 file changed, 38 insertions(+), 28 deletions(-) diff --git a/extra/cairo-demo/cairo-demo.factor b/extra/cairo-demo/cairo-demo.factor index cec6702ce0..29eb5f4986 100644 --- a/extra/cairo-demo/cairo-demo.factor +++ b/extra/cairo-demo/cairo-demo.factor @@ -7,17 +7,16 @@ USING: cairo.ffi math math.constants byte-arrays kernel ui ui.render - ui.gadgets opengl.gl accessors ; +combinators ui.gadgets opengl.gl accessors ; IN: cairo-demo - : make-image-array ( -- array ) - 384 256 4 * * ; + 384 256 4 * * ; : convert-array-to-surface ( array -- cairo_surface_t ) - CAIRO_FORMAT_ARGB32 384 256 over 4 * - cairo_image_surface_create_for_data ; + CAIRO_FORMAT_ARGB32 384 256 over 4 * + cairo_image_surface_create_for_data ; TUPLE: cairo-demo-gadget < gadget image-array cairo-t ; @@ -33,41 +32,52 @@ M: cairo-demo-gadget draw-gadget* ( gadget -- ) convert-array-to-surface ; : init-cairo ( gadget -- cairo_t ) - create-surface cairo_create ; + create-surface cairo_create ; M: cairo-demo-gadget pref-dim* drop { 384 256 0 } ; +ERROR: no-cairo-t ; + +> - dup "Sans" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_BOLD cairo_select_font_face - dup 90.0 cairo_set_font_size - dup 10.0 135.0 cairo_move_to - dup "Hello" cairo_show_text - dup 70.0 165.0 cairo_move_to - dup "World" cairo_text_path - dup 0.5 0.5 1 cairo_set_source_rgb - dup cairo_fill_preserve - dup 0 0 0 cairo_set_source_rgb - dup 2.56 cairo_set_line_width - dup cairo_stroke - dup 1 0.2 0.2 0.6 cairo_set_source_rgba - dup 10.0 135.0 5.12 0 pi 2 * cairo_arc - dup cairo_close_path - dup 70.0 165.0 5.12 0 pi 2 * cairo_arc - cairo_fill ; + cairo-t>> [ no-cairo-t ] unless* + { + [ + "Sans" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_BOLD + cairo_select_font_face + ] + [ 90.0 cairo_set_font_size ] + [ 10.0 135.0 cairo_move_to ] + [ "Hello" cairo_show_text ] + [ 70.0 165.0 cairo_move_to ] + [ "World" cairo_text_path ] + [ 0.5 0.5 1 cairo_set_source_rgb ] + [ cairo_fill_preserve ] + [ 0 0 0 cairo_set_source_rgb ] + [ 2.56 cairo_set_line_width ] + [ cairo_stroke ] + [ 1 0.2 0.2 0.6 cairo_set_source_rgba ] + [ 10.0 135.0 5.12 0 pi 2 * cairo_arc ] + [ cairo_close_path ] + [ 70.0 165.0 5.12 0 pi 2 * cairo_arc ] + [ cairo_fill ] + } cleave ; + +PRIVATE> M: cairo-demo-gadget graft* ( gadget -- ) - dup dup init-cairo swap (>>cairo-t) draw-hello-world ; + dup dup init-cairo swap (>>cairo-t) draw-hello-world ; M: cairo-demo-gadget ungraft* ( gadget -- ) - cairo-t>> cairo_destroy ; + cairo-t>> cairo_destroy ; : ( -- gadget ) - cairo-demo-gadget new-gadget ; + cairo-demo-gadget new-gadget ; : run ( -- ) - [ + [ "Hello World from Factor!" open-window - ] with-ui ; + ] with-ui ; MAIN: run From f32f94c763a5192f94a4a04d6b6f134b75807722 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 23 Feb 2009 16:53:05 -0600 Subject: [PATCH 110/119] fix cairo-demo drawing --- extra/cairo-demo/cairo-demo.factor | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/extra/cairo-demo/cairo-demo.factor b/extra/cairo-demo/cairo-demo.factor index 29eb5f4986..da744e1d53 100644 --- a/extra/cairo-demo/cairo-demo.factor +++ b/extra/cairo-demo/cairo-demo.factor @@ -6,8 +6,9 @@ ! http://cairographics.org/samples/text/ -USING: cairo.ffi math math.constants byte-arrays kernel ui ui.render -combinators ui.gadgets opengl.gl accessors ; +USING: cairo.ffi math math.constants byte-arrays kernel ui +ui.render combinators ui.gadgets opengl.gl accessors +namespaces opengl ; IN: cairo-demo @@ -18,14 +19,15 @@ IN: cairo-demo CAIRO_FORMAT_ARGB32 384 256 over 4 * cairo_image_surface_create_for_data ; - TUPLE: cairo-demo-gadget < gadget image-array cairo-t ; M: cairo-demo-gadget draw-gadget* ( gadget -- ) - 0 0 glRasterPos2i - 1.0 -1.0 glPixelZoom - [ 384 256 GL_RGBA GL_UNSIGNED_BYTE ] dip - image-array>> glDrawPixels ; + origin get [ + 0 0 glRasterPos2i + 1.0 -1.0 glPixelZoom + [ 384 256 GL_RGBA GL_UNSIGNED_BYTE ] dip + image-array>> glDrawPixels + ] with-translation ; : create-surface ( gadget -- cairo_surface_t ) make-image-array [ swap (>>image-array) ] keep @@ -34,7 +36,7 @@ M: cairo-demo-gadget draw-gadget* ( gadget -- ) : init-cairo ( gadget -- cairo_t ) create-surface cairo_create ; -M: cairo-demo-gadget pref-dim* drop { 384 256 0 } ; +M: cairo-demo-gadget pref-dim* drop { 384 256 } ; ERROR: no-cairo-t ; From 1951d739a0f699b62e2aec683580f87845a29495 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Feb 2009 20:27:05 -0600 Subject: [PATCH 111/119] Stack effect declarations are mandatory on all words now define-temp now takes an effect parameter Fix compiler bug that Dan found Stricter enforcement of * effects Move compile-call from compiler.units to compiler --- basis/alien/c-types/c-types.factor | 6 +- basis/checksums/openssl/openssl.factor | 4 +- basis/cocoa/application/application.factor | 6 +- basis/cocoa/dialogs/dialogs.factor | 4 +- basis/cocoa/messages/messages.factor | 14 +- basis/cocoa/pasteboard/pasteboard.factor | 2 +- basis/cocoa/runtime/runtime.factor | 18 +- basis/cocoa/subclassing/subclassing.factor | 6 +- basis/cocoa/views/views.factor | 74 ++--- basis/compiler/compiler-docs.factor | 9 +- basis/compiler/compiler.factor | 5 +- basis/compiler/tests/codegen.factor | 4 +- basis/compiler/tests/curry.factor | 8 +- basis/compiler/tests/float.factor | 2 +- basis/compiler/tests/intrinsics.factor | 2 +- basis/compiler/tests/optimizer.factor | 9 +- basis/compiler/tests/peg-regression-2.factor | 15 + basis/compiler/tests/simple.factor | 2 +- basis/compiler/tests/tuples.factor | 2 +- .../tree/comparisons/comparisons.factor | 4 +- basis/core-foundation/strings/strings.factor | 28 +- basis/functors/functors.factor | 4 +- basis/io/backend/unix/unix.factor | 2 +- basis/none/none.factor | 2 +- basis/opengl/glu/glu.factor | 294 +++++++++--------- basis/openssl/libcrypto/libcrypto.factor | 2 +- basis/peg/parsers/parsers.factor | 4 +- basis/stack-checker/backend/backend.factor | 48 +-- .../known-words/known-words.factor | 6 + basis/threads/threads.factor | 2 +- basis/tools/deploy/config/config.factor | 8 +- basis/tools/deploy/shaker/shaker.factor | 2 +- basis/ui/cocoa/views/views.factor | 8 +- basis/ui/gadgets/buttons/buttons.factor | 2 +- basis/ui/gadgets/frames/frames.factor | 18 +- basis/ui/gadgets/sliders/sliders.factor | 2 +- basis/ui/gadgets/theme/theme.factor | 4 +- basis/ui/render/render.factor | 10 +- basis/unicode/data/data.factor | 8 +- core/bootstrap/primitives.factor | 2 +- core/compiler/units/units-docs.factor | 4 - core/compiler/units/units.factor | 3 - core/continuations/continuations.factor | 8 +- core/effects/effects.factor | 2 + core/generic/standard/standard.factor | 12 +- core/words/words-docs.factor | 4 +- core/words/words.factor | 4 +- 47 files changed, 349 insertions(+), 340 deletions(-) create mode 100644 basis/compiler/tests/peg-regression-2.factor diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index a44b5cf2b6..c3fd41e689 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2008 Slava Pestov. +! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: byte-arrays arrays assocs kernel kernel.private libc math namespaces make parser sequences strings words assocs splitting @@ -275,7 +275,7 @@ M: long-long-type box-return ( type -- ) : if-void ( type true false -- ) pick "void" = [ drop nip call ] [ nip call ] if ; inline -: primitive-types +CONSTANT: primitive-types { "char" "uchar" "short" "ushort" @@ -284,7 +284,7 @@ M: long-long-type box-return ( type -- ) "longlong" "ulonglong" "float" "double" "void*" "bool" - } ; + } [ diff --git a/basis/checksums/openssl/openssl.factor b/basis/checksums/openssl/openssl.factor index 4bc7a7964a..58748b7c29 100644 --- a/basis/checksums/openssl/openssl.factor +++ b/basis/checksums/openssl/openssl.factor @@ -9,9 +9,9 @@ ERROR: unknown-digest name ; TUPLE: openssl-checksum name ; -: openssl-md5 T{ openssl-checksum f "md5" } ; +CONSTANT: openssl-md5 T{ openssl-checksum f "md5" } -: openssl-sha1 T{ openssl-checksum f "sha1" } ; +CONSTANT: openssl-sha1 T{ openssl-checksum f "sha1" } INSTANCE: openssl-checksum stream-checksum diff --git a/basis/cocoa/application/application.factor b/basis/cocoa/application/application.factor index ab2b6375a9..19d83b86d7 100644 --- a/basis/cocoa/application/application.factor +++ b/basis/cocoa/application/application.factor @@ -19,9 +19,9 @@ IN: cocoa.application ] curry assoc-each ] keep ; -: NSApplicationDelegateReplySuccess 0 ; -: NSApplicationDelegateReplyCancel 1 ; -: NSApplicationDelegateReplyFailure 2 ; +CONSTANT: NSApplicationDelegateReplySuccess 0 +CONSTANT: NSApplicationDelegateReplyCancel 1 +CONSTANT: NSApplicationDelegateReplyFailure 2 : with-autorelease-pool ( quot -- ) NSAutoreleasePool -> new slip -> release ; inline diff --git a/basis/cocoa/dialogs/dialogs.factor b/basis/cocoa/dialogs/dialogs.factor index 13f6f0b7d6..84a1ad46a3 100644 --- a/basis/cocoa/dialogs/dialogs.factor +++ b/basis/cocoa/dialogs/dialogs.factor @@ -18,8 +18,8 @@ IN: cocoa.dialogs dup 0 -> setCanChooseDirectories: dup 0 -> setAllowsMultipleSelection: ; -: NSOKButton 1 ; -: NSCancelButton 0 ; +CONSTANT: NSOKButton 1 +CONSTANT: NSCancelButton 0 : open-panel ( -- paths ) diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index ce66467203..9a1bebd38f 100644 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2006, 2008 Slava Pestov. +! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien alien.c-types alien.strings arrays assocs -continuations combinators compiler compiler.alien kernel math -namespaces make parser quotations sequences strings words -cocoa.runtime io macros memoize io.encodings.utf8 -effects libc libc.private parser lexer init core-foundation fry -generalizations specialized-arrays.direct.alien call ; +continuations combinators compiler compiler.alien stack-checker kernel +math namespaces make parser quotations sequences strings words +cocoa.runtime io macros memoize io.encodings.utf8 effects libc +libc.private parser lexer init core-foundation fry generalizations +specialized-arrays.direct.alien call ; IN: cocoa.messages : make-sender ( method function -- quot ) @@ -14,7 +14,7 @@ IN: cocoa.messages : sender-stub ( method function -- word ) [ "( sender-stub )" f dup ] 2dip over first large-struct? [ "_stret" append ] when - make-sender define ; + make-sender dup infer define-declared ; SYMBOL: message-senders SYMBOL: super-message-senders diff --git a/basis/cocoa/pasteboard/pasteboard.factor b/basis/cocoa/pasteboard/pasteboard.factor index 888f5452e2..1a21b338be 100644 --- a/basis/cocoa/pasteboard/pasteboard.factor +++ b/basis/cocoa/pasteboard/pasteboard.factor @@ -5,7 +5,7 @@ cocoa.classes cocoa.application sequences cocoa core-foundation core-foundation.strings core-foundation.arrays ; IN: cocoa.pasteboard -: NSStringPboardType "NSStringPboardType" ; +CONSTANT: NSStringPboardType "NSStringPboardType" : pasteboard-string? ( pasteboard -- ? ) NSStringPboardType swap -> types CF>string-array member? ; diff --git a/basis/cocoa/runtime/runtime.factor b/basis/cocoa/runtime/runtime.factor index 1a741b789f..7817d0006c 100644 --- a/basis/cocoa/runtime/runtime.factor +++ b/basis/cocoa/runtime/runtime.factor @@ -21,15 +21,15 @@ C-STRUCT: objc-super { "id" "receiver" } { "Class" "class" } ; -: CLS_CLASS HEX: 1 ; -: CLS_META HEX: 2 ; -: CLS_INITIALIZED HEX: 4 ; -: CLS_POSING HEX: 8 ; -: CLS_MAPPED HEX: 10 ; -: CLS_FLUSH_CACHE HEX: 20 ; -: CLS_GROW_CACHE HEX: 40 ; -: CLS_NEED_BIND HEX: 80 ; -: CLS_METHOD_ARRAY HEX: 100 ; +CONSTANT: CLS_CLASS HEX: 1 +CONSTANT: CLS_META HEX: 2 +CONSTANT: CLS_INITIALIZED HEX: 4 +CONSTANT: CLS_POSING HEX: 8 +CONSTANT: CLS_MAPPED HEX: 10 +CONSTANT: CLS_FLUSH_CACHE HEX: 20 +CONSTANT: CLS_GROW_CACHE HEX: 40 +CONSTANT: CLS_NEED_BIND HEX: 80 +CONSTANT: CLS_METHOD_ARRAY HEX: 100 FUNCTION: int objc_getClassList ( void* buffer, int bufferLen ) ; diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor index be53364185..0896312670 100644 --- a/basis/cocoa/subclassing/subclassing.factor +++ b/basis/cocoa/subclassing/subclassing.factor @@ -38,9 +38,9 @@ IN: cocoa.subclassing ] map concat ; : prepare-method ( ret types quot -- type imp ) - [ [ encode-types ] 2keep ] dip [ - "cdecl" swap 4array % \ alien-callback , - ] [ ] make define-temp ; + [ [ encode-types ] 2keep ] dip + '[ _ _ "cdecl" _ alien-callback ] + (( -- callback )) define-temp ; : prepare-methods ( methods -- methods ) [ diff --git a/basis/cocoa/views/views.factor b/basis/cocoa/views/views.factor index e74e912202..4bb6468fa6 100644 --- a/basis/cocoa/views/views.factor +++ b/basis/cocoa/views/views.factor @@ -5,43 +5,43 @@ cocoa cocoa.messages cocoa.classes cocoa.types sequences continuations accessors ; IN: cocoa.views -: NSOpenGLPFAAllRenderers 1 ; -: NSOpenGLPFADoubleBuffer 5 ; -: NSOpenGLPFAStereo 6 ; -: NSOpenGLPFAAuxBuffers 7 ; -: NSOpenGLPFAColorSize 8 ; -: NSOpenGLPFAAlphaSize 11 ; -: NSOpenGLPFADepthSize 12 ; -: NSOpenGLPFAStencilSize 13 ; -: NSOpenGLPFAAccumSize 14 ; -: NSOpenGLPFAMinimumPolicy 51 ; -: NSOpenGLPFAMaximumPolicy 52 ; -: NSOpenGLPFAOffScreen 53 ; -: NSOpenGLPFAFullScreen 54 ; -: NSOpenGLPFASampleBuffers 55 ; -: NSOpenGLPFASamples 56 ; -: NSOpenGLPFAAuxDepthStencil 57 ; -: NSOpenGLPFAColorFloat 58 ; -: NSOpenGLPFAMultisample 59 ; -: NSOpenGLPFASupersample 60 ; -: NSOpenGLPFASampleAlpha 61 ; -: NSOpenGLPFARendererID 70 ; -: NSOpenGLPFASingleRenderer 71 ; -: NSOpenGLPFANoRecovery 72 ; -: NSOpenGLPFAAccelerated 73 ; -: NSOpenGLPFAClosestPolicy 74 ; -: NSOpenGLPFARobust 75 ; -: NSOpenGLPFABackingStore 76 ; -: NSOpenGLPFAMPSafe 78 ; -: NSOpenGLPFAWindow 80 ; -: NSOpenGLPFAMultiScreen 81 ; -: NSOpenGLPFACompliant 83 ; -: NSOpenGLPFAScreenMask 84 ; -: NSOpenGLPFAPixelBuffer 90 ; -: NSOpenGLPFAAllowOfflineRenderers 96 ; -: NSOpenGLPFAVirtualScreenCount 128 ; +CONSTANT: NSOpenGLPFAAllRenderers 1 +CONSTANT: NSOpenGLPFADoubleBuffer 5 +CONSTANT: NSOpenGLPFAStereo 6 +CONSTANT: NSOpenGLPFAAuxBuffers 7 +CONSTANT: NSOpenGLPFAColorSize 8 +CONSTANT: NSOpenGLPFAAlphaSize 11 +CONSTANT: NSOpenGLPFADepthSize 12 +CONSTANT: NSOpenGLPFAStencilSize 13 +CONSTANT: NSOpenGLPFAAccumSize 14 +CONSTANT: NSOpenGLPFAMinimumPolicy 51 +CONSTANT: NSOpenGLPFAMaximumPolicy 52 +CONSTANT: NSOpenGLPFAOffScreen 53 +CONSTANT: NSOpenGLPFAFullScreen 54 +CONSTANT: NSOpenGLPFASampleBuffers 55 +CONSTANT: NSOpenGLPFASamples 56 +CONSTANT: NSOpenGLPFAAuxDepthStencil 57 +CONSTANT: NSOpenGLPFAColorFloat 58 +CONSTANT: NSOpenGLPFAMultisample 59 +CONSTANT: NSOpenGLPFASupersample 60 +CONSTANT: NSOpenGLPFASampleAlpha 61 +CONSTANT: NSOpenGLPFARendererID 70 +CONSTANT: NSOpenGLPFASingleRenderer 71 +CONSTANT: NSOpenGLPFANoRecovery 72 +CONSTANT: NSOpenGLPFAAccelerated 73 +CONSTANT: NSOpenGLPFAClosestPolicy 74 +CONSTANT: NSOpenGLPFARobust 75 +CONSTANT: NSOpenGLPFABackingStore 76 +CONSTANT: NSOpenGLPFAMPSafe 78 +CONSTANT: NSOpenGLPFAWindow 80 +CONSTANT: NSOpenGLPFAMultiScreen 81 +CONSTANT: NSOpenGLPFACompliant 83 +CONSTANT: NSOpenGLPFAScreenMask 84 +CONSTANT: NSOpenGLPFAPixelBuffer 90 +CONSTANT: NSOpenGLPFAAllowOfflineRenderers 96 +CONSTANT: NSOpenGLPFAVirtualScreenCount 128 -: kCGLRendererGenericFloatID HEX: 00020400 ; +CONSTANT: kCGLRendererGenericFloatID HEX: 00020400 USE: opengl.gl USE: alien.syntax -: NSOpenGLCPSwapInterval 222 ; +CONSTANT: NSOpenGLCPSwapInterval 222 LIBRARY: OpenGL diff --git a/basis/compiler/compiler-docs.factor b/basis/compiler/compiler-docs.factor index 1c6e7b796e..9169e9e0fa 100644 --- a/basis/compiler/compiler-docs.factor +++ b/basis/compiler/compiler-docs.factor @@ -1,5 +1,5 @@ USING: help.markup help.syntax words io parser -assocs words.private sequences compiler.units ; +assocs words.private sequences compiler.units quotations ; IN: compiler HELP: enable-compiler @@ -16,6 +16,8 @@ ARTICLE: "compiler-usage" "Calling the optimizing compiler" { $subsection optimized-recompile-hook } "Removing a word's optimized definition:" { $subsection decompile } +"Compiling a single quotation:" +{ $subsection compile-call } "Higher-level words can be found in " { $link "compilation-units" } "." ; ARTICLE: "compiler" "Optimizing compiler" @@ -48,3 +50,8 @@ HELP: optimized-recompile-hook { $values { "words" "a sequence of words" } { "alist" "an association list" } } { $description "Compile a set of words." } { $notes "This is an internal word, and user code should call " { $link compile } " instead." } ; + +HELP: compile-call +{ $values { "quot" quotation } } +{ $description "Compiles and runs a quotation." } +{ $notes "This word is used by compiler unit tests to test compilation of small pieces of code." } ; diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index f2f4e7aa9e..d707dff983 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -49,7 +49,7 @@ SYMBOL: +failed+ H{ } clone generic-dependencies set f swap compiler-error ; -: fail ( word error -- ) +: fail ( word error -- * ) [ swap compiler-error ] [ drop @@ -112,6 +112,9 @@ t compile-dependencies? set-global : decompile ( word -- ) f 2array 1array modify-code-heap ; +: compile-call ( quot -- ) + [ dup infer define-temp ] with-compilation-unit execute ; + : optimized-recompile-hook ( words -- alist ) [ compile-queue set diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index 78e95ffb91..2e02e5476c 100644 --- a/basis/compiler/tests/codegen.factor +++ b/basis/compiler/tests/codegen.factor @@ -51,7 +51,7 @@ unit-test \ foo [ global >n get ndrop ] compile-call ] unit-test -: blech drop ; +: blech ( x -- ) drop ; [ 3 ] [ @@ -102,7 +102,7 @@ unit-test [ ] [ [ [ 200 dup [ 200 3array ] curry map drop ] times - ] [ define-temp ] with-compilation-unit drop + ] [ (( n -- )) define-temp ] with-compilation-unit drop ] unit-test ! Test how dispatch handles the end of a basic block diff --git a/basis/compiler/tests/curry.factor b/basis/compiler/tests/curry.factor index 1857baf503..2d1f15b9a8 100644 --- a/basis/compiler/tests/curry.factor +++ b/basis/compiler/tests/curry.factor @@ -1,5 +1,5 @@ USING: tools.test quotations math kernel sequences -assocs namespaces make compiler.units ; +assocs namespaces make compiler.units compiler ; IN: compiler.tests [ 3 ] [ 5 [ [ 2 - ] curry call ] compile-call ] unit-test @@ -32,15 +32,15 @@ IN: compiler.tests compile-call ] unit-test -: foobar ( quot -- ) - dup slip swap [ foobar ] [ drop ] if ; inline +: foobar ( quot: ( -- ) -- ) + dup slip swap [ foobar ] [ drop ] if ; inline recursive [ ] [ [ [ f ] foobar ] compile-call ] unit-test [ { 6 7 8 } ] [ { 1 2 3 } 5 [ [ + ] curry map ] compile-call ] unit-test [ { 6 7 8 } ] [ { 1 2 3 } [ 5 [ + ] curry map ] compile-call ] unit-test -: funky-assoc>map +: funky-assoc>map ( assoc quot -- seq ) [ [ call f ] curry assoc-find 3drop ] { } make ; inline diff --git a/basis/compiler/tests/float.factor b/basis/compiler/tests/float.factor index 81ab750305..b439b5f6a4 100644 --- a/basis/compiler/tests/float.factor +++ b/basis/compiler/tests/float.factor @@ -1,5 +1,5 @@ IN: compiler.tests -USING: compiler.units kernel kernel.private memory math +USING: compiler.units compiler kernel kernel.private memory math math.private tools.test math.floats.private ; [ 5.0 ] [ [ 5.0 ] compile-call gc gc gc ] unit-test diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor index df5f484952..6c6d580c87 100644 --- a/basis/compiler/tests/intrinsics.factor +++ b/basis/compiler/tests/intrinsics.factor @@ -5,7 +5,7 @@ strings.private system random layouts vectors sbufs strings.private slots.private alien math.order alien.accessors alien.c-types alien.syntax alien.strings namespaces libc sequences.private io.encodings.ascii -classes ; +classes compiler ; IN: compiler.tests ! Make sure that intrinsic ops compile to correct code. diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index c5bbe4a6c3..708d17f3d3 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -3,7 +3,8 @@ stack-checker kernel kernel.private math prettyprint sequences sbufs strings tools.test vectors words sequences.private quotations classes classes.algebra classes.tuple.private continuations growable namespaces hints alien.accessors -compiler.tree.builder compiler.tree.optimizer sequences.deep ; +compiler.tree.builder compiler.tree.optimizer sequences.deep +compiler ; IN: optimizer.tests GENERIC: xyz ( obj -- obj ) @@ -208,14 +209,14 @@ USE: sorting USE: binary-search USE: binary-search.private -: old-binsearch ( elt quot seq -- elt quot i ) +: old-binsearch ( elt quot: ( -- ) seq -- elt quot i ) dup length 1 <= [ from>> ] [ [ midpoint swap call ] 3keep roll dup zero? [ drop dup from>> swap midpoint@ + ] - [ dup midpoint@ cut-slice old-binsearch ] if - ] if ; inline + [ drop dup midpoint@ head-slice old-binsearch ] if + ] if ; inline recursive [ 10 ] [ 10 20 >vector diff --git a/basis/compiler/tests/peg-regression-2.factor b/basis/compiler/tests/peg-regression-2.factor new file mode 100644 index 0000000000..1efadba3aa --- /dev/null +++ b/basis/compiler/tests/peg-regression-2.factor @@ -0,0 +1,15 @@ +IN: compiler.tests +USING: peg.ebnf strings tools.test ; + +GENERIC: ( times -- term' ) +M: string ; + +EBNF: parse-regexp + +Times = .* => [[ "foo" ]] + +Regexp = Times:t => [[ t ]] + +;EBNF + +[ "foo" ] [ "a" parse-regexp ] unit-test \ No newline at end of file diff --git a/basis/compiler/tests/simple.factor b/basis/compiler/tests/simple.factor index a6d6c5dfb9..0fde270eac 100644 --- a/basis/compiler/tests/simple.factor +++ b/basis/compiler/tests/simple.factor @@ -54,7 +54,7 @@ IN: compiler.tests ! Labels -: recursive-test ( ? -- ) [ f recursive-test ] when ; inline +: recursive-test ( ? -- ) [ f recursive-test ] when ; inline recursive [ ] [ t [ recursive-test ] compile-call ] unit-test diff --git a/basis/compiler/tests/tuples.factor b/basis/compiler/tests/tuples.factor index 602b438432..caa214b70c 100644 --- a/basis/compiler/tests/tuples.factor +++ b/basis/compiler/tests/tuples.factor @@ -1,5 +1,5 @@ IN: compiler.tests -USING: kernel tools.test compiler.units ; +USING: kernel tools.test compiler.units compiler ; TUPLE: color red green blue ; diff --git a/basis/compiler/tree/comparisons/comparisons.factor b/basis/compiler/tree/comparisons/comparisons.factor index 5242302411..5f4b1e8dab 100644 --- a/basis/compiler/tree/comparisons/comparisons.factor +++ b/basis/compiler/tree/comparisons/comparisons.factor @@ -5,9 +5,9 @@ IN: compiler.tree.comparisons ! Some utilities for working with comparison operations. -: comparison-ops { < > <= >= } ; +CONSTANT: comparison-ops { < > <= >= } -: generic-comparison-ops { before? after? before=? after=? } ; +CONSTANT: generic-comparison-ops { before? after? before=? after=? } : assumption ( i1 i2 op -- i3 ) { diff --git a/basis/core-foundation/strings/strings.factor b/basis/core-foundation/strings/strings.factor index c3a969a325..50c17dc6fd 100644 --- a/basis/core-foundation/strings/strings.factor +++ b/basis/core-foundation/strings/strings.factor @@ -7,20 +7,20 @@ IN: core-foundation.strings TYPEDEF: void* CFStringRef TYPEDEF: int CFStringEncoding -: kCFStringEncodingMacRoman HEX: 0 ; -: kCFStringEncodingWindowsLatin1 HEX: 0500 ; -: kCFStringEncodingISOLatin1 HEX: 0201 ; -: kCFStringEncodingNextStepLatin HEX: 0B01 ; -: kCFStringEncodingASCII HEX: 0600 ; -: kCFStringEncodingUnicode HEX: 0100 ; -: kCFStringEncodingUTF8 HEX: 08000100 ; -: kCFStringEncodingNonLossyASCII HEX: 0BFF ; -: kCFStringEncodingUTF16 HEX: 0100 ; -: kCFStringEncodingUTF16BE HEX: 10000100 ; -: kCFStringEncodingUTF16LE HEX: 14000100 ; -: kCFStringEncodingUTF32 HEX: 0c000100 ; -: kCFStringEncodingUTF32BE HEX: 18000100 ; -: kCFStringEncodingUTF32LE HEX: 1c000100 ; +CONSTANT: kCFStringEncodingMacRoman HEX: 0 +CONSTANT: kCFStringEncodingWindowsLatin1 HEX: 0500 +CONSTANT: kCFStringEncodingISOLatin1 HEX: 0201 +CONSTANT: kCFStringEncodingNextStepLatin HEX: 0B01 +CONSTANT: kCFStringEncodingASCII HEX: 0600 +CONSTANT: kCFStringEncodingUnicode HEX: 0100 +CONSTANT: kCFStringEncodingUTF8 HEX: 08000100 +CONSTANT: kCFStringEncodingNonLossyASCII HEX: 0BFF +CONSTANT: kCFStringEncodingUTF16 HEX: 0100 +CONSTANT: kCFStringEncodingUTF16BE HEX: 10000100 +CONSTANT: kCFStringEncodingUTF16LE HEX: 14000100 +CONSTANT: kCFStringEncodingUTF32 HEX: 0c000100 +CONSTANT: kCFStringEncodingUTF32BE HEX: 18000100 +CONSTANT: kCFStringEncodingUTF32LE HEX: 1c000100 FUNCTION: CFStringRef CFStringCreateWithBytes ( CFAllocatorRef alloc, diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index 14151692f0..0b9c9caa45 100644 --- a/basis/functors/functors.factor +++ b/basis/functors/functors.factor @@ -80,9 +80,9 @@ M: object fake-quotations> ; scan-param parsed \ add-mixin-instance parsed ; parsing -: `inline \ inline parsed ; parsing +: `inline [ word make-inline ] over push-all ; parsing -: `parsing \ parsing parsed ; parsing +: `parsing [ word make-parsing ] over push-all ; parsing : `( ")" parse-effect effect set ; parsing diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor index f5e6426859..f210180517 100644 --- a/basis/io/backend/unix/unix.factor +++ b/basis/io/backend/unix/unix.factor @@ -77,7 +77,7 @@ M: io-timeout summary drop "I/O operation timed out" ; '[ handle>> _ wait-for-fd ] with-timeout ; ! Some general stuff -: file-mode OCT: 0666 ; +CONSTANT: file-mode OCT: 0666 ! Readers : (refill) ( port -- n ) diff --git a/basis/none/none.factor b/basis/none/none.factor index 66a0de8328..77941479aa 100644 --- a/basis/none/none.factor +++ b/basis/none/none.factor @@ -1,6 +1,6 @@ ! Just a dummy shell for the -run switch... IN: none -: none ; +: none ( -- ) ; MAIN: none diff --git a/basis/opengl/glu/glu.factor b/basis/opengl/glu/glu.factor index da19ac52fc..d603724a55 100644 --- a/basis/opengl/glu/glu.factor +++ b/basis/opengl/glu/glu.factor @@ -11,183 +11,183 @@ TYPEDEF: void* GLubyte* TYPEDEF: void* GLUfuncptr ! StringName -: GLU_VERSION 100800 ; -: GLU_EXTENSIONS 100801 ; +CONSTANT: GLU_VERSION 100800 +CONSTANT: GLU_EXTENSIONS 100801 ! ErrorCode -: GLU_INVALID_ENUM 100900 ; -: GLU_INVALID_VALUE 100901 ; -: GLU_OUT_OF_MEMORY 100902 ; -: GLU_INCOMPATIBLE_GL_VERSION 100903 ; -: GLU_INVALID_OPERATION 100904 ; +CONSTANT: GLU_INVALID_ENUM 100900 +CONSTANT: GLU_INVALID_VALUE 100901 +CONSTANT: GLU_OUT_OF_MEMORY 100902 +CONSTANT: GLU_INCOMPATIBLE_GL_VERSION 100903 +CONSTANT: GLU_INVALID_OPERATION 100904 ! NurbsDisplay -: GLU_OUTLINE_POLYGON 100240 ; -: GLU_OUTLINE_PATCH 100241 ; +CONSTANT: GLU_OUTLINE_POLYGON 100240 +CONSTANT: GLU_OUTLINE_PATCH 100241 ! NurbsCallback -: GLU_NURBS_ERROR 100103 ; -: GLU_ERROR 100103 ; -: GLU_NURBS_BEGIN 100164 ; -: GLU_NURBS_BEGIN_EXT 100164 ; -: GLU_NURBS_VERTEX 100165 ; -: GLU_NURBS_VERTEX_EXT 100165 ; -: GLU_NURBS_NORMAL 100166 ; -: GLU_NURBS_NORMAL_EXT 100166 ; -: GLU_NURBS_COLOR 100167 ; -: GLU_NURBS_COLOR_EXT 100167 ; -: GLU_NURBS_TEXTURE_COORD 100168 ; -: GLU_NURBS_TEX_COORD_EXT 100168 ; -: GLU_NURBS_END 100169 ; -: GLU_NURBS_END_EXT 100169 ; -: GLU_NURBS_BEGIN_DATA 100170 ; -: GLU_NURBS_BEGIN_DATA_EXT 100170 ; -: GLU_NURBS_VERTEX_DATA 100171 ; -: GLU_NURBS_VERTEX_DATA_EXT 100171 ; -: GLU_NURBS_NORMAL_DATA 100172 ; -: GLU_NURBS_NORMAL_DATA_EXT 100172 ; -: GLU_NURBS_COLOR_DATA 100173 ; -: GLU_NURBS_COLOR_DATA_EXT 100173 ; -: GLU_NURBS_TEXTURE_COORD_DATA 100174 ; -: GLU_NURBS_TEX_COORD_DATA_EXT 100174 ; -: GLU_NURBS_END_DATA 100175 ; -: GLU_NURBS_END_DATA_EXT 100175 ; +CONSTANT: GLU_NURBS_ERROR 100103 +CONSTANT: GLU_ERROR 100103 +CONSTANT: GLU_NURBS_BEGIN 100164 +CONSTANT: GLU_NURBS_BEGIN_EXT 100164 +CONSTANT: GLU_NURBS_VERTEX 100165 +CONSTANT: GLU_NURBS_VERTEX_EXT 100165 +CONSTANT: GLU_NURBS_NORMAL 100166 +CONSTANT: GLU_NURBS_NORMAL_EXT 100166 +CONSTANT: GLU_NURBS_COLOR 100167 +CONSTANT: GLU_NURBS_COLOR_EXT 100167 +CONSTANT: GLU_NURBS_TEXTURE_COORD 100168 +CONSTANT: GLU_NURBS_TEX_COORD_EXT 100168 +CONSTANT: GLU_NURBS_END 100169 +CONSTANT: GLU_NURBS_END_EXT 100169 +CONSTANT: GLU_NURBS_BEGIN_DATA 100170 +CONSTANT: GLU_NURBS_BEGIN_DATA_EXT 100170 +CONSTANT: GLU_NURBS_VERTEX_DATA 100171 +CONSTANT: GLU_NURBS_VERTEX_DATA_EXT 100171 +CONSTANT: GLU_NURBS_NORMAL_DATA 100172 +CONSTANT: GLU_NURBS_NORMAL_DATA_EXT 100172 +CONSTANT: GLU_NURBS_COLOR_DATA 100173 +CONSTANT: GLU_NURBS_COLOR_DATA_EXT 100173 +CONSTANT: GLU_NURBS_TEXTURE_COORD_DATA 100174 +CONSTANT: GLU_NURBS_TEX_COORD_DATA_EXT 100174 +CONSTANT: GLU_NURBS_END_DATA 100175 +CONSTANT: GLU_NURBS_END_DATA_EXT 100175 ! NurbsError -: GLU_NURBS_ERROR1 100251 ; -: GLU_NURBS_ERROR2 100252 ; -: GLU_NURBS_ERROR3 100253 ; -: GLU_NURBS_ERROR4 100254 ; -: GLU_NURBS_ERROR5 100255 ; -: GLU_NURBS_ERROR6 100256 ; -: GLU_NURBS_ERROR7 100257 ; -: GLU_NURBS_ERROR8 100258 ; -: GLU_NURBS_ERROR9 100259 ; -: GLU_NURBS_ERROR10 100260 ; -: GLU_NURBS_ERROR11 100261 ; -: GLU_NURBS_ERROR12 100262 ; -: GLU_NURBS_ERROR13 100263 ; -: GLU_NURBS_ERROR14 100264 ; -: GLU_NURBS_ERROR15 100265 ; -: GLU_NURBS_ERROR16 100266 ; -: GLU_NURBS_ERROR17 100267 ; -: GLU_NURBS_ERROR18 100268 ; -: GLU_NURBS_ERROR19 100269 ; -: GLU_NURBS_ERROR20 100270 ; -: GLU_NURBS_ERROR21 100271 ; -: GLU_NURBS_ERROR22 100272 ; -: GLU_NURBS_ERROR23 100273 ; -: GLU_NURBS_ERROR24 100274 ; -: GLU_NURBS_ERROR25 100275 ; -: GLU_NURBS_ERROR26 100276 ; -: GLU_NURBS_ERROR27 100277 ; -: GLU_NURBS_ERROR28 100278 ; -: GLU_NURBS_ERROR29 100279 ; -: GLU_NURBS_ERROR30 100280 ; -: GLU_NURBS_ERROR31 100281 ; -: GLU_NURBS_ERROR32 100282 ; -: GLU_NURBS_ERROR33 100283 ; -: GLU_NURBS_ERROR34 100284 ; -: GLU_NURBS_ERROR35 100285 ; -: GLU_NURBS_ERROR36 100286 ; -: GLU_NURBS_ERROR37 100287 ; +CONSTANT: GLU_NURBS_ERROR1 100251 +CONSTANT: GLU_NURBS_ERROR2 100252 +CONSTANT: GLU_NURBS_ERROR3 100253 +CONSTANT: GLU_NURBS_ERROR4 100254 +CONSTANT: GLU_NURBS_ERROR5 100255 +CONSTANT: GLU_NURBS_ERROR6 100256 +CONSTANT: GLU_NURBS_ERROR7 100257 +CONSTANT: GLU_NURBS_ERROR8 100258 +CONSTANT: GLU_NURBS_ERROR9 100259 +CONSTANT: GLU_NURBS_ERROR10 100260 +CONSTANT: GLU_NURBS_ERROR11 100261 +CONSTANT: GLU_NURBS_ERROR12 100262 +CONSTANT: GLU_NURBS_ERROR13 100263 +CONSTANT: GLU_NURBS_ERROR14 100264 +CONSTANT: GLU_NURBS_ERROR15 100265 +CONSTANT: GLU_NURBS_ERROR16 100266 +CONSTANT: GLU_NURBS_ERROR17 100267 +CONSTANT: GLU_NURBS_ERROR18 100268 +CONSTANT: GLU_NURBS_ERROR19 100269 +CONSTANT: GLU_NURBS_ERROR20 100270 +CONSTANT: GLU_NURBS_ERROR21 100271 +CONSTANT: GLU_NURBS_ERROR22 100272 +CONSTANT: GLU_NURBS_ERROR23 100273 +CONSTANT: GLU_NURBS_ERROR24 100274 +CONSTANT: GLU_NURBS_ERROR25 100275 +CONSTANT: GLU_NURBS_ERROR26 100276 +CONSTANT: GLU_NURBS_ERROR27 100277 +CONSTANT: GLU_NURBS_ERROR28 100278 +CONSTANT: GLU_NURBS_ERROR29 100279 +CONSTANT: GLU_NURBS_ERROR30 100280 +CONSTANT: GLU_NURBS_ERROR31 100281 +CONSTANT: GLU_NURBS_ERROR32 100282 +CONSTANT: GLU_NURBS_ERROR33 100283 +CONSTANT: GLU_NURBS_ERROR34 100284 +CONSTANT: GLU_NURBS_ERROR35 100285 +CONSTANT: GLU_NURBS_ERROR36 100286 +CONSTANT: GLU_NURBS_ERROR37 100287 ! NurbsProperty -: GLU_AUTO_LOAD_MATRIX 100200 ; -: GLU_CULLING 100201 ; -: GLU_SAMPLING_TOLERANCE 100203 ; -: GLU_DISPLAY_MODE 100204 ; -: GLU_PARAMETRIC_TOLERANCE 100202 ; -: GLU_SAMPLING_METHOD 100205 ; -: GLU_U_STEP 100206 ; -: GLU_V_STEP 100207 ; -: GLU_NURBS_MODE 100160 ; -: GLU_NURBS_MODE_EXT 100160 ; -: GLU_NURBS_TESSELLATOR 100161 ; -: GLU_NURBS_TESSELLATOR_EXT 100161 ; -: GLU_NURBS_RENDERER 100162 ; -: GLU_NURBS_RENDERER_EXT 100162 ; +CONSTANT: GLU_AUTO_LOAD_MATRIX 100200 +CONSTANT: GLU_CULLING 100201 +CONSTANT: GLU_SAMPLING_TOLERANCE 100203 +CONSTANT: GLU_DISPLAY_MODE 100204 +CONSTANT: GLU_PARAMETRIC_TOLERANCE 100202 +CONSTANT: GLU_SAMPLING_METHOD 100205 +CONSTANT: GLU_U_STEP 100206 +CONSTANT: GLU_V_STEP 100207 +CONSTANT: GLU_NURBS_MODE 100160 +CONSTANT: GLU_NURBS_MODE_EXT 100160 +CONSTANT: GLU_NURBS_TESSELLATOR 100161 +CONSTANT: GLU_NURBS_TESSELLATOR_EXT 100161 +CONSTANT: GLU_NURBS_RENDERER 100162 +CONSTANT: GLU_NURBS_RENDERER_EXT 100162 ! NurbsSampling -: GLU_OBJECT_PARAMETRIC_ERROR 100208 ; -: GLU_OBJECT_PARAMETRIC_ERROR_EXT 100208 ; -: GLU_OBJECT_PATH_LENGTH 100209 ; -: GLU_OBJECT_PATH_LENGTH_EXT 100209 ; -: GLU_PATH_LENGTH 100215 ; -: GLU_PARAMETRIC_ERROR 100216 ; -: GLU_DOMAIN_DISTANCE 100217 ; +CONSTANT: GLU_OBJECT_PARAMETRIC_ERROR 100208 +CONSTANT: GLU_OBJECT_PARAMETRIC_ERROR_EXT 100208 +CONSTANT: GLU_OBJECT_PATH_LENGTH 100209 +CONSTANT: GLU_OBJECT_PATH_LENGTH_EXT 100209 +CONSTANT: GLU_PATH_LENGTH 100215 +CONSTANT: GLU_PARAMETRIC_ERROR 100216 +CONSTANT: GLU_DOMAIN_DISTANCE 100217 ! NurbsTrim -: GLU_MAP1_TRIM_2 100210 ; -: GLU_MAP1_TRIM_3 100211 ; +CONSTANT: GLU_MAP1_TRIM_2 100210 +CONSTANT: GLU_MAP1_TRIM_3 100211 ! QuadricDrawStyle -: GLU_POINT 100010 ; -: GLU_LINE 100011 ; -: GLU_FILL 100012 ; -: GLU_SILHOUETTE 100013 ; +CONSTANT: GLU_POINT 100010 +CONSTANT: GLU_LINE 100011 +CONSTANT: GLU_FILL 100012 +CONSTANT: GLU_SILHOUETTE 100013 ! QuadricNormal -: GLU_SMOOTH 100000 ; -: GLU_FLAT 100001 ; -: GLU_NONE 100002 ; +CONSTANT: GLU_SMOOTH 100000 +CONSTANT: GLU_FLAT 100001 +CONSTANT: GLU_NONE 100002 ! QuadricOrientation -: GLU_OUTSIDE 100020 ; -: GLU_INSIDE 100021 ; +CONSTANT: GLU_OUTSIDE 100020 +CONSTANT: GLU_INSIDE 100021 ! TessCallback -: GLU_TESS_BEGIN 100100 ; -: GLU_BEGIN 100100 ; -: GLU_TESS_VERTEX 100101 ; -: GLU_VERTEX 100101 ; -: GLU_TESS_END 100102 ; -: GLU_END 100102 ; -: GLU_TESS_ERROR 100103 ; -: GLU_TESS_EDGE_FLAG 100104 ; -: GLU_EDGE_FLAG 100104 ; -: GLU_TESS_COMBINE 100105 ; -: GLU_TESS_BEGIN_DATA 100106 ; -: GLU_TESS_VERTEX_DATA 100107 ; -: GLU_TESS_END_DATA 100108 ; -: GLU_TESS_ERROR_DATA 100109 ; -: GLU_TESS_EDGE_FLAG_DATA 100110 ; -: GLU_TESS_COMBINE_DATA 100111 ; +CONSTANT: GLU_TESS_BEGIN 100100 +CONSTANT: GLU_BEGIN 100100 +CONSTANT: GLU_TESS_VERTEX 100101 +CONSTANT: GLU_VERTEX 100101 +CONSTANT: GLU_TESS_END 100102 +CONSTANT: GLU_END 100102 +CONSTANT: GLU_TESS_ERROR 100103 +CONSTANT: GLU_TESS_EDGE_FLAG 100104 +CONSTANT: GLU_EDGE_FLAG 100104 +CONSTANT: GLU_TESS_COMBINE 100105 +CONSTANT: GLU_TESS_BEGIN_DATA 100106 +CONSTANT: GLU_TESS_VERTEX_DATA 100107 +CONSTANT: GLU_TESS_END_DATA 100108 +CONSTANT: GLU_TESS_ERROR_DATA 100109 +CONSTANT: GLU_TESS_EDGE_FLAG_DATA 100110 +CONSTANT: GLU_TESS_COMBINE_DATA 100111 ! TessContour -: GLU_CW 100120 ; -: GLU_CCW 100121 ; -: GLU_INTERIOR 100122 ; -: GLU_EXTERIOR 100123 ; -: GLU_UNKNOWN 100124 ; +CONSTANT: GLU_CW 100120 +CONSTANT: GLU_CCW 100121 +CONSTANT: GLU_INTERIOR 100122 +CONSTANT: GLU_EXTERIOR 100123 +CONSTANT: GLU_UNKNOWN 100124 ! TessProperty -: GLU_TESS_WINDING_RULE 100140 ; -: GLU_TESS_BOUNDARY_ONLY 100141 ; -: GLU_TESS_TOLERANCE 100142 ; +CONSTANT: GLU_TESS_WINDING_RULE 100140 +CONSTANT: GLU_TESS_BOUNDARY_ONLY 100141 +CONSTANT: GLU_TESS_TOLERANCE 100142 ! TessError -: GLU_TESS_ERROR1 100151 ; -: GLU_TESS_ERROR2 100152 ; -: GLU_TESS_ERROR3 100153 ; -: GLU_TESS_ERROR4 100154 ; -: GLU_TESS_ERROR5 100155 ; -: GLU_TESS_ERROR6 100156 ; -: GLU_TESS_ERROR7 100157 ; -: GLU_TESS_ERROR8 100158 ; -: GLU_TESS_MISSING_BEGIN_POLYGON 100151 ; -: GLU_TESS_MISSING_BEGIN_CONTOUR 100152 ; -: GLU_TESS_MISSING_END_POLYGON 100153 ; -: GLU_TESS_MISSING_END_CONTOUR 100154 ; -: GLU_TESS_COORD_TOO_LARGE 100155 ; -: GLU_TESS_NEED_COMBINE_CALLBACK 100156 ; +CONSTANT: GLU_TESS_ERROR1 100151 +CONSTANT: GLU_TESS_ERROR2 100152 +CONSTANT: GLU_TESS_ERROR3 100153 +CONSTANT: GLU_TESS_ERROR4 100154 +CONSTANT: GLU_TESS_ERROR5 100155 +CONSTANT: GLU_TESS_ERROR6 100156 +CONSTANT: GLU_TESS_ERROR7 100157 +CONSTANT: GLU_TESS_ERROR8 100158 +CONSTANT: GLU_TESS_MISSING_BEGIN_POLYGON 100151 +CONSTANT: GLU_TESS_MISSING_BEGIN_CONTOUR 100152 +CONSTANT: GLU_TESS_MISSING_END_POLYGON 100153 +CONSTANT: GLU_TESS_MISSING_END_CONTOUR 100154 +CONSTANT: GLU_TESS_COORD_TOO_LARGE 100155 +CONSTANT: GLU_TESS_NEED_COMBINE_CALLBACK 100156 ! TessWinding -: GLU_TESS_WINDING_ODD 100130 ; -: GLU_TESS_WINDING_NONZERO 100131 ; -: GLU_TESS_WINDING_POSITIVE 100132 ; -: GLU_TESS_WINDING_NEGATIVE 100133 ; -: GLU_TESS_WINDING_ABS_GEQ_TWO 100134 ; +CONSTANT: GLU_TESS_WINDING_ODD 100130 +CONSTANT: GLU_TESS_WINDING_NONZERO 100131 +CONSTANT: GLU_TESS_WINDING_POSITIVE 100132 +CONSTANT: GLU_TESS_WINDING_NEGATIVE 100133 +CONSTANT: GLU_TESS_WINDING_ABS_GEQ_TWO 100134 LIBRARY: glu diff --git a/basis/openssl/libcrypto/libcrypto.factor b/basis/openssl/libcrypto/libcrypto.factor index 3204b83bbb..9cbed1f752 100644 --- a/basis/openssl/libcrypto/libcrypto.factor +++ b/basis/openssl/libcrypto/libcrypto.factor @@ -99,7 +99,7 @@ FUNCTION: void* BIO_f_buffer ( ) ; ! evp.h ! =============================================== -: EVP_MAX_MD_SIZE 64 ; +CONSTANT: EVP_MAX_MD_SIZE 64 C-STRUCT: EVP_MD_CTX { "EVP_MD*" "digest" } diff --git a/basis/peg/parsers/parsers.factor b/basis/peg/parsers/parsers.factor index a9fb366812..aadbbaff16 100644 --- a/basis/peg/parsers/parsers.factor +++ b/basis/peg/parsers/parsers.factor @@ -7,12 +7,12 @@ IN: peg.parsers TUPLE: just-parser p1 ; -: just-pattern +CONSTANT: just-pattern [ execute dup [ dup remaining>> empty? [ drop f ] unless ] when - ] ; + ] M: just-parser (compile) ( parser -- quot ) diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor index b08bdd8436..5f7eb5ceae 100755 --- a/basis/stack-checker/backend/backend.factor +++ b/basis/stack-checker/backend/backend.factor @@ -124,18 +124,13 @@ M: object apply-object push-literal ; : undo-infer ( -- ) recorded get [ f "inferred-effect" set-word-prop ] each ; -: consume/produce ( effect quot -- ) - #! quot is ( inputs outputs -- ) - [ - [ - [ in>> length consume-d ] - [ out>> length produce-d ] - bi - ] dip call - ] [ - drop - terminated?>> [ terminate ] when - ] 2bi ; inline +: (consume/produce) ( effect -- inputs outputs ) + [ in>> length consume-d ] [ out>> length produce-d ] bi ; + +: consume/produce ( effect quot: ( inputs outputs -- ) -- ) + '[ (consume/produce) @ ] + [ terminated?>> [ terminate ] when ] + bi ; inline : infer-word-def ( word -- ) [ specialized-def ] [ add-recursive-state ] bi infer-quot ; @@ -143,23 +138,12 @@ M: object apply-object push-literal ; : end-infer ( -- ) meta-d clone #return, ; -: effect-required? ( word -- ? ) - { - { [ dup deferred? ] [ drop f ] } - { [ dup crossref? not ] [ drop f ] } - [ def>> [ word? ] any? ] - } cond ; - -: ?missing-effect ( word -- ) - dup effect-required? - [ missing-effect inference-error ] [ drop ] if ; +: required-stack-effect ( word -- effect ) + dup stack-effect [ ] [ missing-effect inference-error ] ?if ; : check-effect ( word effect -- ) - over stack-effect { - { [ dup not ] [ 2drop ?missing-effect ] } - { [ 2dup effect<= ] [ 3drop ] } - [ effect-error ] - } cond ; + over required-stack-effect 2dup effect<= + [ 3drop ] [ effect-error ] if ; : finish-word ( word -- ) current-effect @@ -183,22 +167,20 @@ M: object apply-object push-literal ; dependencies off generic-dependencies off [ infer-word-def end-infer ] - [ finish-word current-effect ] - bi + [ finish-word ] + [ stack-effect ] + tri ] with-scope ] maybe-cannot-infer ; : apply-word/effect ( word effect -- ) swap '[ _ #call, ] consume/produce ; -: required-stack-effect ( word -- effect ) - dup stack-effect [ ] [ \ missing-effect inference-error ] ?if ; - : call-recursive-word ( word -- ) dup required-stack-effect apply-word/effect ; : cached-infer ( word -- ) - dup "inferred-effect" word-prop apply-word/effect ; + dup stack-effect apply-word/effect ; : with-infer ( quot -- effect visitor ) [ diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 56aebb20e7..4ac9d802ed 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -319,12 +319,18 @@ M: object infer-call* \ fixnum/i { fixnum fixnum } { integer } define-primitive \ fixnum/i make-foldable +\ fixnum/i-fast { fixnum fixnum } { fixnum } define-primitive +\ fixnum/i-fast make-foldable + \ fixnum-mod { fixnum fixnum } { fixnum } define-primitive \ fixnum-mod make-foldable \ fixnum/mod { fixnum fixnum } { integer fixnum } define-primitive \ fixnum/mod make-foldable +\ fixnum/mod-fast { fixnum fixnum } { fixnum fixnum } define-primitive +\ fixnum/mod-fast make-foldable + \ fixnum-bitand { fixnum fixnum } { fixnum } define-primitive \ fixnum-bitand make-foldable diff --git a/basis/threads/threads.factor b/basis/threads/threads.factor index 305ef0cca3..8556167009 100644 --- a/basis/threads/threads.factor +++ b/basis/threads/threads.factor @@ -118,7 +118,7 @@ DEFER: stop [ ] while drop ; -: start ( namestack thread -- ) +: start ( namestack thread -- * ) [ set-self set-namestack diff --git a/basis/tools/deploy/config/config.factor b/basis/tools/deploy/config/config.factor index 1d9761e885..63c8393b51 100644 --- a/basis/tools/deploy/config/config.factor +++ b/basis/tools/deploy/config/config.factor @@ -14,12 +14,12 @@ SYMBOL: deploy-threads? SYMBOL: deploy-io -: deploy-io-options +CONSTANT: deploy-io-options { { 1 "Level 1 - No input/output" } { 2 "Level 2 - Basic ANSI C streams" } { 3 "Level 3 - Non-blocking streams and networking" } - } ; + } : strip-io? ( -- ? ) deploy-io get 1 = ; @@ -27,7 +27,7 @@ SYMBOL: deploy-io SYMBOL: deploy-reflection -: deploy-reflection-options +CONSTANT: deploy-reflection-options { { 1 "Level 1 - No reflection" } { 2 "Level 2 - Retain word names" } @@ -35,7 +35,7 @@ SYMBOL: deploy-reflection { 4 "Level 4 - Debugger" } { 5 "Level 5 - Parser" } { 6 "Level 6 - Full environment" } - } ; + } : strip-word-names? ( -- ? ) deploy-reflection get 2 < ; : strip-prettyprint? ( -- ? ) deploy-reflection get 3 < ; diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 5095f9e93e..e61021e633 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -190,7 +190,7 @@ IN: tools.deploy.shaker "Stripping default methods" show [ [ generic? ] instances - [ "No method" throw ] define-temp + [ "No method" throw ] (( -- * )) define-temp dup t "default" set-word-prop '[ [ _ "default-method" set-word-prop ] [ make-generic ] bi diff --git a/basis/ui/cocoa/views/views.factor b/basis/ui/cocoa/views/views.factor index 3201779cc5..9e32f2f4de 100644 --- a/basis/ui/cocoa/views/views.factor +++ b/basis/ui/cocoa/views/views.factor @@ -14,15 +14,15 @@ IN: ui.cocoa.views #! Cocoa -> Factor UI button mapping -> buttonNumber H{ { 0 1 } { 2 2 } { 1 3 } } at ; -: modifiers +CONSTANT: modifiers { { S+ HEX: 20000 } { C+ HEX: 40000 } { A+ HEX: 100000 } { M+ HEX: 80000 } - } ; + } -: key-codes +CONSTANT: key-codes H{ { 71 "CLEAR" } { 36 "RET" } @@ -47,7 +47,7 @@ IN: ui.cocoa.views { 126 "UP" } { 116 "PAGE_UP" } { 121 "PAGE_DOWN" } - } ; + } : key-code ( event -- string ? ) dup -> keyCode key-codes at diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor index dabc12d3ae..3deb280c83 100644 --- a/basis/ui/gadgets/buttons/buttons.factor +++ b/basis/ui/gadgets/buttons/buttons.factor @@ -173,7 +173,7 @@ TUPLE: radio-paint < caching-pen color interior-vertices boundary-vertices ; diff --git a/basis/ui/gadgets/frames/frames.factor b/basis/ui/gadgets/frames/frames.factor index ae4c7d929a..a4d6b46129 100644 --- a/basis/ui/gadgets/frames/frames.factor +++ b/basis/ui/gadgets/frames/frames.factor @@ -13,16 +13,16 @@ M: glue pref-dim* drop { 0 0 } ; : ( -- grid ) 9 [ ] replicate 3 group ; -: @center 1 1 ; inline -: @left 0 1 ; inline -: @right 2 1 ; inline -: @top 1 0 ; inline -: @bottom 1 2 ; inline +: @center ( -- i j ) 1 1 ; inline +: @left ( -- i j ) 0 1 ; inline +: @right ( -- i j ) 2 1 ; inline +: @top ( -- i j ) 1 0 ; inline +: @bottom ( -- i j ) 1 2 ; inline -: @top-left 0 0 ; inline -: @top-right 2 0 ; inline -: @bottom-left 0 2 ; inline -: @bottom-right 2 2 ; inline +: @top-left ( -- i j ) 0 0 ; inline +: @top-right ( -- i j ) 2 0 ; inline +: @bottom-left ( -- i j ) 0 2 ; inline +: @bottom-right ( -- i j ) 2 2 ; inline TUPLE: frame < grid ; diff --git a/basis/ui/gadgets/sliders/sliders.factor b/basis/ui/gadgets/sliders/sliders.factor index 1c2055156e..f22bd08ba2 100644 --- a/basis/ui/gadgets/sliders/sliders.factor +++ b/basis/ui/gadgets/sliders/sliders.factor @@ -18,7 +18,7 @@ TUPLE: slider < frame elevator thumb saved line ; : elevator-length ( slider -- n ) [ elevator>> dim>> ] [ orientation>> ] bi v. ; -: min-thumb-dim 15 ; +CONSTANT: min-thumb-dim 15 : slider-value ( gadget -- n ) model>> range-value >fixnum ; : slider-page ( gadget -- n ) model>> range-page-value ; diff --git a/basis/ui/gadgets/theme/theme.factor b/basis/ui/gadgets/theme/theme.factor index 6ca3868d87..7dabd994c2 100644 --- a/basis/ui/gadgets/theme/theme.factor +++ b/basis/ui/gadgets/theme/theme.factor @@ -56,6 +56,6 @@ IN: ui.gadgets.theme T{ gray f 0.5 1.0 } } ; -: sans-serif-font { "sans-serif" plain 12 } ; +CONSTANT: sans-serif-font { "sans-serif" plain 12 } -: monospace-font { "monospace" plain 12 } ; +CONSTANT: monospace-font { "monospace" plain 12 } diff --git a/basis/ui/render/render.factor b/basis/ui/render/render.factor index 5cbac9798a..a913c78f7d 100755 --- a/basis/ui/render/render.factor +++ b/basis/ui/render/render.factor @@ -191,11 +191,11 @@ M: polygon draw-interior [ [ GL_POLYGON 0 ] dip interior-count>> glDrawArrays ] tri ; -: arrow-up { { 3 0 } { 6 6 } { 0 6 } } ; -: arrow-right { { 0 0 } { 6 3 } { 0 6 } } ; -: arrow-down { { 0 0 } { 6 0 } { 3 6 } } ; -: arrow-left { { 0 3 } { 6 0 } { 6 6 } } ; -: close-box { { 0 0 } { 6 0 } { 6 6 } { 0 6 } } ; +CONSTANT: arrow-up { { 3 0 } { 6 6 } { 0 6 } } +CONSTANT: arrow-right { { 0 0 } { 6 3 } { 0 6 } } +CONSTANT: arrow-down { { 0 0 } { 6 0 } { 3 6 } } +CONSTANT: arrow-left { { 0 3 } { 6 0 } { 6 6 } } +CONSTANT: close-box { { 0 0 } { 6 0 } { 6 6 } { 0 6 } } : ( color points -- gadget ) dup max-dim diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor index de8d28ad2e..bff4ddeaab 100644 --- a/basis/unicode/data/data.factor +++ b/basis/unicode/data/data.factor @@ -97,8 +97,8 @@ VALUE: properties [ nip zero? not ] assoc-filter >hashtable ; -: categories ( -- names ) - ! For non-existent characters, use Cn +! For non-existent characters, use Cn +CONSTANT: categories { "Cn" "Lu" "Ll" "Lt" "Lm" "Lo" "Mn" "Mc" "Me" @@ -106,9 +106,9 @@ VALUE: properties "Pc" "Pd" "Ps" "Pe" "Pi" "Pf" "Po" "Sm" "Sc" "Sk" "So" "Zs" "Zl" "Zp" - "Cc" "Cf" "Cs" "Co" } ; + "Cc" "Cf" "Cs" "Co" } -: num-chars HEX: 2FA1E ; +CONSTANT: num-chars HEX: 2FA1E ! the maximum unicode char in the first 3 planes diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index ceeab571b8..9e064cf99c 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -538,4 +538,4 @@ tuple [ [ first2 ] dip make-primitive ] each-index ! Bump build number -"build" "kernel" create build 1+ 1quotation define +"build" "kernel" create build 1+ [ ] curry (( -- n )) define-declared diff --git a/core/compiler/units/units-docs.factor b/core/compiler/units/units-docs.factor index 09baf91018..46d3dbc33f 100644 --- a/core/compiler/units/units-docs.factor +++ b/core/compiler/units/units-docs.factor @@ -67,7 +67,3 @@ HELP: modify-code-heap ( alist -- ) HELP: compile { $values { "words" "a sequence of words" } } { $description "Compiles a set of words." } ; - -HELP: compile-call -{ $values { "quot" "a quotation" } } -{ $description "Compiles and runs a quotation." } ; diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index ac3e99e24c..0577f8b83c 100644 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -172,9 +172,6 @@ SYMBOL: remake-generics-hook ] [ ] cleanup ] with-scope ; inline -: compile-call ( quot -- ) - [ define-temp ] with-compilation-unit execute ; - : default-recompile-hook ( words -- alist ) [ f ] { } map>assoc ; diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor index c7056856b6..37418b85f5 100644 --- a/core/continuations/continuations.factor +++ b/core/continuations/continuations.factor @@ -92,10 +92,10 @@ C: continuation PRIVATE> -: continue-with ( obj continuation -- ) +: continue-with ( obj continuation -- * ) [ (continue-with) ] 2 (throw) ; -: continue ( continuation -- ) +: continue ( continuation -- * ) f swap continue-with ; SYMBOL: return-continuation @@ -103,7 +103,7 @@ SYMBOL: return-continuation : with-return ( quot -- ) [ [ return-continuation set ] prepose callcc0 ] with-scope ; inline -: return ( -- ) +: return ( -- * ) return-continuation get continue ; : with-datastack ( stack quot -- newstack ) @@ -173,7 +173,7 @@ TUPLE: restart name obj continuation ; C: restart -: restart ( restart -- ) +: restart ( restart -- * ) [ obj>> ] [ continuation>> ] bi continue-with ; M: object compute-restarts drop { } ; diff --git a/core/effects/effects.factor b/core/effects/effects.factor index 8a06653eb8..0e40d926d8 100644 --- a/core/effects/effects.factor +++ b/core/effects/effects.factor @@ -48,6 +48,8 @@ M: word stack-effect { "declared-effect" "inferred-effect" } swap props>> [ at ] curry map [ ] find nip ; +M: deferred stack-effect call-next-method (( -- * )) or ; + M: effect clone [ in>> clone ] [ out>> clone ] bi ; diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor index 9ace1a01f4..f9fe3a6e9e 100644 --- a/core/generic/standard/standard.factor +++ b/core/generic/standard/standard.factor @@ -50,16 +50,16 @@ ERROR: no-method object generic ; convert-hi-tag-methods ; +: mangle-method ( method -- quot ) + 1quotation generic get extra-values \ drop + prepend [ ] like ; + : find-default ( methods -- quot ) #! Side-effects methods. object bootstrap-word swap delete-at* [ - drop generic get "default-method" word-prop 1quotation + drop generic get "default-method" word-prop mangle-method ] unless ; -: mangle-method ( method generic -- quot ) - [ 1quotation ] [ extra-values \ drop ] bi* - prepend [ ] like ; - : ( word -- engine ) object bootstrap-word assumed set { [ generic set ] @@ -67,7 +67,7 @@ ERROR: no-method object generic ; [ V{ } clone "engines" set-word-prop ] [ "methods" word-prop - [ generic get mangle-method ] assoc-map + [ mangle-method ] assoc-map [ find-default default set ] [ ] bi diff --git a/core/words/words-docs.factor b/core/words/words-docs.factor index 4dfa2d49bc..f5990c295e 100644 --- a/core/words/words-docs.factor +++ b/core/words/words-docs.factor @@ -288,12 +288,12 @@ HELP: define-declared { $side-effects "word" } ; HELP: define-temp -{ $values { "quot" quotation } { "word" word } } +{ $values { "quot" quotation } { "effect" effect } { "word" word } } { $description "Creates an uninterned word that will call " { $snippet "quot" } " when executed." } { $notes "The following phrases are equivalent:" { $code "[ 2 2 + . ] call" } - { $code "[ 2 2 + . ] define-temp execute" } + { $code "[ 2 2 + . ] (( -- )) define-temp execute" } "This word must be called from inside " { $link with-compilation-unit } "." } ; diff --git a/core/words/words.factor b/core/words/words.factor index 4a3c1b2d52..43a391e46a 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -212,8 +212,8 @@ M: word subwords drop f ; : gensym ( -- word ) "( gensym )" f ; -: define-temp ( quot -- word ) - [ gensym dup ] dip define ; +: define-temp ( quot effect -- word ) + [ gensym dup ] 2dip define-declared ; : reveal ( word -- ) dup [ name>> ] [ vocabulary>> ] bi dup vocab-words From f1d20719b2b7a75662cea4037c61b2b589da6e94 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Feb 2009 20:51:14 -0600 Subject: [PATCH 112/119] inferred-effect word prop is just a boolean now, not an effect object --- basis/stack-checker/backend/backend.factor | 9 ++++----- core/effects/effects.factor | 4 +--- 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor index 5f7eb5ceae..3c298bdfed 100755 --- a/basis/stack-checker/backend/backend.factor +++ b/basis/stack-checker/backend/backend.factor @@ -146,11 +146,10 @@ M: object apply-object push-literal ; [ 3drop ] [ effect-error ] if ; : finish-word ( word -- ) - current-effect - [ check-effect ] - [ drop recorded get push ] - [ "inferred-effect" set-word-prop ] - 2tri ; + [ current-effect check-effect ] + [ recorded get push ] + [ t "inferred-effect" set-word-prop ] + tri ; : cannot-infer-effect ( word -- * ) "cannot-infer" word-prop throw ; diff --git a/core/effects/effects.factor b/core/effects/effects.factor index 0e40d926d8..a9f9634d46 100644 --- a/core/effects/effects.factor +++ b/core/effects/effects.factor @@ -44,9 +44,7 @@ M: effect effect>string ( effect -- string ) GENERIC: stack-effect ( word -- effect/f ) -M: word stack-effect - { "declared-effect" "inferred-effect" } - swap props>> [ at ] curry map [ ] find nip ; +M: word stack-effect "declared-effect" word-prop ; M: deferred stack-effect call-next-method (( -- * )) or ; From eaad0c766018f8c3eec6cb242a3169e911f975bb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Feb 2009 21:40:17 -0600 Subject: [PATCH 113/119] Updating code to use CONSTANT: instead of : foo 123 ; inline --- .../bootstrap/image/download/download.factor | 2 +- basis/cairo/ffi/ffi.factor | 6 +- basis/farkup/farkup.factor | 2 +- basis/furnace/actions/actions.factor | 2 +- basis/furnace/alloy/alloy.factor | 2 +- basis/furnace/asides/asides.factor | 2 +- basis/furnace/auth/login/login.factor | 2 +- basis/furnace/auth/providers/null/null.factor | 4 +- .../conversations/conversations.factor | 2 +- basis/furnace/sessions/sessions.factor | 2 +- basis/furnace/utilities/utilities.factor | 4 +- .../html/templates/chloe/syntax/syntax.factor | 2 +- basis/io/encodings/8-bit/8-bit.factor | 11 +- basis/logging/server/server.factor | 2 +- basis/math/quaternions/quaternions.factor | 10 +- basis/windows/kernel32/kernel32.factor | 4 +- basis/x11/constants/constants.factor | 350 +++++++++--------- basis/x11/glx/glx.factor | 34 +- basis/x11/xim/xim.factor | 2 +- basis/xml/entities/entities.factor | 12 +- basis/xml/errors/errors.factor | 4 +- extra/24-game/24-game.factor | 2 +- extra/benchmark/backtrack/backtrack.factor | 4 +- extra/benchmark/fasta/fasta.factor | 10 +- extra/benchmark/raytracer/raytracer.factor | 7 +- extra/benchmark/sockets/sockets.factor | 2 +- extra/galois-talk/galois-talk.factor | 4 +- extra/game-input/iokit/iokit.factor | 4 +- .../google-tech-talk/google-tech-talk.factor | 4 +- extra/irc/client/client.factor | 2 +- extra/irc/ui/ui.factor | 6 +- extra/joystick-demo/joystick-demo.factor | 8 +- extra/key-caps/key-caps.factor | 6 +- extra/lint/lint.factor | 2 +- extra/lisppaste/lisppaste.factor | 2 +- extra/mason/common/common.factor | 28 +- extra/math/analysis/analysis.factor | 4 +- extra/maze/maze.factor | 2 +- .../minneapolis-talk/minneapolis-talk.factor | 4 +- extra/minneapolis-talk/minneapolis-talk.txt | 116 ------ extra/nehe/2/2.factor | 4 +- extra/nehe/3/3.factor | 4 +- extra/nehe/4/4.factor | 4 +- extra/nehe/5/5.factor | 4 +- extra/otug-talk/otug-talk.factor | 4 +- extra/slides/slides.factor | 4 +- extra/vpri-talk/vpri-talk.factor | 4 +- extra/yahoo/yahoo.factor | 6 +- unfinished/benchmark/richards/richards.factor | 272 -------------- unfinished/sql/sql-tests.factor | 42 --- unfinished/sql/sql.factor | 172 --------- 51 files changed, 295 insertions(+), 903 deletions(-) delete mode 100755 extra/minneapolis-talk/minneapolis-talk.txt delete mode 100644 unfinished/benchmark/richards/richards.factor delete mode 100644 unfinished/sql/sql-tests.factor delete mode 100755 unfinished/sql/sql.factor diff --git a/basis/bootstrap/image/download/download.factor b/basis/bootstrap/image/download/download.factor index f9b7b56779..5bfc5f7ccc 100644 --- a/basis/bootstrap/image/download/download.factor +++ b/basis/bootstrap/image/download/download.factor @@ -4,7 +4,7 @@ USING: http.client checksums checksums.md5 splitting assocs kernel io.files bootstrap.image sequences io urls ; IN: bootstrap.image.download -: url URL" http://factorcode.org/images/latest/" ; +CONSTANT: url URL" http://factorcode.org/images/latest/" : download-checksums ( -- alist ) url "checksums.txt" >url derive-url http-get nip diff --git a/basis/cairo/ffi/ffi.factor b/basis/cairo/ffi/ffi.factor index d29a3fb097..c2daa05374 100644 --- a/basis/cairo/ffi/ffi.factor +++ b/basis/cairo/ffi/ffi.factor @@ -72,9 +72,9 @@ C-ENUM: CAIRO_STATUS_INVALID_STRIDE ; TYPEDEF: int cairo_content_t -: CAIRO_CONTENT_COLOR HEX: 1000 ; -: CAIRO_CONTENT_ALPHA HEX: 2000 ; -: CAIRO_CONTENT_COLOR_ALPHA HEX: 3000 ; +CONSTANT: CAIRO_CONTENT_COLOR HEX: 1000 +CONSTANT: CAIRO_CONTENT_ALPHA HEX: 2000 +CONSTANT: CAIRO_CONTENT_COLOR_ALPHA HEX: 3000 TYPEDEF: void* cairo_write_func_t : cairo-write-func ( quot -- callback ) diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index eea30a3040..50ee938659 100755 --- a/basis/farkup/farkup.factor +++ b/basis/farkup/farkup.factor @@ -157,7 +157,7 @@ stand-alone = (line | code | heading | list | table | paragraph | nl)* ;EBNF -: invalid-url "javascript:alert('Invalid URL in farkup');" ; +CONSTANT: invalid-url "javascript:alert('Invalid URL in farkup');" : check-url ( href -- href' ) { diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor index 97cb73c9cb..166d2a88a2 100644 --- a/basis/furnace/actions/actions.factor +++ b/basis/furnace/actions/actions.factor @@ -63,7 +63,7 @@ TUPLE: action rest init authorize display validate submit ; : param ( name -- value ) params get at ; -: revalidate-url-key "__u" ; +CONSTANT: revalidate-url-key "__u" : revalidate-url ( -- url/f ) revalidate-url-key param diff --git a/basis/furnace/alloy/alloy.factor b/basis/furnace/alloy/alloy.factor index 0fe80427b9..dc280c1e44 100644 --- a/basis/furnace/alloy/alloy.factor +++ b/basis/furnace/alloy/alloy.factor @@ -10,7 +10,7 @@ furnace.auth.providers furnace.auth.login.permits ; IN: furnace.alloy -: state-classes { session aside conversation permit } ; inline +CONSTANT: state-classes { session aside conversation permit } : init-furnace-tables ( -- ) state-classes ensure-tables diff --git a/basis/furnace/asides/asides.factor b/basis/furnace/asides/asides.factor index 7489d19f94..ecf6d0a628 100644 --- a/basis/furnace/asides/asides.factor +++ b/basis/furnace/asides/asides.factor @@ -23,7 +23,7 @@ aside "ASIDES" { { "post-data" "POST_DATA" FACTOR-BLOB } } define-persistent -: aside-id-key "__a" ; +CONSTANT: aside-id-key "__a" TUPLE: asides < server-state-manager ; diff --git a/basis/furnace/auth/login/login.factor b/basis/furnace/auth/login/login.factor index 0ceafa7f86..915ae1c224 100644 --- a/basis/furnace/auth/login/login.factor +++ b/basis/furnace/auth/login/login.factor @@ -64,7 +64,7 @@ SYMBOL: capabilities PRIVATE> -: flashed-variables { description capabilities } ; +CONSTANT: flashed-variables { description capabilities } : login-failed ( -- * ) "invalid username or password" validation-error diff --git a/basis/furnace/auth/providers/null/null.factor b/basis/furnace/auth/providers/null/null.factor index 39ea812ae7..0fab3c5b09 100644 --- a/basis/furnace/auth/providers/null/null.factor +++ b/basis/furnace/auth/providers/null/null.factor @@ -3,9 +3,7 @@ USING: furnace.auth.providers kernel ; IN: furnace.auth.providers.null -TUPLE: no-users ; - -: no-users T{ no-users } ; +SINGLETON: no-users M: no-users get-user 2drop f ; diff --git a/basis/furnace/conversations/conversations.factor b/basis/furnace/conversations/conversations.factor index 266958c8a4..bbb84e2f05 100644 --- a/basis/furnace/conversations/conversations.factor +++ b/basis/furnace/conversations/conversations.factor @@ -20,7 +20,7 @@ conversation "CONVERSATIONS" { { "session" "SESSION" BIG-INTEGER +not-null+ } } define-persistent -: conversation-id-key "__c" ; +CONSTANT: conversation-id-key "__c" TUPLE: conversations < server-state-manager ; diff --git a/basis/furnace/sessions/sessions.factor b/basis/furnace/sessions/sessions.factor index 52e705c153..3eb7a11215 100644 --- a/basis/furnace/sessions/sessions.factor +++ b/basis/furnace/sessions/sessions.factor @@ -73,7 +73,7 @@ TUPLE: sessions < server-state-manager domain verify? ; [ session set ] [ save-session-after ] bi sessions get responder>> call-responder ; -: session-id-key "__s" ; +CONSTANT: session-id-key "__s" : verify-session ( session -- session ) sessions get verify?>> [ diff --git a/basis/furnace/utilities/utilities.factor b/basis/furnace/utilities/utilities.factor index 4fc68f7735..c0cb7dbced 100755 --- a/basis/furnace/utilities/utilities.factor +++ b/basis/furnace/utilities/utilities.factor @@ -89,7 +89,7 @@ M: object modify-form drop f ; [XML name=<->/> XML] ] [ drop ] if ; -: nested-forms-key "__n" ; +CONSTANT: nested-forms-key "__n" : request-params ( request -- assoc ) dup method>> { @@ -131,7 +131,7 @@ M: object modify-form drop f ; SYMBOL: exit-continuation -: exit-with ( value -- ) +: exit-with ( value -- * ) exit-continuation get continue-with ; : with-exit-continuation ( quot -- value ) diff --git a/basis/html/templates/chloe/syntax/syntax.factor b/basis/html/templates/chloe/syntax/syntax.factor index faf8bed66b..9e7079023d 100644 --- a/basis/html/templates/chloe/syntax/syntax.factor +++ b/basis/html/templates/chloe/syntax/syntax.factor @@ -18,7 +18,7 @@ tags [ H{ } clone ] initialize : CHLOE: scan parse-definition define-chloe-tag ; parsing -: chloe-ns "http://factorcode.org/chloe/1.0" ; inline +CONSTANT: chloe-ns "http://factorcode.org/chloe/1.0" : chloe-name? ( name -- ? ) url>> chloe-ns = ; diff --git a/basis/io/encodings/8-bit/8-bit.factor b/basis/io/encodings/8-bit/8-bit.factor index bad2d9fd82..9ef2b07322 100644 --- a/basis/io/encodings/8-bit/8-bit.factor +++ b/basis/io/encodings/8-bit/8-bit.factor @@ -4,12 +4,12 @@ USING: math.parser arrays io.encodings sequences kernel assocs hashtables io.encodings.ascii generic parser classes.tuple words words.symbol io io.files splitting namespaces math compiler.units accessors classes.singleton classes.mixin -io.encodings.iana ; +io.encodings.iana fry ; IN: io.encodings.8-bit ch ( assoc -- array ) 256 replacement-char - [ [ swapd set-nth ] curry assoc-each ] keep ; + [ '[ swap _ set-nth ] assoc-each ] keep ; : ch>byte ( assoc -- newassoc ) [ swap ] assoc-map >hashtable ; diff --git a/basis/logging/server/server.factor b/basis/logging/server/server.factor index 618dba544c..7dced852fd 100644 --- a/basis/logging/server/server.factor +++ b/basis/logging/server/server.factor @@ -63,7 +63,7 @@ SYMBOL: log-files dup values [ try-dispose ] each clear-assoc ; -: keep-logs 10 ; +CONSTANT: keep-logs 10 : ?delete-file ( path -- ) dup exists? [ delete-file ] [ drop ] if ; diff --git a/basis/math/quaternions/quaternions.factor b/basis/math/quaternions/quaternions.factor index bc6da9f564..f2c2c6d226 100755 --- a/basis/math/quaternions/quaternions.factor +++ b/basis/math/quaternions/quaternions.factor @@ -45,13 +45,13 @@ PRIVATE> first2 [ imaginary-part ] dip >rect 3array ; ! Zero -: q0 { 0 0 } ; +CONSTANT: q0 { 0 0 } ! Units -: q1 { 1 0 } ; -: qi { C{ 0 1 } 0 } ; -: qj { 0 1 } ; -: qk { 0 C{ 0 1 } } ; +CONSTANT: q1 { 1 0 } +CONSTANT: qi { C{ 0 1 } 0 } +CONSTANT: qj { 0 1 } +CONSTANT: qk { 0 C{ 0 1 } } ! Euler angles diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index 8a271f7210..36acc5e346 100755 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -993,8 +993,8 @@ FUNCTION: BOOL DuplicateHandle ( BOOL bInheritHandle, DWORD dwOptions ) ; -: DUPLICATE_CLOSE_SOURCE 1 ; -: DUPLICATE_SAME_ACCESS 2 ; +CONSTANT: DUPLICATE_CLOSE_SOURCE 1 +CONSTANT: DUPLICATE_SAME_ACCESS 2 ! FUNCTION: EncodePointer ! FUNCTION: EncodeSystemPointer diff --git a/basis/x11/constants/constants.factor b/basis/x11/constants/constants.factor index fcce09380f..1fe825d6af 100644 --- a/basis/x11/constants/constants.factor +++ b/basis/x11/constants/constants.factor @@ -12,17 +12,17 @@ TYPEDEF: uchar KeyCode ! Reserved Resource and Constant Definitions -: ParentRelative 1 ; -: CopyFromParent 0 ; -: PointerWindow 0 ; -: InputFocus 1 ; -: PointerRoot 1 ; -: AnyPropertyType 0 ; -: AnyKey 0 ; -: AnyButton 0 ; -: AllTemporary 0 ; -: CurrentTime 0 ; -: NoSymbol 0 ; +CONSTANT: ParentRelative 1 +CONSTANT: CopyFromParent 0 +CONSTANT: PointerWindow 0 +CONSTANT: InputFocus 1 +CONSTANT: PointerRoot 1 +CONSTANT: AnyPropertyType 0 +CONSTANT: AnyKey 0 +CONSTANT: AnyButton 0 +CONSTANT: AllTemporary 0 +CONSTANT: CurrentTime 0 +CONSTANT: NoSymbol 0 ! Key masks. Used as modifiers to GrabButton and GrabKey, results of QueryPointer, ! state in various key-, mouse-, and button-related events. @@ -31,14 +31,14 @@ TYPEDEF: uchar KeyCode ! modifier names. Used to build a SetModifierMapping request or ! to read a GetModifierMapping request. These correspond to the ! masks defined above. -: ShiftMapIndex 0 ; -: LockMapIndex 1 ; -: ControlMapIndex 2 ; -: Mod1MapIndex 3 ; -: Mod2MapIndex 4 ; -: Mod3MapIndex 5 ; -: Mod4MapIndex 6 ; -: Mod5MapIndex 7 ; +CONSTANT: ShiftMapIndex 0 +CONSTANT: LockMapIndex 1 +CONSTANT: ControlMapIndex 2 +CONSTANT: Mod1MapIndex 3 +CONSTANT: Mod2MapIndex 4 +CONSTANT: Mod3MapIndex 5 +CONSTANT: Mod4MapIndex 6 +CONSTANT: Mod5MapIndex 7 ! button masks. Used in same manner as Key masks above. Not to be confused @@ -53,100 +53,100 @@ TYPEDEF: uchar KeyCode ! Notify modes -: NotifyNormal 0 ; -: NotifyGrab 1 ; -: NotifyUngrab 2 ; -: NotifyWhileGrabbed 3 ; +CONSTANT: NotifyNormal 0 +CONSTANT: NotifyGrab 1 +CONSTANT: NotifyUngrab 2 +CONSTANT: NotifyWhileGrabbed 3 -: NotifyHint 1 ; ! for MotionNotify events +CONSTANT: NotifyHint 1 ! for MotionNotify events ! Notify detail -: NotifyAncestor 0 ; -: NotifyVirtual 1 ; -: NotifyInferior 2 ; -: NotifyNonlinear 3 ; -: NotifyNonlinearVirtual 4 ; -: NotifyPointer 5 ; -: NotifyPointerRoot 6 ; -: NotifyDetailNone 7 ; +CONSTANT: NotifyAncestor 0 +CONSTANT: NotifyVirtual 1 +CONSTANT: NotifyInferior 2 +CONSTANT: NotifyNonlinear 3 +CONSTANT: NotifyNonlinearVirtual 4 +CONSTANT: NotifyPointer 5 +CONSTANT: NotifyPointerRoot 6 +CONSTANT: NotifyDetailNone 7 ! Visibility notify -: VisibilityUnobscured 0 ; -: VisibilityPartiallyObscured 1 ; -: VisibilityFullyObscured 2 ; +CONSTANT: VisibilityUnobscured 0 +CONSTANT: VisibilityPartiallyObscured 1 +CONSTANT: VisibilityFullyObscured 2 ! Circulation request -: PlaceOnTop 0 ; -: PlaceOnBottom 1 ; +CONSTANT: PlaceOnTop 0 +CONSTANT: PlaceOnBottom 1 ! protocol families -: FamilyInternet 0 ; ! IPv4 -: FamilyDECnet 1 ; -: FamilyChaos 2 ; -: FamilyInternet6 6 ; ! IPv6 +CONSTANT: FamilyInternet 0 ! IPv4 +CONSTANT: FamilyDECnet 1 +CONSTANT: FamilyChaos 2 +CONSTANT: FamilyInternet6 6 ! IPv6 ! authentication families not tied to a specific protocol -: FamilyServerInterpreted 5 ; +CONSTANT: FamilyServerInterpreted 5 ! Property notification -: PropertyNewValue 0 ; -: PropertyDelete 1 ; +CONSTANT: PropertyNewValue 0 +CONSTANT: PropertyDelete 1 ! Color Map notification -: ColormapUninstalled 0 ; -: ColormapInstalled 1 ; +CONSTANT: ColormapUninstalled 0 +CONSTANT: ColormapInstalled 1 ! GrabPointer, GrabButton, GrabKeyboard, GrabKey Modes -: GrabModeSync 0 ; -: GrabModeAsync 1 ; +CONSTANT: GrabModeSync 0 +CONSTANT: GrabModeAsync 1 ! GrabPointer, GrabKeyboard reply status -: GrabSuccess 0 ; -: AlreadyGrabbed 1 ; -: GrabInvalidTime 2 ; -: GrabNotViewable 3 ; -: GrabFrozen 4 ; +CONSTANT: GrabSuccess 0 +CONSTANT: AlreadyGrabbed 1 +CONSTANT: GrabInvalidTime 2 +CONSTANT: GrabNotViewable 3 +CONSTANT: GrabFrozen 4 ! AllowEvents modes -: AsyncPointer 0 ; -: SyncPointer 1 ; -: ReplayPointer 2 ; -: AsyncKeyboard 3 ; -: SyncKeyboard 4 ; -: ReplayKeyboard 5 ; -: AsyncBoth 6 ; -: SyncBoth 7 ; +CONSTANT: AsyncPointer 0 +CONSTANT: SyncPointer 1 +CONSTANT: ReplayPointer 2 +CONSTANT: AsyncKeyboard 3 +CONSTANT: SyncKeyboard 4 +CONSTANT: ReplayKeyboard 5 +CONSTANT: AsyncBoth 6 +CONSTANT: SyncBoth 7 ! Used in SetInputFocus, GetInputFocus : RevertToNone ( -- n ) None ; : RevertToPointerRoot ( -- n ) PointerRoot ; -: RevertToParent 2 ; +CONSTANT: RevertToParent 2 ! ***************************************************************** ! * ERROR CODES ! ***************************************************************** -: Success 0 ; ! everything's okay -: BadRequest 1 ; ! bad request code -: BadValue 2 ; ! int parameter out of range -: BadWindow 3 ; ! parameter not a Window -: BadPixmap 4 ; ! parameter not a Pixmap -: BadAtom 5 ; ! parameter not an Atom -: BadCursor 6 ; ! parameter not a Cursor -: BadFont 7 ; ! parameter not a Font -: BadMatch 8 ; ! parameter mismatch -: BadDrawable 9 ; ! parameter not a Pixmap or Window -: BadAccess 10 ; ! depending on context: +CONSTANT: Success 0 ! everything's okay +CONSTANT: BadRequest 1 ! bad request code +CONSTANT: BadValue 2 ! int parameter out of range +CONSTANT: BadWindow 3 ! parameter not a Window +CONSTANT: BadPixmap 4 ! parameter not a Pixmap +CONSTANT: BadAtom 5 ! parameter not an Atom +CONSTANT: BadCursor 6 ! parameter not a Cursor +CONSTANT: BadFont 7 ! parameter not a Font +CONSTANT: BadMatch 8 ! parameter mismatch +CONSTANT: BadDrawable 9 ! parameter not a Pixmap or Window +CONSTANT: BadAccess 10 ! depending on context: ! - key/button already grabbed ! - attempt to free an illegal ! cmap entry @@ -154,16 +154,16 @@ TYPEDEF: uchar KeyCode ! color map entry. ! - attempt to modify the access control ! list from other than the local host. -: BadAlloc 11 ; ! insufficient resources -: BadColor 12 ; ! no such colormap -: BadGC 13 ; ! parameter not a GC -: BadIDChoice 14 ; ! choice not in range or already used -: BadName 15 ; ! font or color name doesn't exist -: BadLength 16 ; ! Request length incorrect -: BadImplementation 17 ; ! server is defective +CONSTANT: BadAlloc 11 ! insufficient resources +CONSTANT: BadColor 12 ! no such colormap +CONSTANT: BadGC 13 ! parameter not a GC +CONSTANT: BadIDChoice 14 ! choice not in range or already used +CONSTANT: BadName 15 ! font or color name doesn't exist +CONSTANT: BadLength 16 ! Request length incorrect +CONSTANT: BadImplementation 17 ! server is defective -: FirstExtensionError 128 ; -: LastExtensionError 255 ; +CONSTANT: FirstExtensionError 128 +CONSTANT: LastExtensionError 255 ! ***************************************************************** ! * WINDOW DEFINITIONS @@ -172,44 +172,44 @@ TYPEDEF: uchar KeyCode ! Window classes used by CreateWindow ! Note that CopyFromParent is already defined as 0 above -: InputOutput 1 ; -: InputOnly 2 ; +CONSTANT: InputOutput 1 +CONSTANT: InputOnly 2 ! Used in CreateWindow for backing-store hint -: NotUseful 0 ; -: WhenMapped 1 ; -: Always 2 ; +CONSTANT: NotUseful 0 +CONSTANT: WhenMapped 1 +CONSTANT: Always 2 ! Used in ChangeSaveSet -: SetModeInsert 0 ; -: SetModeDelete 1 ; +CONSTANT: SetModeInsert 0 +CONSTANT: SetModeDelete 1 ! Used in ChangeCloseDownMode -: DestroyAll 0 ; -: RetainPermanent 1 ; -: RetainTemporary 2 ; +CONSTANT: DestroyAll 0 +CONSTANT: RetainPermanent 1 +CONSTANT: RetainTemporary 2 ! Window stacking method (in configureWindow) -: Above 0 ; -: Below 1 ; -: TopIf 2 ; -: BottomIf 3 ; -: Opposite 4 ; +CONSTANT: Above 0 +CONSTANT: Below 1 +CONSTANT: TopIf 2 +CONSTANT: BottomIf 3 +CONSTANT: Opposite 4 ! Circulation direction -: RaiseLowest 0 ; -: LowerHighest 1 ; +CONSTANT: RaiseLowest 0 +CONSTANT: LowerHighest 1 ! Property modes -: PropModeReplace 0 ; -: PropModePrepend 1 ; -: PropModeAppend 2 ; +CONSTANT: PropModeReplace 0 +CONSTANT: PropModePrepend 1 +CONSTANT: PropModeAppend 2 ! ***************************************************************** ! * GRAPHICS DEFINITIONS @@ -217,62 +217,62 @@ TYPEDEF: uchar KeyCode ! LineStyle -: LineSolid 0 ; -: LineOnOffDash 1 ; -: LineDoubleDash 2 ; +CONSTANT: LineSolid 0 +CONSTANT: LineOnOffDash 1 +CONSTANT: LineDoubleDash 2 ! capStyle -: CapNotLast 0 ; -: CapButt 1 ; -: CapRound 2 ; -: CapProjecting 3 ; +CONSTANT: CapNotLast 0 +CONSTANT: CapButt 1 +CONSTANT: CapRound 2 +CONSTANT: CapProjecting 3 ! joinStyle -: JoinMiter 0 ; -: JoinRound 1 ; -: JoinBevel 2 ; +CONSTANT: JoinMiter 0 +CONSTANT: JoinRound 1 +CONSTANT: JoinBevel 2 ! fillStyle -: FillSolid 0 ; -: FillTiled 1 ; -: FillStippled 2 ; -: FillOpaqueStippled 3 ; +CONSTANT: FillSolid 0 +CONSTANT: FillTiled 1 +CONSTANT: FillStippled 2 +CONSTANT: FillOpaqueStippled 3 ! fillRule -: EvenOddRule 0 ; -: WindingRule 1 ; +CONSTANT: EvenOddRule 0 +CONSTANT: WindingRule 1 ! subwindow mode -: ClipByChildren 0 ; -: IncludeInferiors 1 ; +CONSTANT: ClipByChildren 0 +CONSTANT: IncludeInferiors 1 ! SetClipRectangles ordering -: Unsorted 0 ; -: YSorted 1 ; -: YXSorted 2 ; -: YXBanded 3 ; +CONSTANT: Unsorted 0 +CONSTANT: YSorted 1 +CONSTANT: YXSorted 2 +CONSTANT: YXBanded 3 ! CoordinateMode for drawing routines -: CoordModeOrigin 0 ; ! relative to the origin -: CoordModePrevious 1 ; ! relative to previous point +CONSTANT: CoordModeOrigin 0 ! relative to the origin +CONSTANT: CoordModePrevious 1 ! relative to previous point ! Polygon shapes -: Complex 0 ; ! paths may intersect -: Nonconvex 1 ; ! no paths intersect, but not convex -: Convex 2 ; ! wholly convex +CONSTANT: Complex 0 ! paths may intersect +CONSTANT: Nonconvex 1 ! no paths intersect, but not convex +CONSTANT: Convex 2 ! wholly convex ! Arc modes for PolyFillArc -: ArcChord 0 ; ! join endpoints of arc -: ArcPieSlice 1 ; ! join endpoints to center of arc +CONSTANT: ArcChord 0 ! join endpoints of arc +CONSTANT: ArcPieSlice 1 ! join endpoints to center of arc ! ***************************************************************** ! * FONTS @@ -280,10 +280,10 @@ TYPEDEF: uchar KeyCode ! used in QueryFont -- draw direction -: FontLeftToRight 0 ; -: FontRightToLeft 1 ; +CONSTANT: FontLeftToRight 0 +CONSTANT: FontRightToLeft 1 -: FontChange 255 ; +CONSTANT: FontChange 255 ! ***************************************************************** ! * IMAGING @@ -291,9 +291,9 @@ TYPEDEF: uchar KeyCode ! ImageFormat -- PutImage, GetImage -: XYBitmap 0 ; ! depth 1, XYFormat -: XYPixmap 1 ; ! depth == drawable depth -: ZPixmap 2 ; ! depth == drawable depth +CONSTANT: XYBitmap 0 ! depth 1, XYFormat +CONSTANT: XYPixmap 1 ! depth == drawable depth +CONSTANT: ZPixmap 2 ! depth == drawable depth ! ***************************************************************** ! * COLOR MAP STUFF @@ -301,8 +301,8 @@ TYPEDEF: uchar KeyCode ! For CreateColormap -: AllocNone 0 ; ! create map with no entries -: AllocAll 1 ; ! allocate entire map writeable +CONSTANT: AllocNone 0 ! create map with no entries +CONSTANT: AllocAll 1 ! allocate entire map writeable ! Flags used in StoreNamedColor, StoreColors @@ -317,20 +317,20 @@ TYPEDEF: uchar KeyCode ! QueryBestSize Class -: CursorShape 0 ; ! largest size that can be displayed -: TileShape 1 ; ! size tiled fastest -: StippleShape 2 ; ! size stippled fastest +CONSTANT: CursorShape 0 ! largest size that can be displayed +CONSTANT: TileShape 1 ! size tiled fastest +CONSTANT: StippleShape 2 ! size stippled fastest ! ***************************************************************** ! * KEYBOARD/POINTER STUFF ! ***************************************************************** -: AutoRepeatModeOff 0 ; -: AutoRepeatModeOn 1 ; -: AutoRepeatModeDefault 2 ; +CONSTANT: AutoRepeatModeOff 0 +CONSTANT: AutoRepeatModeOn 1 +CONSTANT: AutoRepeatModeDefault 2 -: LedModeOff 0 ; -: LedModeOn 1 ; +CONSTANT: LedModeOff 0 +CONSTANT: LedModeOn 1 ! masks for ChangeKeyboardControl @@ -343,33 +343,33 @@ TYPEDEF: uchar KeyCode : KBKey ( -- n ) 6 2^ ; : KBAutoRepeatMode ( -- n ) 7 2^ ; -: MappingSuccess 0 ; -: MappingBusy 1 ; -: MappingFailed 2 ; +CONSTANT: MappingSuccess 0 +CONSTANT: MappingBusy 1 +CONSTANT: MappingFailed 2 -: MappingModifier 0 ; -: MappingKeyboard 1 ; -: MappingPointer 2 ; +CONSTANT: MappingModifier 0 +CONSTANT: MappingKeyboard 1 +CONSTANT: MappingPointer 2 ! ***************************************************************** ! * SCREEN SAVER STUFF ! ***************************************************************** -: DontPreferBlanking 0 ; -: PreferBlanking 1 ; -: DefaultBlanking 2 ; +CONSTANT: DontPreferBlanking 0 +CONSTANT: PreferBlanking 1 +CONSTANT: DefaultBlanking 2 -: DisableScreenSaver 0 ; -: DisableScreenInterval 0 ; +CONSTANT: DisableScreenSaver 0 +CONSTANT: DisableScreenInterval 0 -: DontAllowExposures 0 ; -: AllowExposures 1 ; -: DefaultExposures 2 ; +CONSTANT: DontAllowExposures 0 +CONSTANT: AllowExposures 1 +CONSTANT: DefaultExposures 2 ! for ForceScreenSaver -: ScreenSaverReset 0 ; -: ScreenSaverActive 1 ; +CONSTANT: ScreenSaverReset 0 +CONSTANT: ScreenSaverActive 1 ! ***************************************************************** ! * HOSTS AND CONNECTIONS @@ -377,30 +377,30 @@ TYPEDEF: uchar KeyCode ! for ChangeHosts -: HostInsert 0 ; -: HostDelete 1 ; +CONSTANT: HostInsert 0 +CONSTANT: HostDelete 1 ! for ChangeAccessControl -: EnableAccess 1 ; -: DisableAccess 0 ; +CONSTANT: EnableAccess 1 +CONSTANT: DisableAccess 0 ! Display classes used in opening the connection ! Note that the statically allocated ones are even numbered and the ! dynamically changeable ones are odd numbered -: StaticGray 0 ; -: GrayScale 1 ; -: StaticColor 2 ; -: PseudoColor 3 ; -: TrueColor 4 ; -: DirectColor 5 ; +CONSTANT: StaticGray 0 +CONSTANT: GrayScale 1 +CONSTANT: StaticColor 2 +CONSTANT: PseudoColor 3 +CONSTANT: TrueColor 4 +CONSTANT: DirectColor 5 ! Byte order used in imageByteOrder and bitmapBitOrder -: LSBFirst 0 ; -: MSBFirst 1 ; +CONSTANT: LSBFirst 0 +CONSTANT: MSBFirst 1 ! ***************************************************************** ! * EXTENDED WINDOW MANAGER HINTS diff --git a/basis/x11/glx/glx.factor b/basis/x11/glx/glx.factor index 11473d6e83..e6001d3e59 100644 --- a/basis/x11/glx/glx.factor +++ b/basis/x11/glx/glx.factor @@ -9,23 +9,23 @@ IN: x11.glx LIBRARY: glx ! Visual Config Attributes (glXGetConfig, glXGetFBConfigAttrib) -: GLX_USE_GL 1 ; ! support GLX rendering -: GLX_BUFFER_SIZE 2 ; ! depth of the color buffer -: GLX_LEVEL 3 ; ! level in plane stacking -: GLX_RGBA 4 ; ! true if RGBA mode -: GLX_DOUBLEBUFFER 5 ; ! double buffering supported -: GLX_STEREO 6 ; ! stereo buffering supported -: GLX_AUX_BUFFERS 7 ; ! number of aux buffers -: GLX_RED_SIZE 8 ; ! number of red component bits -: GLX_GREEN_SIZE 9 ; ! number of green component bits -: GLX_BLUE_SIZE 10 ; ! number of blue component bits -: GLX_ALPHA_SIZE 11 ; ! number of alpha component bits -: GLX_DEPTH_SIZE 12 ; ! number of depth bits -: GLX_STENCIL_SIZE 13 ; ! number of stencil bits -: GLX_ACCUM_RED_SIZE 14 ; ! number of red accum bits -: GLX_ACCUM_GREEN_SIZE 15 ; ! number of green accum bits -: GLX_ACCUM_BLUE_SIZE 16 ; ! number of blue accum bits -: GLX_ACCUM_ALPHA_SIZE 17 ; ! number of alpha accum bits +CONSTANT: GLX_USE_GL 1 ! support GLX rendering +CONSTANT: GLX_BUFFER_SIZE 2 ! depth of the color buffer +CONSTANT: GLX_LEVEL 3 ! level in plane stacking +CONSTANT: GLX_RGBA 4 ! true if RGBA mode +CONSTANT: GLX_DOUBLEBUFFER 5 ! double buffering supported +CONSTANT: GLX_STEREO 6 ! stereo buffering supported +CONSTANT: GLX_AUX_BUFFERS 7 ! number of aux buffers +CONSTANT: GLX_RED_SIZE 8 ! number of red component bits +CONSTANT: GLX_GREEN_SIZE 9 ! number of green component bits +CONSTANT: GLX_BLUE_SIZE 10 ! number of blue component bits +CONSTANT: GLX_ALPHA_SIZE 11 ! number of alpha component bits +CONSTANT: GLX_DEPTH_SIZE 12 ! number of depth bits +CONSTANT: GLX_STENCIL_SIZE 13 ! number of stencil bits +CONSTANT: GLX_ACCUM_RED_SIZE 14 ! number of red accum bits +CONSTANT: GLX_ACCUM_GREEN_SIZE 15 ! number of green accum bits +CONSTANT: GLX_ACCUM_BLUE_SIZE 16 ! number of blue accum bits +CONSTANT: GLX_ACCUM_ALPHA_SIZE 17 ! number of alpha accum bits TYPEDEF: XID GLXContextID TYPEDEF: XID GLXPixmap diff --git a/basis/x11/xim/xim.factor b/basis/x11/xim/xim.factor index 534e47ac37..e06872fa83 100644 --- a/basis/x11/xim/xim.factor +++ b/basis/x11/xim/xim.factor @@ -34,7 +34,7 @@ SYMBOL: xim XNResourceClass over 0 XCreateIC [ "XCreateIC() failed" throw ] unless* ; -: buf-size 100 ; +CONSTANT: buf-size 100 SYMBOL: keybuf SYMBOL: keysym diff --git a/basis/xml/entities/entities.factor b/basis/xml/entities/entities.factor index 3e768b1b88..7eac725052 100644 --- a/basis/xml/entities/entities.factor +++ b/basis/xml/entities/entities.factor @@ -4,20 +4,20 @@ USING: namespaces make kernel assocs sequences fry values io.files io.encodings.binary xml.state ; IN: xml.entities -: entities-out +CONSTANT: entities-out H{ { CHAR: < "<" } { CHAR: > ">" } { CHAR: & "&" } - } ; + } -: quoted-entities-out +CONSTANT: quoted-entities-out H{ { CHAR: & "&" } { CHAR: ' "'" } { CHAR: " """ } { CHAR: < "<" } - } ; + } : escape-string-by ( str table -- escaped ) #! Convert <, >, &, ' and " to HTML entities. @@ -29,14 +29,14 @@ IN: xml.entities : escape-quoted-string ( str -- newstr ) quoted-entities-out escape-string-by ; -: entities +CONSTANT: entities H{ { "lt" CHAR: < } { "gt" CHAR: > } { "amp" CHAR: & } { "apos" CHAR: ' } { "quot" CHAR: " } - } ; + } : with-entities ( entities quot -- ) [ swap extra-entities set call ] with-scope ; inline diff --git a/basis/xml/errors/errors.factor b/basis/xml/errors/errors.factor index 304b38f2bd..35111f5a54 100644 --- a/basis/xml/errors/errors.factor +++ b/basis/xml/errors/errors.factor @@ -290,7 +290,7 @@ M: quoteless-attr summary TUPLE: attr-w/< < xml-error-at ; -: attr-w/< ( value -- * ) +: attr-w/< ( -- * ) \ attr-w/< xml-error-at throw ; M: attr-w/< summary @@ -299,7 +299,7 @@ M: attr-w/< summary TUPLE: text-w/]]> < xml-error-at ; -: text-w/]]> ( text -- * ) +: text-w/]]> ( -- * ) \ text-w/]]> xml-error-at throw ; M: text-w/]]> summary diff --git a/extra/24-game/24-game.factor b/extra/24-game/24-game.factor index f842d5f4cb..f22ca001f4 100644 --- a/extra/24-game/24-game.factor +++ b/extra/24-game/24-game.factor @@ -7,7 +7,7 @@ arrays words quotations accessors math.parser backtrack assocs ; IN: 24-game SYMBOL: commands -: nop ; +: nop ( -- ) ; : do-something ( a b -- c ) { + - * } amb-execute ; : maybe-swap ( a b -- a b ) { nop swap } amb-execute ; : some-rots ( a b c -- a b c ) diff --git a/extra/benchmark/backtrack/backtrack.factor b/extra/benchmark/backtrack/backtrack.factor index df67872b11..0ae7d792dd 100755 --- a/extra/benchmark/backtrack/backtrack.factor +++ b/extra/benchmark/backtrack/backtrack.factor @@ -10,7 +10,7 @@ IN: benchmark.backtrack ! placing them on the stack, and applying the operations ! +, -, * and rot as many times as we wish. -: nop ; +: nop ( -- ) ; : do-something ( a b -- c ) { + - * } amb-execute ; @@ -42,7 +42,7 @@ MEMO: 24-from-4 ( a b c d -- ? ) ] sigma ] sigma ; -: words { 24-from-1 24-from-2 24-from-3 24-from-4 } ; +CONSTANT: words { 24-from-1 24-from-2 24-from-3 24-from-4 } : backtrack-benchmark ( -- ) words [ reset-memoized ] each diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor index 61d9e9fd43..2ae5ada8a1 100755 --- a/extra/benchmark/fasta/fasta.factor +++ b/extra/benchmark/fasta/fasta.factor @@ -10,8 +10,6 @@ CONSTANT: IC 29573 CONSTANT: initial-seed 42 CONSTANT: line-length 60 -USE: math.private - : random ( seed -- n seed ) >float IA * IC + IM mod [ IM /f ] keep ; inline @@ -19,7 +17,7 @@ HINTS: random fixnum ; CONSTANT: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA" -: IUB +CONSTANT: IUB { { CHAR: a 0.27 } { CHAR: c 0.12 } @@ -37,15 +35,15 @@ CONSTANT: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACC { CHAR: V 0.02 } { CHAR: W 0.02 } { CHAR: Y 0.02 } - } ; inline + } -: homo-sapiens +CONSTANT: homo-sapiens { { CHAR: a 0.3029549426680 } { CHAR: c 0.1979883004921 } { CHAR: g 0.1975473066391 } { CHAR: t 0.3015094502008 } - } ; inline + } : make-cumulative ( freq -- chars floats ) dup keys >byte-array diff --git a/extra/benchmark/raytracer/raytracer.factor b/extra/benchmark/raytracer/raytracer.factor index 8d07ae1c65..a4df1fe04d 100755 --- a/extra/benchmark/raytracer/raytracer.factor +++ b/extra/benchmark/raytracer/raytracer.factor @@ -8,13 +8,14 @@ hints ; IN: benchmark.raytracer ! parameters -: light - #! Normalized { -1 -3 2 }. + +! Normalized { -1 -3 2 }. +CONSTANT: light double-array{ -0.2672612419124244 -0.8017837257372732 0.5345224838248488 - } ; inline + } CONSTANT: oversampling 4 diff --git a/extra/benchmark/sockets/sockets.factor b/extra/benchmark/sockets/sockets.factor index 20c905156b..d6e4f29b86 100755 --- a/extra/benchmark/sockets/sockets.factor +++ b/extra/benchmark/sockets/sockets.factor @@ -10,7 +10,7 @@ SYMBOL: counter SYMBOL: port-promise SYMBOL: server -: number-of-requests 1000 ; +CONSTANT: number-of-requests 1000 : server-addr ( -- addr ) "127.0.0.1" port-promise get ?promise ; diff --git a/extra/galois-talk/galois-talk.factor b/extra/galois-talk/galois-talk.factor index 259fa446af..ccba90fb6f 100644 --- a/extra/galois-talk/galois-talk.factor +++ b/extra/galois-talk/galois-talk.factor @@ -8,7 +8,7 @@ help.topics math.functions compiler.tree.optimizer compiler.cfg.optimizer fry ; IN: galois-talk -: galois-slides +CONSTANT: galois-slides { { $slide "Factor!" { $url "http://factorcode.org" } @@ -305,7 +305,7 @@ IN: galois-talk "Factor has many cool things that I didn't talk about" "Questions?" } -} ; +} : galois-talk ( -- ) galois-slides slides-window ; diff --git a/extra/game-input/iokit/iokit.factor b/extra/game-input/iokit/iokit.factor index 8a10535306..254ed61ab0 100755 --- a/extra/game-input/iokit/iokit.factor +++ b/extra/game-input/iokit/iokit.factor @@ -121,12 +121,12 @@ CONSTANT: hat-switch-matching-hash : hat-switch? ( {usage-page,usage} -- ? ) { 1 HEX: 39 } = ; inline -: pov-values +CONSTANT: pov-values { pov-up pov-up-right pov-right pov-down-right pov-down pov-down-left pov-left pov-up-left pov-neutral - } ; inline + } : button-value ( value -- f/(0,1] ) IOHIDValueGetIntegerValue dup zero? [ drop f ] when ; diff --git a/extra/google-tech-talk/google-tech-talk.factor b/extra/google-tech-talk/google-tech-talk.factor index 9bd3c5854b..4d4e3b0507 100644 --- a/extra/google-tech-talk/google-tech-talk.factor +++ b/extra/google-tech-talk/google-tech-talk.factor @@ -8,7 +8,7 @@ help.topics math.functions compiler.tree.optimizer compiler.cfg.optimizer fry ; IN: google-tech-talk -: google-slides +CONSTANT: google-slides { { $slide "Factor!" { $url "http://factorcode.org" } @@ -562,7 +562,7 @@ IN: google-tech-talk "Put your prejudices aside and give it a shot!" } { $slide "Questions?" } -} ; +} : google-talk ( -- ) google-slides slides-window ; diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 0eba6f6af5..2770471093 100755 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -12,7 +12,7 @@ IN: irc.client ! Setup and running objects ! ====================================== -: irc-port 6667 ; ! Default irc port +CONSTANT: irc-port 6667 ! Default irc port TUPLE: irc-profile server port nickname password ; C: irc-profile diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index 59e4cf6cb4..791639d260 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -28,9 +28,9 @@ TUPLE: irc-tab < frame chat client window ; : write-color ( str color -- ) foreground associate format ; -: dark-red T{ rgba f 0.5 0.0 0.0 1 } ; -: dark-green T{ rgba f 0.0 0.5 0.0 1 } ; -: dark-blue T{ rgba f 0.0 0.0 0.5 1 } ; +CONSTANT: dark-red T{ rgba f 0.5 0.0 0.0 1 } +CONSTANT: dark-green T{ rgba f 0.0 0.5 0.0 1 } +CONSTANT: dark-blue T{ rgba f 0.0 0.0 0.5 1 } : dot-or-parens ( string -- string ) [ "." ] diff --git a/extra/joystick-demo/joystick-demo.factor b/extra/joystick-demo/joystick-demo.factor index 9e457c7bdd..188095dd2e 100755 --- a/extra/joystick-demo/joystick-demo.factor +++ b/extra/joystick-demo/joystick-demo.factor @@ -5,8 +5,8 @@ calendar locals strings ui.gadgets.buttons combinators math.parser assocs threads ; IN: joystick-demo -: SIZE { 151 151 } ; -: INDICATOR-SIZE { 4 4 } ; +CONSTANT: SIZE { 151 151 } +CONSTANT: INDICATOR-SIZE { 4 4 } : FREQUENCY ( -- f ) 30 recip seconds ; TUPLE: axis-gadget < gadget indicator z-indicator pov ; @@ -21,7 +21,7 @@ M: axis-gadget pref-dim* drop SIZE ; : indicator-polygon ( -- polygon ) { 0 0 } INDICATOR-SIZE (rect-polygon) ; -: pov-polygons +CONSTANT: pov-polygons V{ { pov-neutral { { 70 75 } { 75 70 } { 80 75 } { 75 80 } } } { pov-up { { 70 65 } { 75 60 } { 80 65 } } } @@ -32,7 +32,7 @@ M: axis-gadget pref-dim* drop SIZE ; { pov-down-left { { 67 90 } { 60 90 } { 60 83 } } } { pov-left { { 65 70 } { 60 75 } { 65 80 } } } { pov-up-left { { 67 60 } { 60 60 } { 60 67 } } } - } ; + } : ( color -- indicator ) indicator-polygon ; diff --git a/extra/key-caps/key-caps.factor b/extra/key-caps/key-caps.factor index 05edb205d2..acf20f90ab 100755 --- a/extra/key-caps/key-caps.factor +++ b/extra/key-caps/key-caps.factor @@ -4,7 +4,7 @@ words arrays assocs math calendar fry alarms ui ui.gadgets.borders ui.gestures ; IN: key-caps -: key-locations H{ +CONSTANT: key-locations H{ { key-escape { { 0 0 } { 10 10 } } } { key-f1 { { 20 0 } { 10 10 } } } @@ -129,9 +129,9 @@ IN: key-caps { key-keypad-0 { { 190 55 } { 20 10 } } } { key-keypad-. { { 210 55 } { 10 10 } } } -} ; +} -: KEYBOARD-SIZE { 230 65 } ; +CONSTANT: KEYBOARD-SIZE { 230 65 } : FREQUENCY ( -- f ) 30 recip seconds ; TUPLE: key-caps-gadget < gadget keys alarm ; diff --git a/extra/lint/lint.factor b/extra/lint/lint.factor index 849cc540a3..9877c70062 100755 --- a/extra/lint/lint.factor +++ b/extra/lint/lint.factor @@ -42,7 +42,7 @@ SYMBOL: def-hash-keys set-alien-float alien-float } ; -: trivial-defs +: trivial-defs ( -- seq ) { [ drop ] [ 2array ] [ bitand ] diff --git a/extra/lisppaste/lisppaste.factor b/extra/lisppaste/lisppaste.factor index df85f01f26..43b5b78097 100644 --- a/extra/lisppaste/lisppaste.factor +++ b/extra/lisppaste/lisppaste.factor @@ -1,7 +1,7 @@ USING: arrays kernel xml-rpc ; IN: lisppaste -: url "http://www.common-lisp.net:8185/RPC2" ; +CONSTANT: url "http://www.common-lisp.net:8185/RPC2" : channels ( -- seq ) { } "listchannels" url invoke-method ; diff --git a/extra/mason/common/common.factor b/extra/mason/common/common.factor index ec0cbdbc9c..3cd38e1ff4 100644 --- a/extra/mason/common/common.factor +++ b/extra/mason/common/common.factor @@ -67,24 +67,24 @@ SYMBOL: stamp : ?prepare-build-machine ( -- ) builds/factor exists? [ prepare-build-machine ] unless ; -: load-everything-vocabs-file "load-everything-vocabs" ; -: load-everything-errors-file "load-everything-errors" ; +CONSTANT: load-everything-vocabs-file "load-everything-vocabs" +CONSTANT: load-everything-errors-file "load-everything-errors" -: test-all-vocabs-file "test-all-vocabs" ; -: test-all-errors-file "test-all-errors" ; +CONSTANT: test-all-vocabs-file "test-all-vocabs" +CONSTANT: test-all-errors-file "test-all-errors" -: help-lint-vocabs-file "help-lint-vocabs" ; -: help-lint-errors-file "help-lint-errors" ; +CONSTANT: help-lint-vocabs-file "help-lint-vocabs" +CONSTANT: help-lint-errors-file "help-lint-errors" -: boot-time-file "boot-time" ; -: load-time-file "load-time" ; -: compiler-errors-file "compiler-errors" ; -: test-time-file "test-time" ; -: help-lint-time-file "help-lint-time" ; -: benchmark-time-file "benchmark-time" ; -: html-help-time-file "html-help-time" ; +CONSTANT: boot-time-file "boot-time" +CONSTANT: load-time-file "load-time" +CONSTANT: compiler-errors-file "compiler-errors" +CONSTANT: test-time-file "test-time" +CONSTANT: help-lint-time-file "help-lint-time" +CONSTANT: benchmark-time-file "benchmark-time" +CONSTANT: html-help-time-file "html-help-time" -: benchmarks-file "benchmarks" ; +CONSTANT: benchmarks-file "benchmarks" SYMBOL: status diff --git a/extra/math/analysis/analysis.factor b/extra/math/analysis/analysis.factor index 9c773f748e..fa01b0376d 100755 --- a/extra/math/analysis/analysis.factor +++ b/extra/math/analysis/analysis.factor @@ -11,11 +11,11 @@ IN: math.analysis CONSTANT: gamma-g6 5.15 -: gamma-p6 +CONSTANT: gamma-p6 { 2.50662827563479526904 225.525584619175212544 -268.295973841304927459 80.9030806934622512966 -5.00757863970517583837 0.0114684895434781459556 - } ; inline + } : gamma-z ( x n -- seq ) [ + recip ] with map 1.0 0 pick set-nth ; diff --git a/extra/maze/maze.factor b/extra/maze/maze.factor index de345e732e..a490a8bbfc 100644 --- a/extra/maze/maze.factor +++ b/extra/maze/maze.factor @@ -4,7 +4,7 @@ arrays kernel random ui ui.gadgets ui.gadgets.canvas ui.render math.order math.geometry.rect ; IN: maze -: line-width 8 ; +CONSTANT: line-width 8 SYMBOL: visited diff --git a/extra/minneapolis-talk/minneapolis-talk.factor b/extra/minneapolis-talk/minneapolis-talk.factor index 25bad4061a..6f1df44bfb 100755 --- a/extra/minneapolis-talk/minneapolis-talk.factor +++ b/extra/minneapolis-talk/minneapolis-talk.factor @@ -2,7 +2,7 @@ USING: slides help.markup math arrays hashtables namespaces sequences kernel sequences parser memoize ; IN: minneapolis-talk -: minneapolis-slides +CONSTANT: minneapolis-slides { { $slide "What is Factor?" "Dynamically typed, stack language" @@ -175,7 +175,7 @@ IN: minneapolis-talk "Mailing list: factor-talk@lists.sf.net" } { $slide "Questions?" } -} ; +} : minneapolis-talk ( -- ) minneapolis-slides slides-window ; diff --git a/extra/minneapolis-talk/minneapolis-talk.txt b/extra/minneapolis-talk/minneapolis-talk.txt deleted file mode 100755 index 5310accf5b..0000000000 --- a/extra/minneapolis-talk/minneapolis-talk.txt +++ /dev/null @@ -1,116 +0,0 @@ -- how to create a small module -- editor integration -- presentations -- module system -- copy and paste factoring, inverse -- help system -- tetris -- memoization -- editing inspector demo -- dynamic scope, lexical scope - -Factor: contradictions? ------------------------ - -Have our cake and eat it too - -Research -vs- practical -High level -vs- fast -Interactive -vs- deployment - -Factor from 10,000 feet ------------------------ - -word: named function -vocabulary: module -quotation: anonymous function -classes, objects, etc. - -The stack ---------- - -- Stack -vs- applicative -- Pass by reference, dynamically typed -- Stack languages: you can omit names where they're not needed -- More compositional style -- If you need to name things for clarity, you can: - lexical vars, dynamic vars, sequences, assocs, objects... - -Functional programming ----------------------- - -Quotations -Curry -Continuations - -Object-oriented programming ---------------------------- - -Generic words: sort of like open classes -Tuple reshaping -Editing inspector - -Meta programming ----------------- - -Simple, orthogonal core - -Why use a stack at all? ------------------------ - -Nice idioms: 10 days ago -Copy and paste factoring -Easy meta-programming -Sequence operations correspond to functional operations: -- curry is adding at the front -- compose is append - -UI --- - -Written in Factor -renders with OpenGL -Windows, X11, Cocoa backends -You can call Windows, X11, Cocoa APIs directly -OpenGL 2.1 shaders, OpenAL 3D audio... - -Tools ------ - -Edit -Usages -Profiler -Easy to make your own tools - -Implementation --------------- - -Two compilers -Generational garbage collector -Non-blocking I/O - -Hands on --------- - -Community ---------- - -Factor started in 2003 -About a dozen contributors -Handful of "core contributors" -Web site: http://factorcode.org -IRC: #concatenative on irc.freenode.net -Mailing list: factor-talk@lists.sf.net - -C library interface -------------------- - -Efficient -No need to write C code -Supports floats, structs, unions, ... -Function pointers, callbacks -Here is an example - -TerminateProcess - -process-handle TerminateProcess diff --git a/extra/nehe/2/2.factor b/extra/nehe/2/2.factor index 29d4ccffc1..fdb53ef254 100644 --- a/extra/nehe/2/2.factor +++ b/extra/nehe/2/2.factor @@ -4,8 +4,8 @@ IN: nehe.2 TUPLE: nehe2-gadget < gadget ; -: width 256 ; -: height 256 ; +CONSTANT: width 256 +CONSTANT: height 256 : ( -- gadget ) nehe2-gadget new-gadget ; diff --git a/extra/nehe/3/3.factor b/extra/nehe/3/3.factor index 75f2e573cc..557655a029 100644 --- a/extra/nehe/3/3.factor +++ b/extra/nehe/3/3.factor @@ -4,8 +4,8 @@ IN: nehe.3 TUPLE: nehe3-gadget < gadget ; -: width 256 ; -: height 256 ; +CONSTANT: width 256 +CONSTANT: height 256 : ( -- gadget ) nehe3-gadget new-gadget ; diff --git a/extra/nehe/4/4.factor b/extra/nehe/4/4.factor index fda22d2f1e..00308277ea 100644 --- a/extra/nehe/4/4.factor +++ b/extra/nehe/4/4.factor @@ -5,8 +5,8 @@ IN: nehe.4 TUPLE: nehe4-gadget < gadget rtri rquad thread quit? ; -: width 256 ; -: height 256 ; +CONSTANT: width 256 +CONSTANT: height 256 : redraw-interval ( -- dt ) 10 milliseconds ; : ( -- gadget ) diff --git a/extra/nehe/5/5.factor b/extra/nehe/5/5.factor index 30d0991fd8..3723014c83 100755 --- a/extra/nehe/5/5.factor +++ b/extra/nehe/5/5.factor @@ -4,8 +4,8 @@ calendar ; IN: nehe.5 TUPLE: nehe5-gadget < gadget rtri rquad thread quit? ; -: width 256 ; -: height 256 ; +CONSTANT: width 256 +CONSTANT: height 256 : redraw-interval ( -- dt ) 10 milliseconds ; : ( -- gadget ) diff --git a/extra/otug-talk/otug-talk.factor b/extra/otug-talk/otug-talk.factor index b52749dbe1..ef5782dda7 100644 --- a/extra/otug-talk/otug-talk.factor +++ b/extra/otug-talk/otug-talk.factor @@ -39,7 +39,7 @@ M: png-gadget ungraft* ( gadget -- ) : $tetris ( element -- ) drop [ gadget. ] ($block) ; -: otug-slides +CONSTANT: otug-slides { { $slide "Factor!" { $url "http://factorcode.org" } @@ -361,7 +361,7 @@ var price = (order == null ? null : order.price);"> } "Factor has many cool things that I didn't talk about" "Questions?" } -} ; +} : otug-talk ( -- ) otug-slides slides-window ; diff --git a/extra/slides/slides.factor b/extra/slides/slides.factor index 0ce946dc49..ba21ba9c84 100755 --- a/extra/slides/slides.factor +++ b/extra/slides/slides.factor @@ -6,7 +6,7 @@ ui.gadgets.books ui.gadgets.panes ui.gestures ui.render parser accessors colors ; IN: slides -: stylesheet +CONSTANT: stylesheet H{ { default-span-style H{ @@ -40,7 +40,7 @@ IN: slides H{ { table-gap { 10 20 } } } } { bullet "\u0000b7" } - } ; + } : $title ( string -- ) [ H{ { font "sans-serif" } { font-size 48 } } format ] ($block) ; diff --git a/extra/vpri-talk/vpri-talk.factor b/extra/vpri-talk/vpri-talk.factor index 35d8bb52ff..5d7620101f 100644 --- a/extra/vpri-talk/vpri-talk.factor +++ b/extra/vpri-talk/vpri-talk.factor @@ -8,7 +8,7 @@ help.topics math.functions compiler.tree.optimizer compiler.cfg.optimizer fry ; IN: vpri-talk -: vpri-slides +CONSTANT: vpri-slides { { $slide "Factor!" { $url "http://factorcode.org" } @@ -485,7 +485,7 @@ IN: vpri-talk "Factor has many cool things that I didn't talk about" "Questions?" } -} ; +} : vpri-talk ( -- ) vpri-slides slides-window ; diff --git a/extra/yahoo/yahoo.factor b/extra/yahoo/yahoo.factor index b58a11747f..5e0c08b430 100755 --- a/extra/yahoo/yahoo.factor +++ b/extra/yahoo/yahoo.factor @@ -18,8 +18,7 @@ format similar-ok language country site subscription license ; first3 ] map ; -: yahoo-url ( -- str ) - URL" http://search.yahooapis.com/WebSearchService/V1/webSearch" ; +CONSTANT: yahoo-url URL" http://search.yahooapis.com/WebSearchService/V1/webSearch" :: param ( search url name quot -- search url ) search url search quot call @@ -49,8 +48,7 @@ format similar-ok language country site subscription license ; "similar_ok" [ similar-ok>> ] bool-param nip ; -: factor-id - "fRrVAKzV34GDyeRw6bUHDhEWHRedwfOC7e61wwXZLgGF80E67spxdQXuugBe2pgIevMmKwA-" ; +CONSTANT: factor-id "fRrVAKzV34GDyeRw6bUHDhEWHRedwfOC7e61wwXZLgGF80E67spxdQXuugBe2pgIevMmKwA-" : ( query -- search ) search new diff --git a/unfinished/benchmark/richards/richards.factor b/unfinished/benchmark/richards/richards.factor deleted file mode 100644 index 90d4304eee..0000000000 --- a/unfinished/benchmark/richards/richards.factor +++ /dev/null @@ -1,272 +0,0 @@ -! Based on http://research.sun.com/people/mario/java_benchmarking/ -! Ported by Factor by Slava Pestov -! -! Based on original version written in BCPL by Dr Martin Richards -! in 1981 at Cambridge University Computer Laboratory, England -! Java version: Copyright (C) 1995 Sun Microsystems, Inc. -! by Jonathan Gibbons. -! Outer loop added 8/7/96 by Alex Jacoby -USING: values kernel accessors math math.bitwise sequences -arrays combinators fry locals ; -IN: benchmark.richards - -! Packets -TUPLE: packet link id kind a1 a2 ; - -: BUFSIZE 4 ; inline - -: ( link id kind -- packet ) - packet new - swap >>kind - swap >>id - swap >>link - 0 >>a1 - BUFSIZE 0 >>a2 ; - -: last-packet ( packet -- last ) - dup link>> [ last-packet ] [ ] ?if ; - -: append-to ( packet list -- packet ) - [ f >>link ] dip - [ tuck last-packet >>link drop ] when* ; - -! Tasks -: I_IDLE 1 ; inline -: I_WORK 2 ; inline -: I_HANDLERA 3 ; inline -: I_HANDLERB 4 ; inline -: I_DEVA 5 ; inline -: I_DEVB 6 ; inline - -! Packet types -: K_DEV 1000 ; inline -: K_WORK 1001 ; inline - -: PKTBIT 1 ; inline -: WAITBIT 2 ; inline -: HOLDBIT 4 ; inline - -: S_RUN 0 ; inline -: S_RUNPKT ( -- n ) { PKTBIT } flags ; inline -: S_WAIT ( -- n ) { WAITBIT } flags ; inline -: S_WAITPKT ( -- n ) { WAITBIT PKTBIT } flags ; inline -: S_HOLD ( -- n ) { HOLDBIT } flags ; inline -: S_HOLDPKT ( -- n ) { HOLDBIT PKTBIT } flags ; inline -: S_HOLDWAIT ( -- n ) { HOLDBIT WAITBIT } flags ; inline -: S_HOLDWAITPKT ( -- n ) { HOLDBIT WAITBIT PKTBIT } flags ; inline - -: task-tab-size 10 ; inline - -VALUE: task-tab -VALUE: task-list -VALUE: tracing -VALUE: hold-count -VALUE: qpkt-count - -TUPLE: task link id pri wkq state ; - -: new-task ( id pri wkq state class -- task ) - new - swap >>state - swap >>wkq - swap >>pri - swap >>id - task-list >>link - dup to: task-list - dup dup id>> task-tab set-nth ; inline - -GENERIC: fn ( packet task -- task ) - -: state-on ( task flag -- task ) - '[ _ bitor ] change-state ; inline - -: state-off ( task flag -- task ) - '[ _ bitnot bitand ] change-state ; inline - -: wait-task ( task -- task ) - WAITBIT state-on ; - -: hold ( task -- task ) - hold-count 1+ to: hold-count - HOLDBIT state-on - link>> ; - -: highest-priority ( t1 t2 -- t1/t2 ) - [ [ pri>> ] bi@ > ] most ; - -: find-tcb ( i -- task ) - task-tab nth [ "Bad task" throw ] unless* ; - -: release ( task i -- task ) - find-tcb HOLDBIT state-off highest-priority ; - -:: qpkt ( task pkt -- task ) - [let | t [ pkt id>> find-tcb ] | - t [ - qpkt-count 1+ to: qpkt-count - f pkt (>>link) - task id>> pkt (>>id) - t wkq>> [ - pkt t wkq>> append-to t (>>wkq) - task - ] [ - pkt t (>>wkq) - t PKTBIT state-on drop - t task highest-priority - ] if - ] [ task ] if - ] ; - -: schedule-waitpkt ( task -- task pkt ) - dup wkq>> - 2dup link>> >>wkq drop - 2dup S_RUNPKT S_RUN ? >>state drop ; inline - -: schedule-run ( task pkt -- task ) - swap fn ; inline - -: schedule-wait ( task -- task ) - link>> ; inline - -: (schedule) ( task -- ) - [ - dup state>> { - { S_WAITPKT [ schedule-waitpkt schedule-run (schedule) ] } - { S_RUN [ f schedule-run (schedule) ] } - { S_RUNPKT [ f schedule-run (schedule) ] } - { S_WAIT [ schedule-wait (schedule) ] } - { S_HOLD [ schedule-wait (schedule) ] } - { S_HOLDPKT [ schedule-wait (schedule) ] } - { S_HOLDWAIT [ schedule-wait (schedule) ] } - { S_HOLDWAITPKT [ schedule-wait (schedule) ] } - [ 2drop ] - } case - ] when* ; - -: schedule ( -- ) - task-list (schedule) ; - -! Device task -TUPLE: device-task < task v1 ; - -: ( id pri wkq -- task ) - dup S_WAITPKT S_WAIT ? device-task new-task ; - -M:: device-task fn ( pkt task -- task ) - pkt [ - task dup v1>> - [ wait-task ] - [ [ f ] change-v1 swap qpkt ] if - ] [ pkt task (>>v1) task hold ] if ; - -TUPLE: handler-task < task workpkts devpkts ; - -: ( id pri wkq -- task ) - dup S_WAITPKT S_WAIT ? handler-task new-task ; - -M:: handler-task fn ( pkt task -- task ) - pkt [ - task over kind>> K_WORK = - [ [ append-to ] change-workpkts ] - [ [ append-to ] change-devpkts ] - if drop - ] when* - - task workpkts>> [ - [let* | devpkt [ task devpkts>> ] - workpkt [ task workpkts>> ] - count [ workpkt a1>> ] | - count BUFSIZE > [ - workpkt link>> task (>>workpkts) - task workpkt qpkt - ] [ - devpkt [ - devpkt link>> task (>>devpkts) - count workpkt a2>> nth devpkt (>>a1) - count 1+ workpkt (>>a1) - task devpkt qpkt - ] [ - task wait-task - ] if - ] if - ] - ] [ task wait-task ] if ; - -! Idle task -TUPLE: idle-task < task { v1 fixnum } { v2 fixnum } ; - -: ( i a1 a2 -- task ) - [ 0 f S_RUN idle-task new-task ] 2dip - [ >>v1 ] [ >>v2 ] bi* ; - -M: idle-task fn ( pkt task -- task ) - nip - [ 1- ] change-v2 - dup v2>> 0 = [ hold ] [ - dup v1>> 1 bitand 0 = [ - [ -1 shift ] change-v1 - I_DEVA release - ] [ - [ -1 shift HEX: d008 bitor ] change-v1 - I_DEVB release - ] if - ] if ; - -! Work task -TUPLE: work-task < task { handler fixnum } { n fixnum } ; - -: ( id pri w -- work-task ) - dup S_WAITPKT S_WAIT ? work-task new-task - I_HANDLERA >>handler - 0 >>n ; - -M:: work-task fn ( pkt task -- task ) - pkt [ - task [ I_HANDLERA = I_HANDLERB I_HANDLERA ? ] change-handler drop - task handler>> pkt (>>id) - 0 pkt (>>a1) - BUFSIZE [| i | - task [ 1+ ] change-n drop - task n>> 26 > [ 1 task (>>n) ] when - task n>> 1 - CHAR: A + i pkt a2>> set-nth - ] each - task pkt qpkt - ] [ task wait-task ] if ; - -! Main -: init ( -- ) - task-tab-size f to: task-tab - f to: tracing - 0 to: hold-count - 0 to: qpkt-count ; - -: start ( -- ) - I_IDLE 1 10000 drop - - I_WORK 1000 - f 0 K_WORK 0 K_WORK - drop - - I_HANDLERA 2000 - f I_DEVA K_DEV - I_DEVA K_DEV - I_DEVA K_DEV - drop - - I_HANDLERB 3000 - f I_DEVB K_DEV - I_DEVB K_DEV - I_DEVB K_DEV - drop - - I_DEVA 4000 f drop - I_DEVB 4000 f drop ; - -: check ( -- ) - qpkt-count 23246 assert= - hold-count 9297 assert= ; - -: run ( -- ) - init - start - schedule check ; diff --git a/unfinished/sql/sql-tests.factor b/unfinished/sql/sql-tests.factor deleted file mode 100644 index 0b57c2d8fa..0000000000 --- a/unfinished/sql/sql-tests.factor +++ /dev/null @@ -1,42 +0,0 @@ -USING: kernel namespaces db.sql sequences math ; -IN: db.sql.tests - -! TUPLE: person name age ; -: insert-1 - { insert - { - { table "person" } - { columns "name" "age" } - { values "erg" 26 } - } - } ; - -: update-1 - { update "person" - { set { "name" "erg" } - { "age" 6 } } - { where { "age" 6 } } - } ; - -: select-1 - { select - { columns - "branchno" - { count "staffno" as "mycount" } - { sum "salary" as "mysum" } } - { from "staff" "lol" } - { where - { "salary" > all - { select - { columns "salary" } - { from "staff" } - { where { "branchno" = "b003" } } - } - } - { "branchno" > 3 } } - { group-by "branchno" "lol2" } - { having { count "staffno" > 1 } } - { order-by "branchno" } - { offset 40 } - { limit 20 } - } ; diff --git a/unfinished/sql/sql.factor b/unfinished/sql/sql.factor deleted file mode 100755 index ba0673ae24..0000000000 --- a/unfinished/sql/sql.factor +++ /dev/null @@ -1,172 +0,0 @@ -USING: kernel parser quotations classes.tuple words math.order -nmake namespaces sequences arrays combinators -prettyprint strings math.parser math symbols db ; -IN: db.sql - -SYMBOLS: insert update delete select distinct columns from as -where group-by having order-by limit offset is-null desc all -any count avg table values ; - -: input-spec, ( obj -- ) 1, ; -: output-spec, ( obj -- ) 2, ; -: input, ( obj -- ) 3, ; -: output, ( obj -- ) 4, ; - -DEFER: sql% - -: (sql-interleave) ( seq sep -- ) - [ sql% ] curry [ sql% ] interleave ; - -: sql-interleave ( seq str sep -- ) - swap sql% (sql-interleave) ; - -: sql-function, ( seq function -- ) - sql% "(" sql% unclip sql% ")" sql% [ sql% ] each ; - -: sql-where, ( seq -- ) - [ - [ second 0, ] - [ first 0, ] - [ third 1, \ ? 0, ] tri - ] each ; - -HOOK: sql-create db ( object -- ) -M: db sql-create ( object -- ) - drop - "create table" sql% ; - -HOOK: sql-drop db ( object -- ) -M: db sql-drop ( object -- ) - drop - "drop table" sql% ; - -HOOK: sql-insert db ( object -- ) -M: db sql-insert ( object -- ) - drop - "insert into" sql% ; - -HOOK: sql-update db ( object -- ) -M: db sql-update ( object -- ) - drop - "update" sql% ; - -HOOK: sql-delete db ( object -- ) -M: db sql-delete ( object -- ) - drop - "delete" sql% ; - -HOOK: sql-select db ( object -- ) -M: db sql-select ( object -- ) - "select" sql% "," (sql-interleave) ; - -HOOK: sql-columns db ( object -- ) -M: db sql-columns ( object -- ) - "," (sql-interleave) ; - -HOOK: sql-from db ( object -- ) -M: db sql-from ( object -- ) - "from" "," sql-interleave ; - -HOOK: sql-where db ( object -- ) -M: db sql-where ( object -- ) - "where" 0, sql-where, ; - -HOOK: sql-group-by db ( object -- ) -M: db sql-group-by ( object -- ) - "group by" "," sql-interleave ; - -HOOK: sql-having db ( object -- ) -M: db sql-having ( object -- ) - "having" "," sql-interleave ; - -HOOK: sql-order-by db ( object -- ) -M: db sql-order-by ( object -- ) - "order by" "," sql-interleave ; - -HOOK: sql-offset db ( object -- ) -M: db sql-offset ( object -- ) - "offset" sql% sql% ; - -HOOK: sql-limit db ( object -- ) -M: db sql-limit ( object -- ) - "limit" sql% sql% ; - -! GENERIC: sql-subselect db ( object -- ) -! M: db sql-subselectselect ( object -- ) - ! "(select" sql% sql% ")" sql% ; - -HOOK: sql-table db ( object -- ) -M: db sql-table ( object -- ) - sql% ; - -HOOK: sql-set db ( object -- ) -M: db sql-set ( object -- ) - "set" "," sql-interleave ; - -HOOK: sql-values db ( object -- ) -M: db sql-values ( object -- ) - "values(" sql% "," (sql-interleave) ")" sql% ; - -HOOK: sql-count db ( object -- ) -M: db sql-count ( object -- ) - "count" sql-function, ; - -HOOK: sql-sum db ( object -- ) -M: db sql-sum ( object -- ) - "sum" sql-function, ; - -HOOK: sql-avg db ( object -- ) -M: db sql-avg ( object -- ) - "avg" sql-function, ; - -HOOK: sql-min db ( object -- ) -M: db sql-min ( object -- ) - "min" sql-function, ; - -HOOK: sql-max db ( object -- ) -M: db sql-max ( object -- ) - "max" sql-function, ; - -: sql-array% ( array -- ) - unclip - { - { \ create [ sql-create ] } - { \ drop [ sql-drop ] } - { \ insert [ sql-insert ] } - { \ update [ sql-update ] } - { \ delete [ sql-delete ] } - { \ select [ sql-select ] } - { \ columns [ sql-columns ] } - { \ from [ sql-from ] } - { \ where [ sql-where ] } - { \ group-by [ sql-group-by ] } - { \ having [ sql-having ] } - { \ order-by [ sql-order-by ] } - { \ offset [ sql-offset ] } - { \ limit [ sql-limit ] } - { \ table [ sql-table ] } - { \ set [ sql-set ] } - { \ values [ sql-values ] } - { \ count [ sql-count ] } - { \ sum [ sql-sum ] } - { \ avg [ sql-avg ] } - { \ min [ sql-min ] } - { \ max [ sql-max ] } - [ sql% [ sql% ] each ] - } case ; - -ERROR: no-sql-match ; -: sql% ( obj -- ) - { - { [ dup string? ] [ 0, ] } - { [ dup array? ] [ sql-array% ] } - { [ dup number? ] [ number>string sql% ] } - { [ dup symbol? ] [ unparse sql% ] } - { [ dup word? ] [ unparse sql% ] } - { [ dup quotation? ] [ call ] } - [ no-sql-match ] - } cond ; - -: parse-sql ( obj -- sql in-spec out-spec in out ) - [ [ sql% ] each ] { { } { } { } } nmake - [ " " join ] 2dip ; From 901bcccc1c6d70e5beeaf96cd0dc32ed40291d21 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Feb 2009 23:25:13 -0600 Subject: [PATCH 114/119] Fix remaining text failures --- basis/compiler/compiler.factor | 5 +---- basis/compiler/tests/optimizer.factor | 22 ++++++++++--------- basis/compiler/tests/simple.factor | 4 ++-- .../tree/cleanup/cleanup-tests.factor | 2 +- .../tree/recursive/recursive-tests.factor | 2 +- basis/tools/profiler/profiler-tests.factor | 2 +- 6 files changed, 18 insertions(+), 19 deletions(-) diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index d707dff983..f2f4e7aa9e 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -49,7 +49,7 @@ SYMBOL: +failed+ H{ } clone generic-dependencies set f swap compiler-error ; -: fail ( word error -- * ) +: fail ( word error -- ) [ swap compiler-error ] [ drop @@ -112,9 +112,6 @@ t compile-dependencies? set-global : decompile ( word -- ) f 2array 1array modify-code-heap ; -: compile-call ( quot -- ) - [ dup infer define-temp ] with-compilation-unit execute ; - : optimized-recompile-hook ( words -- alist ) [ compile-queue set diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index 708d17f3d3..cfeb5d01ac 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -55,7 +55,7 @@ TUPLE: pred-test ; ! regression -: literal-not-branch 0 not [ ] [ ] if ; +: literal-not-branch ( -- ) 0 not [ ] [ ] if ; [ ] [ literal-not-branch ] unit-test @@ -108,12 +108,12 @@ GENERIC: void-generic ( obj -- * ) [ 10 ] [ branch-fold-regression-1 ] unit-test ! another regression -: constant-branch-fold-0 "hey" ; foldable +: constant-branch-fold-0 ( -- value ) "hey" ; foldable : constant-branch-fold-1 ( -- ? ) constant-branch-fold-0 "hey" = ; inline [ 1 ] [ [ constant-branch-fold-1 [ 1 ] [ 2 ] if ] compile-call ] unit-test ! another regression -: foo f ; +: foo ( -- value ) f ; : bar ( -- ? ) foo 4 4 = and ; [ f ] [ bar ] unit-test @@ -134,15 +134,15 @@ M: slice foozul ; ] unit-test ! regression -: constant-fold-2 f ; foldable -: constant-fold-3 4 ; foldable +: constant-fold-2 ( -- value ) f ; foldable +: constant-fold-3 ( -- value ) 4 ; foldable [ f t ] [ [ constant-fold-2 constant-fold-3 4 = ] compile-call ] unit-test -: constant-fold-4 f ; foldable -: constant-fold-5 f ; foldable +: constant-fold-4 ( -- value ) f ; foldable +: constant-fold-5 ( -- value ) f ; foldable [ f ] [ [ constant-fold-4 constant-fold-5 or ] compile-call @@ -247,7 +247,7 @@ USE: binary-search.private [ 3 "an integer" ] [ 3 lift-throw-tail-regression ] unit-test [ "hi" "a string" ] [ "hi" lift-throw-tail-regression ] unit-test -: lift-loop-tail-test-1 ( a quot -- ) +: lift-loop-tail-test-1 ( a quot: ( -- ) -- ) over even? [ [ [ 3 - ] dip call ] keep lift-loop-tail-test-1 ] [ @@ -256,11 +256,13 @@ USE: binary-search.private ] [ [ [ 2 - ] dip call ] keep lift-loop-tail-test-1 ] if - ] if ; inline + ] if ; inline recursive -: lift-loop-tail-test-2 +: lift-loop-tail-test-2 ( -- a b c ) 10 [ ] lift-loop-tail-test-1 1 2 3 ; +\ lift-loop-tail-test-2 must-infer + [ 1 2 3 ] [ lift-loop-tail-test-2 ] unit-test ! Forgot a recursive inline check diff --git a/basis/compiler/tests/simple.factor b/basis/compiler/tests/simple.factor index 0fde270eac..d53b864b06 100644 --- a/basis/compiler/tests/simple.factor +++ b/basis/compiler/tests/simple.factor @@ -18,13 +18,13 @@ IN: compiler.tests [ "hey" ] [ [ "hey" ] compile-call ] unit-test ! Calls -: no-op ; +: no-op ( -- ) ; [ ] [ [ no-op ] compile-call ] unit-test [ 3 ] [ [ no-op 3 ] compile-call ] unit-test [ 3 ] [ [ 3 no-op ] compile-call ] unit-test -: bar 4 ; +: bar ( -- value ) 4 ; [ 4 ] [ [ bar no-op ] compile-call ] unit-test [ 4 3 ] [ [ no-op bar 3 ] compile-call ] unit-test diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor index 751a335a13..54f8aaf20e 100755 --- a/basis/compiler/tree/cleanup/cleanup-tests.factor +++ b/basis/compiler/tree/cleanup/cleanup-tests.factor @@ -474,7 +474,7 @@ cell-bits 32 = [ ] unit-test ! A reduction -: buffalo-sauce f ; +: buffalo-sauce ( -- value ) f ; : steak ( -- ) buffalo-sauce [ steak ] when ; inline recursive diff --git a/basis/compiler/tree/recursive/recursive-tests.factor b/basis/compiler/tree/recursive/recursive-tests.factor index b1f9406092..d548d58bc6 100644 --- a/basis/compiler/tree/recursive/recursive-tests.factor +++ b/basis/compiler/tree/recursive/recursive-tests.factor @@ -87,7 +87,7 @@ compiler.tree.combinators ; ] contains-node? ] unit-test -: blah f ; +: blah ( -- value ) f ; DEFER: a diff --git a/basis/tools/profiler/profiler-tests.factor b/basis/tools/profiler/profiler-tests.factor index 197ace74d8..5bf62ef156 100644 --- a/basis/tools/profiler/profiler-tests.factor +++ b/basis/tools/profiler/profiler-tests.factor @@ -1,6 +1,6 @@ IN: tools.profiler.tests USING: accessors tools.profiler tools.test kernel memory math -threads alien tools.profiler.private sequences compiler.units +threads alien tools.profiler.private sequences compiler words ; [ t ] [ From e7243da0b80dda06cfea3e55954431a7c70b8fb7 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Feb 2009 23:28:02 -0600 Subject: [PATCH 115/119] Clean up memoize code to not use gensym anymore --- basis/macros/macros.factor | 4 +- basis/memoize/memoize-tests.factor | 8 ++- basis/memoize/memoize.factor | 67 ++++++++++++------------- basis/tools/deploy/shaker/shaker.factor | 2 +- 4 files changed, 41 insertions(+), 40 deletions(-) diff --git a/basis/macros/macros.factor b/basis/macros/macros.factor index 4fba7efba3..21a91e567d 100644 --- a/basis/macros/macros.factor +++ b/basis/macros/macros.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007, 2008 Slava Pestov. +! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: parser kernel sequences words effects combinators assocs definitions quotations namespaces memoize accessors ; @@ -7,7 +7,7 @@ IN: macros > 1 ; + stack-effect in>> 1 ; PRIVATE> diff --git a/basis/memoize/memoize-tests.factor b/basis/memoize/memoize-tests.factor index 7ee56866ce..03549d9b80 100644 --- a/basis/memoize/memoize-tests.factor +++ b/basis/memoize/memoize-tests.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg. +! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: math kernel memoize tools.test parser generalizations prettyprint io.streams.string sequences eval ; @@ -17,6 +17,10 @@ MEMO: see-test ( a -- b ) reverse ; [ [ \ see-test see ] with-string-writer ] unit-test -[ ] [ "IN: memoize.tests : fib ;" eval ] unit-test +[ ] [ "IN: memoize.tests : fib ( -- ) ;" eval ] unit-test [ "IN: memoize.tests\n: fib ( -- ) ;\n" ] [ [ \ fib see ] with-string-writer ] unit-test + +[ sq ] (( a -- b )) memoize-quot "q" set + +[ 9 ] [ 3 "q" get call ] unit-test diff --git a/basis/memoize/memoize.factor b/basis/memoize/memoize.factor index 7b8c30c534..3bc573dff5 100644 --- a/basis/memoize/memoize.factor +++ b/basis/memoize/memoize.factor @@ -1,47 +1,45 @@ -! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg. +! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: kernel hashtables sequences arrays words namespaces make parser math assocs effects definitions quotations summary -accessors ; +accessors fry ; IN: memoize -: packer ( n -- quot ) - { [ f ] [ ] [ 2array ] [ 3array ] [ 4array ] } nth ; - -: unpacker ( n -- quot ) - { [ drop ] [ ] [ first2 ] [ first3 ] [ first4 ] } nth ; - -: #in ( word -- n ) - stack-effect in>> length ; - -: #out ( word -- n ) - stack-effect out>> length ; - -: pack/unpack ( quot word -- newquot ) - [ dup #in unpacker % swap % #out packer % ] [ ] make ; - -: make-memoizer ( quot word -- quot ) - [ - [ #in packer % ] keep - [ "memoize" word-prop , ] keep - [ pack/unpack , ] keep - \ cache , - #out unpacker % - ] [ ] make ; - ERROR: too-many-arguments ; M: too-many-arguments summary drop "There must be no more than 4 input and 4 output arguments" ; -: check-memoized ( word -- ) - [ #in ] [ #out ] bi [ 4 > ] either? [ too-many-arguments ] when ; +> packer ] [ out>> unpacker ] bi surround ; + +: unpack/pack ( quot effect -- newquot ) + [ in>> unpacker ] [ out>> packer ] bi surround ; + +: check-memoized ( effect -- ) + [ in>> ] [ out>> ] bi [ length 4 > ] either? [ too-many-arguments ] when ; + +: make-memoizer ( table quot effect -- quot ) + [ check-memoized ] keep + [ unpack/pack '[ _ _ cache ] ] keep + pack/unpack ; + +PRIVATE> : define-memoized ( word quot -- ) - over check-memoized - 2dup "memo-quot" set-word-prop - over H{ } clone "memoize" set-word-prop - over make-memoizer define ; + [ H{ } clone ] dip + [ pick stack-effect make-memoizer define ] + [ nip "memo-quot" set-word-prop ] + [ drop "memoize" set-word-prop ] + 3tri ; : MEMO: (:) define-memoized ; parsing @@ -57,11 +55,10 @@ M: memoized reset-word bi ; : memoize-quot ( quot effect -- memo-quot ) - gensym swap dupd "declared-effect" set-word-prop - dup rot define-memoized 1quotation ; + [ H{ } clone ] 2dip make-memoizer ; : reset-memoized ( word -- ) "memoize" word-prop clear-assoc ; : invalidate-memoized ( inputs... word -- ) - [ #in packer call ] [ "memoize" word-prop delete-at ] bi ; + [ stack-effect in>> packer call ] [ "memoize" word-prop delete-at ] bi ; diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index e61021e633..5095f9e93e 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -190,7 +190,7 @@ IN: tools.deploy.shaker "Stripping default methods" show [ [ generic? ] instances - [ "No method" throw ] (( -- * )) define-temp + [ "No method" throw ] define-temp dup t "default" set-word-prop '[ [ _ "default-method" set-word-prop ] [ make-generic ] bi From b06903b0efc727bcce5c7269aa033cf94dcc2400 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Feb 2009 23:28:22 -0600 Subject: [PATCH 116/119] Update tree shaker for define-temp changes --- basis/tools/deploy/shaker/shaker.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 5095f9e93e..961d0ff26d 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -95,7 +95,7 @@ IN: tools.deploy.shaker "cannot-infer" "coercer" "combination" - "compiled-effect" + "compiled-status" "compiled-generic-uses" "compiled-uses" "constraints" @@ -190,7 +190,7 @@ IN: tools.deploy.shaker "Stripping default methods" show [ [ generic? ] instances - [ "No method" throw ] define-temp + [ "No method" throw ] (( -- * )) define-temp dup t "default" set-word-prop '[ [ _ "default-method" set-word-prop ] [ make-generic ] bi From 65a53e1fa5fa120988ec108ed57358bba221c94a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Feb 2009 23:55:16 -0600 Subject: [PATCH 117/119] Don't keep compiled-effect around anymore --- basis/compiler/cfg/debugger/debugger.factor | 2 +- basis/compiler/compiler.factor | 62 ++++++++++--------- basis/compiler/tests/optimizer.factor | 2 +- .../tree/builder/builder-tests.factor | 2 +- basis/compiler/tree/builder/builder.factor | 8 +-- basis/compiler/tree/debugger/debugger.factor | 2 +- 6 files changed, 41 insertions(+), 37 deletions(-) diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor index ba58e60a4a..6d0a8f8c8e 100644 --- a/basis/compiler/cfg/debugger/debugger.factor +++ b/basis/compiler/cfg/debugger/debugger.factor @@ -16,7 +16,7 @@ M: callable test-cfg build-tree optimize-tree gensym build-cfg ; M: word test-cfg - [ build-tree-from-word nip optimize-tree ] keep build-cfg ; + [ build-tree-from-word optimize-tree ] keep build-cfg ; SYMBOL: allocate-registers? diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index f2f4e7aa9e..d6da95408d 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -1,46 +1,47 @@ ! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel namespaces arrays sequences io -words fry continuations vocabs assocs dlists definitions math -graphs generic combinators deques search-deques io -stack-checker stack-checker.state stack-checker.inlining -compiler.errors compiler.units compiler.tree.builder -compiler.tree.optimizer compiler.cfg.builder -compiler.cfg.optimizer compiler.cfg.linearization -compiler.cfg.two-operand compiler.cfg.linear-scan -compiler.cfg.stack-frame compiler.codegen compiler.utilities ; +USING: accessors kernel namespaces arrays sequences io words fry +continuations vocabs assocs dlists definitions math graphs +generic combinators deques search-deques io stack-checker +stack-checker.state stack-checker.inlining +combinators.short-circuit compiler.errors compiler.units +compiler.tree.builder compiler.tree.optimizer +compiler.cfg.builder compiler.cfg.optimizer +compiler.cfg.linearization compiler.cfg.two-operand +compiler.cfg.linear-scan compiler.cfg.stack-frame +compiler.codegen compiler.utilities ; IN: compiler SYMBOL: compile-queue SYMBOL: compiled -: queue-compile ( word -- ) +: queue-compile? ( word -- ? ) { - { [ dup "forgotten" word-prop ] [ ] } - { [ dup compiled get key? ] [ ] } - { [ dup inlined-block? ] [ ] } - { [ dup primitive? ] [ ] } - [ dup compile-queue get push-front ] - } cond drop ; + [ "forgotten" word-prop ] + [ compiled get key? ] + [ inlined-block? ] + [ primitive? ] + } 1|| not ; + +: queue-compile ( word -- ) + dup queue-compile? [ compile-queue get push-front ] [ drop ] if ; : maybe-compile ( word -- ) dup optimized>> [ drop ] [ queue-compile ] if ; -SYMBOL: +failed+ +SYMBOLS: +optimized+ +unoptimized+ ; : ripple-up ( words -- ) - dup "compiled-effect" word-prop +failed+ eq? + dup "compiled-status" word-prop +unoptimized+ eq? [ usage [ word? ] filter ] [ compiled-usage keys ] if [ queue-compile ] each ; -: ripple-up? ( word effect -- ? ) - #! If the word has previously been compiled and had a - #! different stack effect, we have to recompile any callers. - swap "compiled-effect" word-prop [ = not ] keep and ; +: ripple-up? ( word status -- ? ) + swap "compiled-status" word-prop [ = not ] keep and ; -: save-effect ( word effect -- ) +: save-compiled-status ( word status -- ) [ dupd ripple-up? [ ripple-up ] [ drop ] if ] - [ "compiled-effect" set-word-prop ] + [ "compiled-status" set-word-prop ] 2bi ; : start ( word -- ) @@ -49,18 +50,18 @@ SYMBOL: +failed+ H{ } clone generic-dependencies set f swap compiler-error ; -: fail ( word error -- ) +: fail ( word error -- * ) [ swap compiler-error ] [ drop [ compiled-unxref ] [ f swap compiled get set-at ] - [ +failed+ save-effect ] + [ +unoptimized+ save-compiled-status ] tri ] 2bi return ; -: frontend ( word -- effect nodes ) +: frontend ( word -- nodes ) [ build-tree-from-word ] [ fail ] recover optimize-tree ; ! Only switch this off for debugging. @@ -84,8 +85,8 @@ t compile-dependencies? set-global save-asm ] each ; -: finish ( effect word -- ) - [ swap save-effect ] +: finish ( word -- ) + [ +optimized+ save-compiled-status ] [ compiled-unxref ] [ dup crossref? @@ -112,6 +113,9 @@ t compile-dependencies? set-global : decompile ( word -- ) f 2array 1array modify-code-heap ; +: compile-call ( quot -- ) + [ dup infer define-temp ] with-compilation-unit execute ; + : optimized-recompile-hook ( words -- alist ) [ compile-queue set diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index cfeb5d01ac..b5cb0ddbdb 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -303,7 +303,7 @@ HINTS: recursive-inline-hang-3 array ; : member-test ( obj -- ? ) { + - * / /i } member? ; \ member-test must-infer -[ ] [ \ member-test build-tree-from-word optimize-tree 2drop ] unit-test +[ ] [ \ member-test build-tree-from-word optimize-tree drop ] unit-test [ t ] [ \ + member-test ] unit-test [ f ] [ \ append member-test ] unit-test diff --git a/basis/compiler/tree/builder/builder-tests.factor b/basis/compiler/tree/builder/builder-tests.factor index d758e2a34d..4982a3986c 100755 --- a/basis/compiler/tree/builder/builder-tests.factor +++ b/basis/compiler/tree/builder/builder-tests.factor @@ -8,4 +8,4 @@ compiler.tree ; : inline-recursive ( -- ) inline-recursive ; inline recursive -[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? nip ] unit-test +[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? ] unit-test diff --git a/basis/compiler/tree/builder/builder.factor b/basis/compiler/tree/builder/builder.factor index b715223445..4cb7650b1d 100644 --- a/basis/compiler/tree/builder/builder.factor +++ b/basis/compiler/tree/builder/builder.factor @@ -12,18 +12,18 @@ IN: compiler.tree.builder : with-tree-builder ( quot -- nodes ) '[ V{ } clone stack-visitor set @ ] - with-infer ; inline + with-infer nip ; inline : build-tree ( quot -- nodes ) #! Not safe to call from inference transforms. - [ f initial-recursive-state infer-quot ] with-tree-builder nip ; + [ f initial-recursive-state infer-quot ] with-tree-builder ; : build-tree-with ( in-stack quot -- nodes out-stack ) #! Not safe to call from inference transforms. [ [ >vector \ meta-d set ] [ f initial-recursive-state infer-quot ] bi* - ] with-tree-builder nip + ] with-tree-builder unclip-last in-d>> ; : build-sub-tree ( #call quot -- nodes ) @@ -45,7 +45,7 @@ IN: compiler.tree.builder : check-no-compile ( word -- ) dup "no-compile" word-prop [ cannot-infer-effect ] [ drop ] if ; -: build-tree-from-word ( word -- effect nodes ) +: build-tree-from-word ( word -- nodes ) [ [ { diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor index 9f2cc0536e..188dcdb935 100644 --- a/basis/compiler/tree/debugger/debugger.factor +++ b/basis/compiler/tree/debugger/debugger.factor @@ -144,7 +144,7 @@ SYMBOL: node-count : make-report ( word/quot -- assoc ) [ - dup word? [ build-tree-from-word nip ] [ build-tree ] if + dup word? [ build-tree-from-word ] [ build-tree ] if optimize-tree H{ } clone words-called set From b8ed7d20de7b33c20d8308db151355f4ae5519fd Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Wed, 28 Jan 2009 02:46:29 -0600 Subject: [PATCH 118/119] Update Windows-specific code for stricter stack checking --- basis/ui/windows/windows.factor | 14 +++++++------- basis/windows/winsock/winsock.factor | 5 ++--- 2 files changed, 9 insertions(+), 10 deletions(-) mode change 100644 => 100755 basis/windows/winsock/winsock.factor diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor index c22fcb6cbe..9df694ee37 100755 --- a/basis/ui/windows/windows.factor +++ b/basis/ui/windows/windows.factor @@ -104,7 +104,7 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ; [ lo-word ] keep hi-word 2array swap window (>>window-loc) ; -: wm-keydown-codes ( -- key ) +CONSTANT: wm-keydown-codes H{ { 8 "BACKSPACE" } { 9 "TAB" } @@ -132,7 +132,7 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ; { 121 "F10" } { 122 "F11" } { 123 "F12" } - } ; + } : key-state-down? ( key -- ? ) GetKeyState 16 bit? ; @@ -155,22 +155,22 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ; alt? [ A+ , ] when ] { } make [ empty? not ] keep f ? ; -: exclude-keys-wm-keydown +CONSTANT: exclude-keys-wm-keydown H{ { 16 "SHIFT" } { 17 "CTRL" } { 18 "ALT" } { 20 "CAPS-LOCK" } - } ; + } -: exclude-keys-wm-char - ! Values are ignored +! Values are ignored +CONSTANT: exclude-keys-wm-char H{ { 8 "BACKSPACE" } { 9 "TAB" } { 13 "RET" } { 27 "ESC" } - } ; + } : exclude-key-wm-keydown? ( n -- ? ) exclude-keys-wm-keydown key? ; diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor old mode 100644 new mode 100755 index 27069ed743..06df74cd4c --- a/basis/windows/winsock/winsock.factor +++ b/basis/windows/winsock/winsock.factor @@ -257,12 +257,11 @@ TYPEDEF: WSANAMESPACE_INFOW WSANAMESPACE_INFO TYPEDEF: WSANAMESPACE_INFO* PWSANAMESPACE_INFO TYPEDEF: WSANAMESPACE_INFO* LPWSANAMESPACE_INFO -: FD_MAX_EVENTS 10 ; +CONSTANT: FD_MAX_EVENTS 10 C-STRUCT: WSANETWORKEVENTS { "long" "lNetworkEvents" } - ! { { "int" "FD_MAX_EVENTS" } "iErrorCode" } ; - { { "int" 10 } "iErrorCode" } ; + { { "int" FD_MAX_EVENTS } "iErrorCode" } ; TYPEDEF: WSANETWORKEVENTS* PWSANETWORKEVENTS TYPEDEF: WSANETWORKEVENTS* LPWSANETWORKEVENTS From e8361b99806c781e7c966e6e7fb7dafb272316dc Mon Sep 17 00:00:00 2001 From: slava Date: Tue, 24 Feb 2009 01:06:50 -0600 Subject: [PATCH 119/119] Updating X11 UI backend for stricter stack effect checking --- basis/ui/x11/x11.factor | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/basis/ui/x11/x11.factor b/basis/ui/x11/x11.factor index 34cff42777..d0d7eeb234 100755 --- a/basis/ui/x11/x11.factor +++ b/basis/ui/x11/x11.factor @@ -29,14 +29,14 @@ M: world configure-event ! In case dimensions didn't change relayout-1 ; -: modifiers +CONSTANT: modifiers { { S+ HEX: 1 } { C+ HEX: 4 } { A+ HEX: 8 } - } ; - -: key-codes + } + +CONSTANT: key-codes H{ { HEX: FF08 "BACKSPACE" } { HEX: FF09 "TAB" } @@ -62,7 +62,7 @@ M: world configure-event { HEX: FFC4 "F7" } { HEX: FFC5 "F8" } { HEX: FFC6 "F9" } - } ; + } : key-code ( keysym -- keycode action? ) dup key-codes at [ t ] [ 1string f ] ?if ;