From d59415d23b606ad7d89e1a6d634d6644658f5a70 Mon Sep 17 00:00:00 2001 From: Jason Merrill Date: Thu, 19 Feb 2009 22:21:31 -0500 Subject: [PATCH 1/8] Fixed help for math.dual. Help is now autogenerated where possible. --- extra/math/dual/dual-docs.factor | 79 -------------------------------- extra/math/dual/dual.factor | 30 ++++++++---- 2 files changed, 21 insertions(+), 88 deletions(-) diff --git a/extra/math/dual/dual-docs.factor b/extra/math/dual/dual-docs.factor index 1f24c8217c..67b3d6ae97 100644 --- a/extra/math/dual/dual-docs.factor +++ b/extra/math/dual/dual-docs.factor @@ -10,84 +10,6 @@ HELP: } { $description "Creates a dual number from its ordinary and epsilon parts." } ; -HELP: d* -{ $values - { "x" dual } { "y" dual } - { "x*y" dual } -} -{ $description "Multiply dual numbers." } ; - -HELP: d+ -{ $values - { "x" dual } { "y" dual } - { "x+y" dual } -} -{ $description "Add dual numbers." } ; - -HELP: d- -{ $values - { "x" dual } { "y" dual } - { "x-y" dual } -} -{ $description "Subtract dual numbers." } ; - -HELP: d/ -{ $values - { "x" dual } { "y" dual } - { "x/y" dual } -} -{ $description "Divide dual numbers." } -{ $errors "Throws an error if the ordinary part of " { $snippet "x" } " is zero." } ; - -HELP: d^ -{ $values - { "x" dual } { "y" dual } - { "x^y" dual } -} -{ $description "Raise a dual number to a (possibly dual) power" } ; - -HELP: dabs -{ $values - { "x" dual } - { "|x|" dual } -} -{ $description "Absolute value of a dual number." } ; - -HELP: dacosh -{ $values - { "x" dual } - { "y" dual } -} -{ $description "Inverse hyberbolic cosine of a dual number." } ; - -HELP: dasinh -{ $values - { "x" dual } - { "y" dual } -} -{ $description "Inverse hyberbolic sine of a dual number." } ; - -HELP: datanh -{ $values - { "x" dual } - { "y" dual } -} -{ $description "Inverse hyberbolic tangent of a dual number." } ; - -HELP: dneg -{ $values - { "x" dual } - { "-x" dual } -} -{ $description "Negative of a dual number." } ; - -HELP: drecip -{ $values - { "x" dual } - { "1/x" dual } -} -{ $description "Reciprocal of a dual number." } ; - HELP: define-dual { $values { "word" word } @@ -128,5 +50,4 @@ $nl "Dual numbers are ordered pairs " { $snippet ""} "--an ordinary part and an epsilon part--with component-wise addition and multiplication defined by "{ $snippet "* = " } ". They are analagous to complex numbers with " { $snippet "i^2 = 0" } "instead of " { $snippet "i^2 = -1" } ". For well-behaved functions " { $snippet "f" } ", " { $snippet "f() = f(o1) + e1*f'(o1)" } ", where " { $snippet "f'"} " is the derivative of " { $snippet "f" } "." ; - ABOUT: "math.dual" diff --git a/extra/math/dual/dual.factor b/extra/math/dual/dual.factor index c85c23e51d..3e0e5437b4 100644 --- a/extra/math/dual/dual.factor +++ b/extra/math/dual/dual.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2009 Jason W. Merrill. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.functions math.derivatives accessors - macros words effects vocabs sequences generalizations fry - combinators.smart generic compiler.units ; + macros generic compiler.units words effects vocabs + sequences arrays assocs generalizations fry make + combinators.smart help help.markup ; IN: math.dual @@ -48,6 +49,19 @@ MACRO: chain-rule ( word -- e ) tri '[ [ @ _ @ ] sum-outputs ] ; +: set-dual-help ( word dword -- ) + [ swap + [ stack-effect [ in>> ] [ out>> ] bi append + [ dual ] { } map>assoc { $values } prepend + ] + [ [ { $description } % "Version of " , + { $link } swap suffix , + " extended to work on dual numbers." , ] + { } make + ] + bi* 2array + ] keep set-word-help ; + PRIVATE> MACRO: dual-op ( word -- ) @@ -58,13 +72,11 @@ MACRO: dual-op ( word -- ) '[ _ @ @ ] ; : define-dual ( word -- ) - [ - [ stack-effect ] - [ name>> "d" prepend "math.dual" create ] - bi [ set-stack-effect ] keep - ] - keep - '[ _ dual-op ] define ; + dup name>> "d" prepend "math.dual" create + [ [ stack-effect ] dip set-stack-effect ] + [ set-dual-help ] + [ swap '[ _ dual-op ] define ] + 2tri ; ! Specialize math functions to operate on dual numbers. [ all-words [ "derivative" word-prop ] filter From 19acf89d82b0f7f33f58b02cbe505930432a036d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 20 Feb 2009 12:12:00 -0600 Subject: [PATCH 2/8] 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 3/8] 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 4/8] 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 5/8] 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 6/8] 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 7/8] 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 8/8] 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 -- ) [