Merge branch 'master' of git://factorcode.org/git/factor
commit
6101a887fe
|
@ -123,12 +123,8 @@ hi "HELLO" {
|
||||||
] with-db
|
] with-db
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ ] [
|
|
||||||
test.db [
|
! Test SQLite triggers
|
||||||
hi create-table
|
|
||||||
hi drop-table
|
|
||||||
] with-db
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
TUPLE: show id ;
|
TUPLE: show id ;
|
||||||
TUPLE: user username data ;
|
TUPLE: user username data ;
|
||||||
|
@ -144,12 +140,12 @@ show "SHOW" {
|
||||||
} define-persistent
|
} define-persistent
|
||||||
|
|
||||||
watch "WATCH" {
|
watch "WATCH" {
|
||||||
{ "user" "USER" TEXT +not-null+
|
{ "user" "USER" TEXT +not-null+ +user-assigned-id+
|
||||||
{ +foreign-id+ user "USERNAME" } +user-assigned-id+ }
|
{ +foreign-id+ user "USERNAME" } }
|
||||||
{ "show" "SHOW" BIG-INTEGER +not-null+
|
{ "show" "SHOW" BIG-INTEGER +not-null+ +user-assigned-id+
|
||||||
{ +foreign-id+ show "ID" } +user-assigned-id+ }
|
{ +foreign-id+ show "ID" } }
|
||||||
} define-persistent
|
} define-persistent
|
||||||
|
|
||||||
[ T{ user { username "littledan" } { data "foo" } } ] [
|
[ T{ user { username "littledan" } { data "foo" } } ] [
|
||||||
test.db [
|
test.db [
|
||||||
user create-table
|
user create-table
|
||||||
|
@ -160,7 +156,7 @@ watch "WATCH" {
|
||||||
show new insert-tuple
|
show new insert-tuple
|
||||||
show new select-tuple
|
show new select-tuple
|
||||||
"littledan" f user boa select-tuple
|
"littledan" f user boa select-tuple
|
||||||
swap [ username>> ] [ id>> ] bi*
|
[ id>> ] [ username>> ] bi*
|
||||||
watch boa insert-tuple
|
watch boa insert-tuple
|
||||||
watch new select-tuple
|
watch new select-tuple
|
||||||
user>> f user boa select-tuple
|
user>> f user boa select-tuple
|
||||||
|
|
|
@ -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
|
CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
|
||||||
BEFORE INSERT ON ${table-name}
|
BEFORE INSERT ON ${table-name}
|
||||||
FOR EACH ROW BEGIN
|
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;
|
WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
|
||||||
END;
|
END;
|
||||||
"> interpolate
|
"> 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
|
CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
|
||||||
BEFORE INSERT ON ${table-name}
|
BEFORE INSERT ON ${table-name}
|
||||||
FOR EACH ROW BEGIN
|
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 NEW.${foreign-table-id} IS NOT NULL
|
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;
|
AND (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
|
||||||
END;
|
END;
|
||||||
"> interpolate
|
"> 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
|
CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
|
||||||
BEFORE UPDATE ON ${table-name}
|
BEFORE UPDATE ON ${table-name}
|
||||||
FOR EACH ROW BEGIN
|
FOR EACH ROW BEGIN
|
||||||
SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
|
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;
|
WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
|
||||||
END;
|
END;
|
||||||
"> interpolate
|
"> interpolate
|
||||||
] with-string-writer ;
|
] 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
|
CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
|
||||||
BEFORE UPDATE ON ${table-name}
|
BEFORE UPDATE ON ${table-name}
|
||||||
FOR EACH ROW BEGIN
|
FOR EACH ROW BEGIN
|
||||||
SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
|
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.${foreign-table-id} IS NOT NULL
|
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;
|
AND (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
|
||||||
END;
|
END;
|
||||||
"> interpolate
|
"> 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
|
CREATE TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
|
||||||
BEFORE DELETE ON ${foreign-table-name}
|
BEFORE DELETE ON ${foreign-table-name}
|
||||||
FOR EACH ROW BEGIN
|
FOR EACH ROW BEGIN
|
||||||
SELECT RAISE(ROLLBACK, 'delete on table "${foreign-table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
|
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;
|
WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = OLD.${foreign-table-id}) IS NOT NULL;
|
||||||
END;
|
END;
|
||||||
"> interpolate
|
"> interpolate
|
||||||
] with-string-writer ;
|
] with-string-writer ;
|
||||||
|
@ -336,17 +336,19 @@ M: sqlite-db-connection persistent-table ( -- assoc )
|
||||||
[ modifiers>> [ +foreign-id+ = ] deep-any? ] filter
|
[ modifiers>> [ +foreign-id+ = ] deep-any? ] filter
|
||||||
[
|
[
|
||||||
[ class>> db-table-name "db-table" set ]
|
[ 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
|
modifiers>> [ [ +foreign-id+ = ] deep-any? ] filter
|
||||||
[
|
[
|
||||||
[ second db-table-name "foreign-table-name" set ]
|
[ second db-table-name "foreign-table-name" set ]
|
||||||
[ third "foreign-table-id" set ] bi
|
[ third "foreign-table-id" set ] bi
|
||||||
_ execute
|
_ execute
|
||||||
] each
|
] each
|
||||||
] tri
|
] bi
|
||||||
] each
|
] each
|
||||||
] call ;
|
] call ; inline
|
||||||
|
|
||||||
: sqlite-create-table ( sql-specs class-name -- )
|
: sqlite-create-table ( sql-specs class-name -- )
|
||||||
[
|
[
|
||||||
|
@ -378,8 +380,7 @@ M: sqlite-db-connection create-sql-statement ( class -- statement )
|
||||||
|
|
||||||
M: sqlite-db-connection drop-sql-statement ( class -- statements )
|
M: sqlite-db-connection drop-sql-statement ( class -- statements )
|
||||||
[
|
[
|
||||||
[ nip "drop table " 0% 0% ";" 0% ]
|
nip "drop table " 0% 0% ";" 0%
|
||||||
[ drop \ drop-sqlite-triggers db-triggers ] 2bi
|
|
||||||
] query-make ;
|
] query-make ;
|
||||||
|
|
||||||
M: sqlite-db-connection compound ( string seq -- new-string )
|
M: sqlite-db-connection compound ( string seq -- new-string )
|
||||||
|
|
|
@ -1,17 +1,24 @@
|
||||||
USING: definitions io.launcher kernel parser words sequences math
|
USING: definitions io.launcher kernel parser words sequences math
|
||||||
math.parser namespaces editors make system ;
|
math.parser namespaces editors make system combinators.short-circuit
|
||||||
|
fry threads ;
|
||||||
IN: editors.emacs
|
IN: editors.emacs
|
||||||
|
|
||||||
|
SYMBOL: emacsclient-path
|
||||||
|
|
||||||
|
HOOK: default-emacsclient os ( -- path )
|
||||||
|
|
||||||
|
M: object default-emacsclient ( -- path ) "emacsclient" ;
|
||||||
|
|
||||||
: emacsclient ( file line -- )
|
: emacsclient ( file line -- )
|
||||||
[
|
[
|
||||||
\ emacsclient get "emacsclient" or ,
|
{ [ \ emacsclient-path get ] [ default-emacsclient ] } 0|| ,
|
||||||
os windows? [ "--no-wait" , ] unless
|
"--no-wait" ,
|
||||||
"+" swap number>string append ,
|
number>string "+" prepend ,
|
||||||
,
|
,
|
||||||
] { } make try-process ;
|
] { } make
|
||||||
|
os windows? [ run-detached drop ] [ try-process ] if ;
|
||||||
|
|
||||||
: emacs ( word -- )
|
: emacs ( word -- )
|
||||||
where first2 emacsclient ;
|
where first2 emacsclient ;
|
||||||
|
|
||||||
[ emacsclient ] edit-hook set-global
|
[ emacsclient ] edit-hook set-global
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Doug Coleman
|
|
@ -0,0 +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 combinators.short-circuit ;
|
||||||
|
IN: editors.emacs.windows
|
||||||
|
|
||||||
|
M: windows default-emacsclient
|
||||||
|
{
|
||||||
|
[ "Emacs" t [ "emacsclientw.exe" tail? ] find-in-program-files ]
|
||||||
|
[ "Emacs" t [ "emacsclient.exe" tail? ] find-in-program-files ]
|
||||||
|
[ "emacsclient.exe" ]
|
||||||
|
} 0|| ;
|
|
@ -57,8 +57,14 @@ PRIVATE>
|
||||||
pusher [ [ f ] compose iterate-directory drop ] dip
|
pusher [ [ f ] compose iterate-directory drop ] dip
|
||||||
] [ drop f ] recover ; inline
|
] [ drop f ] recover ; inline
|
||||||
|
|
||||||
|
ERROR: file-not-found ;
|
||||||
|
|
||||||
: find-in-directories ( directories bfs? quot: ( obj -- ? ) -- path'/f )
|
: 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-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f )
|
||||||
'[ _ _ find-all-files ] map concat ;
|
'[ _ _ find-all-files ] map concat ;
|
||||||
|
|
|
@ -10,84 +10,6 @@ HELP: <dual>
|
||||||
}
|
}
|
||||||
{ $description "Creates a dual number from its ordinary and epsilon parts." } ;
|
{ $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
|
HELP: define-dual
|
||||||
{ $values
|
{ $values
|
||||||
{ "word" word }
|
{ "word" word }
|
||||||
|
@ -128,5 +50,4 @@ $nl
|
||||||
"Dual numbers are ordered pairs " { $snippet "<o,e>"} "--an ordinary part and an epsilon part--with component-wise addition and multiplication defined by "{ $snippet "<o1,e1>*<o2,e2> = <o1*o2,e1*o2 + e2*o1>" } ". 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(<o1,e1>) = f(o1) + e1*f'(o1)" } ", where " { $snippet "f'"} " is the derivative of " { $snippet "f" } "."
|
"Dual numbers are ordered pairs " { $snippet "<o,e>"} "--an ordinary part and an epsilon part--with component-wise addition and multiplication defined by "{ $snippet "<o1,e1>*<o2,e2> = <o1*o2,e1*o2 + e2*o1>" } ". 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(<o1,e1>) = f(o1) + e1*f'(o1)" } ", where " { $snippet "f'"} " is the derivative of " { $snippet "f" } "."
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
||||||
ABOUT: "math.dual"
|
ABOUT: "math.dual"
|
||||||
|
|
|
@ -1,8 +1,9 @@
|
||||||
! Copyright (C) 2009 Jason W. Merrill.
|
! Copyright (C) 2009 Jason W. Merrill.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel math math.functions math.derivatives accessors
|
USING: kernel math math.functions math.derivatives accessors
|
||||||
macros words effects vocabs sequences generalizations fry
|
macros generic compiler.units words effects vocabs
|
||||||
combinators.smart generic compiler.units ;
|
sequences arrays assocs generalizations fry make
|
||||||
|
combinators.smart help help.markup ;
|
||||||
|
|
||||||
IN: math.dual
|
IN: math.dual
|
||||||
|
|
||||||
|
@ -48,6 +49,19 @@ MACRO: chain-rule ( word -- e )
|
||||||
tri
|
tri
|
||||||
'[ [ @ _ @ ] sum-outputs ] ;
|
'[ [ @ _ @ ] 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>
|
PRIVATE>
|
||||||
|
|
||||||
MACRO: dual-op ( word -- )
|
MACRO: dual-op ( word -- )
|
||||||
|
@ -58,13 +72,11 @@ MACRO: dual-op ( word -- )
|
||||||
'[ _ @ @ <dual> ] ;
|
'[ _ @ @ <dual> ] ;
|
||||||
|
|
||||||
: define-dual ( word -- )
|
: define-dual ( word -- )
|
||||||
[
|
dup name>> "d" prepend "math.dual" create
|
||||||
[ stack-effect ]
|
[ [ stack-effect ] dip set-stack-effect ]
|
||||||
[ name>> "d" prepend "math.dual" create ]
|
[ set-dual-help ]
|
||||||
bi [ set-stack-effect ] keep
|
[ swap '[ _ dual-op ] define ]
|
||||||
]
|
2tri ;
|
||||||
keep
|
|
||||||
'[ _ dual-op ] define ;
|
|
||||||
|
|
||||||
! Specialize math functions to operate on dual numbers.
|
! Specialize math functions to operate on dual numbers.
|
||||||
[ all-words [ "derivative" word-prop ] filter
|
[ all-words [ "derivative" word-prop ] filter
|
||||||
|
|
Loading…
Reference in New Issue