From f1286a353f1e24a8036628323a3e75ae2d4fcc32 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 10 Oct 2008 13:43:58 -0500 Subject: [PATCH 01/10] Fix typo --- core/alien/alien-docs.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor index 814ca8613e..ce3497439a 100644 --- a/core/alien/alien-docs.factor +++ b/core/alien/alien-docs.factor @@ -302,8 +302,8 @@ ARTICLE: "embedding" "Embedding Factor into C applications" "The Factor " { $snippet "Makefile" } " builds the Factor VM both as an executable and a library. The library can be used by other applications. File names for the library on various operating systems:" { $table { "OS" "Library name" "Shared?" } - { "Windows XP/Vista" { $snippet "factor-nt.dll" } "Yes" } - { "Windows CE" { $snippet "factor-ce.dll" } "Yes" } + { "Windows XP/Vista" { $snippet "factor.dll" } "Yes" } + ! { "Windows CE" { $snippet "factor-ce.dll" } "Yes" } { "Mac OS X" { $snippet "libfactor.dylib" } "Yes" } { "Other Unix" { $snippet "libfactor.a" } "No" } } From 2779103b63c5d596ceef6430796fe61b91d2bcec Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 10 Oct 2008 15:32:36 -0500 Subject: [PATCH 02/10] add on-update --- basis/db/postgresql/postgresql.factor | 1 + basis/db/sqlite/sqlite.factor | 1 + basis/db/types/types.factor | 4 ++-- 3 files changed, 4 insertions(+), 2 deletions(-) diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor index f9c9ea73ec..2b4cadf489 100644 --- a/basis/db/postgresql/postgresql.factor +++ b/basis/db/postgresql/postgresql.factor @@ -230,6 +230,7 @@ M: postgresql-db persistent-table ( -- hashtable ) { +foreign-id+ { f f "references" } } + { +on-update+ { f f "on update" } } { +on-delete+ { f f "on delete" } } { +restrict+ { f f "restrict" } } { +cascade+ { f f "cascade" } } diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index 216f324bbf..93135a23e3 100644 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -178,6 +178,7 @@ M: sqlite-db persistent-table ( -- assoc ) { +random-id+ { "integer" "integer" f } } { +foreign-id+ { "integer" "integer" "references" } } + { +on-update+ { f f "on update" } } { +on-delete+ { f f "on delete" } } { +restrict+ { f f "restrict" } } { +cascade+ { f f "cascade" } } diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor index ac9e3397f8..ad9c9b0acf 100644 --- a/basis/db/types/types.factor +++ b/basis/db/types/types.factor @@ -26,8 +26,8 @@ SINGLETONS: +db-assigned-id+ +user-assigned-id+ +random-id+ ; UNION: +primary-key+ +db-assigned-id+ +user-assigned-id+ +random-id+ ; SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+ -+foreign-id+ +has-many+ +on-delete+ +restrict+ +cascade+ +set-null+ -+set-default+ ; ++foreign-id+ +has-many+ +on-update+ +on-delete+ +restrict+ +cascade+ ++set-null+ +set-default+ ; SYMBOL: IGNORE From ad533918066481c633c2afbe84b3b5fbc3de8610 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 10 Oct 2008 20:52:28 -0500 Subject: [PATCH 03/10] make all types singletons instead of symbols, add NULL support for select statements --- basis/db/queries/queries.factor | 3 +++ basis/db/tuples/tuples-tests.factor | 7 ++++++- basis/db/types/types.factor | 2 +- 3 files changed, 10 insertions(+), 2 deletions(-) diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor index 768ec70185..3cf4d98215 100644 --- a/basis/db/queries/queries.factor +++ b/basis/db/queries/queries.factor @@ -114,6 +114,9 @@ M: sequence where ( spec obj -- ) [ " or " 0% ] [ dupd where ] interleave drop ] in-parens ; +M: NULL where ( spec obj -- ) + drop column-name>> 0% " is NULL" 0% ; + : object-where ( spec obj -- ) over column-name>> 0% " = " 0% bind# ; diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor index f5569a97cd..192986484e 100644 --- a/basis/db/tuples/tuples-tests.factor +++ b/basis/db/tuples/tuples-tests.factor @@ -472,7 +472,12 @@ TUPLE: exam id name score ; T{ exam } select-tuples ] unit-test - [ 4 ] [ T{ exam } count-tuples ] unit-test ; + [ 4 ] [ T{ exam } count-tuples ] unit-test + + [ ] [ T{ exam { score 10 } } insert-tuple ] unit-test + + [ 10 ] + [ T{ exam { name NULL } } select-tuples first score>> ] unit-test ; TUPLE: bignum-test id m n o ; : ( m n o -- obj ) diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor index ad9c9b0acf..6a889689ce 100644 --- a/basis/db/types/types.factor +++ b/basis/db/types/types.factor @@ -91,7 +91,7 @@ ERROR: not-persistent class ; : relation? ( spec -- ? ) [ +has-many+ = ] deep-find ; -SYMBOLS: INTEGER BIG-INTEGER SIGNED-BIG-INTEGER UNSIGNED-BIG-INTEGER +SINGLETONS: INTEGER BIG-INTEGER SIGNED-BIG-INTEGER UNSIGNED-BIG-INTEGER DOUBLE REAL BOOLEAN TEXT VARCHAR DATE TIME DATETIME TIMESTAMP BLOB FACTOR-BLOB NULL URL ; From 3161a85736c77f7d49f14d0fde67ec5cea1e57ee Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 11 Oct 2008 00:35:19 -0600 Subject: [PATCH 04/10] fix calculator --- extra/webapps/calculator/calculator.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/webapps/calculator/calculator.factor b/extra/webapps/calculator/calculator.factor index f1416fb02d..d19946d39b 100644 --- a/extra/webapps/calculator/calculator.factor +++ b/extra/webapps/calculator/calculator.factor @@ -33,7 +33,7 @@ TUPLE: calculator < dispatcher ; ! Deployment example USING: db.sqlite furnace.alloy namespaces http.server ; -: calculator-db ( -- params db ) "calculator.db" sqlite-db ; +: calculator-db ( -- db ) "calculator.db" ; : run-calculator ( -- ) From 3368866fc307616f529ced38971bbc4213fbad77 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 12 Oct 2008 07:25:03 -0600 Subject: [PATCH 05/10] fix counter --- extra/webapps/counter/counter.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/webapps/counter/counter.factor b/extra/webapps/counter/counter.factor index a5c9fbc6b9..d62096fffc 100644 --- a/extra/webapps/counter/counter.factor +++ b/extra/webapps/counter/counter.factor @@ -32,7 +32,7 @@ M: counter-app init-session* drop 0 count sset ; ! Deployment example USING: db.sqlite furnace.alloy namespaces ; -: counter-db ( -- params db ) "counter.db" sqlite-db ; +: counter-db ( -- db ) "counter.db" ; : run-counter ( -- ) From 72be15283234e99acea31c451d1ae8293a65ed06 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 12 Oct 2008 07:25:16 -0600 Subject: [PATCH 06/10] fix db tutorial --- basis/db/tuples/tuples-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/db/tuples/tuples-docs.factor b/basis/db/tuples/tuples-docs.factor index 02f5dfa38c..51830ee610 100644 --- a/basis/db/tuples/tuples-docs.factor +++ b/basis/db/tuples/tuples-docs.factor @@ -229,7 +229,7 @@ T{ book "Now we've created a book. Let's save it to the database." { $code <" USING: db db.sqlite fry io.files ; : with-book-tutorial ( quot -- ) - '[ "book-tutorial.db" temp-file sqlite-db _ with-db ] call ; + '[ "book-tutorial.db" temp-file _ with-db ] call ; [ book recreate-table From 868ad064261efec4a197c4a2ff1df4dc56ddbccb Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Tue, 14 Oct 2008 15:05:05 +1100 Subject: [PATCH 07/10] Adding hats --- extra/hats/authors.txt | 1 + extra/hats/hats-tests.factor | 87 ++++++++++++++++++++++++++++++++++++ extra/hats/hats.factor | 57 +++++++++++++++++++++++ extra/hats/summary.txt | 1 + 4 files changed, 146 insertions(+) create mode 100644 extra/hats/authors.txt create mode 100644 extra/hats/hats-tests.factor create mode 100644 extra/hats/hats.factor create mode 100644 extra/hats/summary.txt diff --git a/extra/hats/authors.txt b/extra/hats/authors.txt new file mode 100644 index 0000000000..e9c193bac7 --- /dev/null +++ b/extra/hats/authors.txt @@ -0,0 +1 @@ +Alex Chapman diff --git a/extra/hats/hats-tests.factor b/extra/hats/hats-tests.factor new file mode 100644 index 0000000000..ebb61a0830 --- /dev/null +++ b/extra/hats/hats-tests.factor @@ -0,0 +1,87 @@ +! Copyright (C) 2008 Alex Chapman. +! See http://factorcode.org/license.txt for BSD license. +USING: boxes hats kernel namespaces symbols tools.test ; +IN: hats.tests + +SYMBOLS: lion giraffe elephant rabbit ; + +! caps +[ rabbit ] [ rabbit out ] unit-test +[ rabbit ] [ f rabbit in out ] unit-test +[ rabbit ] [ rabbit take ] unit-test +[ f ] [ rabbit empty-hat out ] unit-test +[ rabbit f ] [ rabbit [ take ] keep out ] unit-test +[ rabbit t ] [ rabbit [ take ] keep empty-hat? ] unit-test +[ lion ] [ rabbit [ drop lion ] change-hat out ] unit-test + +! bowlers +[ giraffe ] [ [ giraffe rabbit set rabbit out ] with-scope ] unit-test + +[ rabbit ] +[ + [ + lion rabbit set [ + rabbit rabbit set rabbit out + ] with-scope + ] with-scope +] unit-test + +[ rabbit ] [ + rabbit + [ + lion rabbit set [ + rabbit rabbit set out + ] with-scope + ] with-scope +] unit-test + +[ elephant ] [ + rabbit + [ + elephant rabbit set [ + rabbit rabbit set + ] with-scope + out + ] with-scope +] unit-test + +[ rabbit ] [ + rabbit + [ + elephant in [ + rabbit in out + ] with-scope + ] with-scope +] unit-test + +[ elephant ] [ + rabbit + [ + elephant in [ + rabbit in + ] with-scope + out + ] with-scope +] unit-test + +! Top Hats +[ lion ] [ lion rabbit set-global rabbit out ] unit-test +[ giraffe ] [ rabbit giraffe in out ] unit-test + +! Tuple hats +TUPLE: foo bar ; +C: foo + +: test-tuple ( -- tuple ) + rabbit ; + +: test-slot-hat ( -- slot-hat ) + test-tuple 2 ; ! hack! + +[ rabbit ] [ test-slot-hat out ] unit-test +[ lion ] [ test-slot-hat lion in out ] unit-test + +! Boxes as hats +[ rabbit ] [ rabbit in out ] unit-test +[ rabbit in lion in ] must-fail +[ out ] must-fail diff --git a/extra/hats/hats.factor b/extra/hats/hats.factor new file mode 100644 index 0000000000..113705bd11 --- /dev/null +++ b/extra/hats/hats.factor @@ -0,0 +1,57 @@ +! Copyright (C) 2008 Alex Chapman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors boxes kernel namespaces ; +IN: hats + +! Bullwinkle: Hey Rocky, watch me pull a rabbit out of my hat! +! Rocky: But that trick never works! +! Bullwinkle: This time for sure! + +! hat protocol +MIXIN: hat + +GENERIC: out ( hat -- object ) +GENERIC: (in) ( object hat -- ) + +: in ( hat object -- hat ) over (in) ; inline +: empty-hat? ( hat -- ? ) out not ; inline +: empty-hat ( hat -- hat ) f in ; inline +: take ( hat -- object ) dup out f rot (in) ; inline +: change-hat ( hat quot -- hat ) + over >r >r out r> call r> swap in ; inline + +! caps (the simplest of hats) +TUPLE: cap object ; +C: cap +M: cap out ( cap -- object ) object>> ; +M: cap (in) ( object cap -- ) (>>object) ; +INSTANCE: cap hat + +! bowlers (dynamic variable hats) +TUPLE: bowler variable ; +C: bowler +M: bowler out ( bowler -- object ) variable>> get ; +M: bowler (in) ( object bowler -- ) variable>> set ; +INSTANCE: bowler hat + +! Top Hats (global variable hats) +TUPLE: top-hat variable ; +C: top-hat +M: top-hat out ( top-hat -- object ) variable>> get-global ; +M: top-hat (in) ( object top-hat -- ) variable>> set-global ; +INSTANCE: top-hat hat + +USE: slots.private +! Slot hats +TUPLE: slot-hat tuple slot ; +C: slot-hat +: >slot-hat< ( slot-hat -- tuple slot ) [ tuple>> ] [ slot>> ] bi ; inline +M: slot-hat out ( slot-hat -- object ) >slot-hat< slot ; +M: slot-hat (in) ( object slot-hat -- ) >slot-hat< set-slot ; +INSTANCE: slot-hat hat + +! Put a box on your head +M: box out ( box -- object ) box> ; +M: box (in) ( object box -- ) >box ; +INSTANCE: box hat + diff --git a/extra/hats/summary.txt b/extra/hats/summary.txt new file mode 100644 index 0000000000..9590639922 --- /dev/null +++ b/extra/hats/summary.txt @@ -0,0 +1 @@ +A protocol for getting and setting From 78e747186a80198f6754b19e6bccd54e16169fd1 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 13 Oct 2008 23:32:35 -0500 Subject: [PATCH 08/10] *** empty log message *** --- extra/dns/cache/rr/rr.factor | 68 ++++++++++++++++++++++++++++++++++++ 1 file changed, 68 insertions(+) create mode 100644 extra/dns/cache/rr/rr.factor diff --git a/extra/dns/cache/rr/rr.factor b/extra/dns/cache/rr/rr.factor new file mode 100644 index 0000000000..b9c12786e2 --- /dev/null +++ b/extra/dns/cache/rr/rr.factor @@ -0,0 +1,68 @@ + +USING: kernel sequences assocs sets locals combinators + accessors system math math.functions unicode.case prettyprint + combinators.cleave dns ; + +IN: dns.cache.rr + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: time data ; + +: now ( -- seconds ) millis 1000.0 / round >integer ; + +: expired? ( -- ? ) time>> now <= ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: make-cache-key ( obj -- key ) + { [ name>> >lower ] [ type>> unparse ] [ class>> unparse ] } 1arr " " join ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: cache ( -- table ) H{ } ; + +: cache-at ( obj -- ent ) make-cache-key cache at ; +: cache-delete ( obj -- ) make-cache-key cache delete-at ; +: cache-set-at ( ent obj -- ) make-cache-key cache set-at ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: cache-get ( OBJ -- rrs/f ) + [let | ENT [ OBJ cache-at ] | + { + { [ ENT f = ] [ f ] } + { [ ENT expired? ] [ OBJ cache-delete f ] } + { + [ t ] + [ + [let | NAME [ OBJ name>> ] + TYPE [ OBJ type>> ] + CLASS [ OBJ class>> ] + TTL [ now ENT time>> - ] | + ENT data>> + [| RDATA | T{ rr f NAME TYPE CLASS TTL RDATA } ] + map + ] + ] + } + } + cond + ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: cache-add ( RR -- ) + [let | ENT [ RR cache-at ] + TIME [ RR ttl>> now + ] + RDATA [ RR rdata>> ] | + { + { [ ENT f = ] [ T{ f TIME V{ RDATA } } RR cache-set-at ] } + { [ ENT expired? ] [ RR cache-delete RR cache-add ] } + { [ t ] [ TIME ENT (>>time) RDATA ENT data>> adjoin ] } + } + cond + ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + From fa41397a17235d7488e0db9bbc4f8a2a6a66b2d8 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 15 Oct 2008 04:44:18 -0500 Subject: [PATCH 09/10] Add 'bind-in' vocabulary (the -> operator...) --- extra/bind-in/bind-in.factor | 12 ++++++++++++ extra/dns/cache/nx/nx.factor | 35 +++++++++++++++++++++++++++++++++++ 2 files changed, 47 insertions(+) create mode 100644 extra/bind-in/bind-in.factor create mode 100644 extra/dns/cache/nx/nx.factor diff --git a/extra/bind-in/bind-in.factor b/extra/bind-in/bind-in.factor new file mode 100644 index 0000000000..ab6ff19094 --- /dev/null +++ b/extra/bind-in/bind-in.factor @@ -0,0 +1,12 @@ + +USING: kernel parser lexer locals.private ; + +IN: bind-in + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: -> + "[" parse-tokens make-locals dup push-locals + \ ] (parse-lambda) + parsed-lambda + \ call parsed ; parsing \ No newline at end of file diff --git a/extra/dns/cache/nx/nx.factor b/extra/dns/cache/nx/nx.factor new file mode 100644 index 0000000000..9904f857ba --- /dev/null +++ b/extra/dns/cache/nx/nx.factor @@ -0,0 +1,35 @@ + +USING: kernel assocs locals combinators + math math.functions system unicode.case ; + +IN: dns.cache.nx + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: nx-cache ( -- table ) H{ } ; + +: nx-cache-at ( name -- time ) >lower nx-cache at ; +: nx-cache-delete-at ( name -- ) >lower nx-cache delete-at ; +: nx-cache-set-at ( time name -- ) >lower nx-cache set-at ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: now ( -- seconds ) millis 1000.0 / round >integer ; + +:: non-existent-name? ( NAME -- ? ) + [let | TIME [ NAME nx-cache-at ] | + { + { [ TIME f = ] [ f ] } + { [ TIME now <= ] [ NAME nx-cache-delete-at f ] } + { [ t ] [ t ] } + } + cond + ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: cache-non-existent-name ( NAME TTL -- ) + [let | TIME [ TTL now + ] | TIME NAME nx-cache-set-at ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + From 4505ab4944753a70a8fda0f626605580c671b08b Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 15 Oct 2008 04:45:01 -0500 Subject: [PATCH 10/10] dns.cache.rr: Separate cache just for the rr objects --- extra/dns/cache/rr/rr.factor | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/extra/dns/cache/rr/rr.factor b/extra/dns/cache/rr/rr.factor index b9c12786e2..f3082b124c 100644 --- a/extra/dns/cache/rr/rr.factor +++ b/extra/dns/cache/rr/rr.factor @@ -62,7 +62,4 @@ TUPLE: time data ; { [ t ] [ TIME ENT (>>time) RDATA ENT data>> adjoin ] } } cond - ] ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - + ] ; \ No newline at end of file