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 01/48] 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: Fri, 20 Feb 2009 16:55:08 +0100 Subject: [PATCH 02/48] 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 03/48] 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 04/48] 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 05/48] 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 06/48] 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 07/48] 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 08/48] 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 09/48] 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 10/48] 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 11/48] 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 12/48] 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 13/48] 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 14/48] 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 15/48] 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 16/48] 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 17/48] 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 18/48] 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 19/48] 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 20/48] 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 21/48] 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 22/48] 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 23/48] 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 24/48] 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 25/48] 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 26/48] 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 27/48] 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 28/48] 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 29/48] 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 30/48] 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 31/48] 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 32/48] 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 33/48] 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 34/48] 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 35/48] 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 36/48] 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 37/48] 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 38/48] 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 39/48] 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 40/48] 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 41/48] 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 42/48] 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 43/48] 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 44/48] 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 45/48] 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 46/48] 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 47/48] 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 48/48] 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 */