diff --git a/core/dlists/dlists.factor b/core/dlists/dlists.factor
index ddec312182..12b1cd51ad 100755
--- a/core/dlists/dlists.factor
+++ b/core/dlists/dlists.factor
@@ -144,6 +144,11 @@ PRIVATE>
: dlist-delete ( obj dlist -- obj/f )
>r [ eq? ] curry r> delete-node-if ;
+: dlist-delete-all ( dlist -- )
+ f over set-dlist-front
+ f over set-dlist-back
+ 0 swap set-dlist-length ;
+
: dlist-each ( dlist quot -- )
[ dlist-node-obj ] swap compose dlist-each-node ; inline
diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index 5d4bb70912..bac9a2e65e 100755
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -2,7 +2,8 @@ IN: temporary
USING: tools.test io.files io threads kernel continuations ;
[ "passwd" ] [ "/etc/passwd" file-name ] unit-test
-[ "awk/" ] [ "/usr/libexec/awk/" file-name ] unit-test
+[ "awk" ] [ "/usr/libexec/awk/" file-name ] unit-test
+[ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test
[ ] [
"test-foo.txt" resource-path <file-writer> [
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 8c9bd8f2e9..79b59cc364 100755
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -64,7 +64,7 @@ M: object root-directory? ( path -- ? ) path-separator? ;
normalize-directory dup (directory) fixup-directory ;
: last-path-separator ( path -- n ? )
- [ length 2 [-] ] keep [ path-separator? ] find-last* ;
+ [ length 1- ] keep [ path-separator? ] find-last* ;
TUPLE: no-parent-directory path ;
@@ -83,7 +83,11 @@ TUPLE: no-parent-directory path ;
} cond ;
: file-name ( path -- string )
- dup last-path-separator [ 1+ tail ] [ drop ] if ;
+ right-trim-separators {
+ { [ dup empty? ] [ drop "/" ] }
+ { [ dup last-path-separator ] [ 1+ tail ] }
+ { [ t ] [ drop ] }
+ } cond ;
: resource-path ( path -- newpath )
\ resource-path get [ image parent-directory ] unless*
diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor
index eb04e329d9..c40bc54335 100755
--- a/core/parser/parser-tests.factor
+++ b/core/parser/parser-tests.factor
@@ -349,6 +349,14 @@ IN: temporary
"IN: temporary : foo ; TUPLE: foo ;"
<string-reader> "redefining-a-class-4" parse-stream drop
] [ [ redefine-error? ] is? ] must-fail-with
+
+ [ ] [
+ "IN: temporary : foo ( x y -- z ) 1 2 ; : bar ( a -- b ) ;" eval
+ ] unit-test
+
+ [
+ "IN: temporary : foo ( x y -- z) 1 2 ; : bar ( a -- b ) ;" eval
+ ] must-fail
] with-file-vocabs
[
diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index 59d18dc734..d54bf1c1f4 100755
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -307,10 +307,14 @@ SYMBOL: lexer-factory
! Parsing word utilities
: parse-effect ( -- effect )
- ")" parse-tokens { "--" } split1 dup [
- <effect>
+ ")" parse-tokens "(" over member? [
+ "Stack effect declaration must not contain (" throw
] [
- "Stack effect declaration must contain --" throw
+ { "--" } split1 dup [
+ <effect>
+ ] [
+ "Stack effect declaration must contain --" throw
+ ] if
] if ;
TUPLE: bad-number ;
diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor
index 64372fe4b7..e42dace945 100755
--- a/core/vocabs/loader/loader.factor
+++ b/core/vocabs/loader/loader.factor
@@ -149,12 +149,14 @@ SYMBOL: load-help?
dup modified-sources swap modified-docs ;
: load-error. ( vocab error -- )
- "While loading " rot dup >vocab-link write-object ":" print
- print-error ;
+ "==== " write >r
+ dup vocab-name swap f >vocab-link write-object ":" print nl
+ r> print-error ;
TUPLE: require-all-error vocabs ;
: require-all-error ( vocabs -- )
+ [ vocab-name ] map
\ require-all-error construct-boa throw ;
M: require-all-error summary
@@ -167,7 +169,6 @@ M: require-all-error summary
[ [ require ] [ 2array , ] recover ] each
] { } make
dup empty? [ drop ] [
- "==== LOAD ERRORS:" print
dup [ nl load-error. ] assoc-each
keys require-all-error
] if
diff --git a/extra/asn1/asn1-tests.factor b/extra/asn1/asn1-tests.factor
index 1c9bc79d76..329ba8256d 100755
--- a/extra/asn1/asn1-tests.factor
+++ b/extra/asn1/asn1-tests.factor
@@ -5,11 +5,11 @@ USING: asn1 asn1.ldap io io.streams.string tools.test ;
] unit-test
[ "testing" ] [
- "\u0004\u0007testing" <string-reader> [ asn-syntax read-ber ] with-stream
+ "\u000004\u000007testing" <string-reader> [ asn-syntax read-ber ] with-stream
] unit-test
[ { 1 { 3 "Administrator" "ad_is_bogus" } } ] [
- "0$\u0002\u0001\u0001`\u001f\u0002\u0001\u0003\u0004\rAdministrator\u0080\u000bad_is_bogus"
+ "0$\u000002\u000001\u000001`\u00001f\u000002\u000001\u000003\u000004\rAdministrator\u000080\u00000bad_is_bogus"
<string-reader> [ asn-syntax read-ber ] with-stream
] unit-test
diff --git a/extra/concurrency/concurrency-tests.factor b/extra/concurrency/concurrency-tests.factor
old mode 100644
new mode 100755
index 2f9b6605d7..b6f62d1779
--- a/extra/concurrency/concurrency-tests.factor
+++ b/extra/concurrency/concurrency-tests.factor
@@ -6,6 +6,8 @@ namespaces tools.test continuations dlists strings math words
match quotations concurrency.private ;
IN: temporary
+[ ] [ self process-mailbox mailbox-data dlist-delete-all ] unit-test
+
[ V{ 1 2 3 } ] [
0 <vector>
make-mailbox
diff --git a/extra/concurrency/concurrency.factor b/extra/concurrency/concurrency.factor
old mode 100644
new mode 100755
index 8d842f15d0..cf44ab125c
--- a/extra/concurrency/concurrency.factor
+++ b/extra/concurrency/concurrency.factor
@@ -73,7 +73,7 @@ PRIVATE>
: mailbox-get?* ( pred mailbox timeout -- obj )
2over >r >r (mailbox-block-unless-pred) r> r>
- mailbox-data delete-node ; inline
+ mailbox-data delete-node-if ; inline
: mailbox-get? ( pred mailbox -- obj )
f mailbox-get?* ;
diff --git a/extra/hardware-info/windows/ce/ce.factor b/extra/hardware-info/windows/ce/ce.factor
index 8923d86b03..f671ea9426 100755
--- a/extra/hardware-info/windows/ce/ce.factor
+++ b/extra/hardware-info/windows/ce/ce.factor
@@ -10,25 +10,25 @@ T{ wince-os } os set-global
"MEMORYSTATUS" heap-size over set-MEMORYSTATUS-dwLength
[ GlobalMemoryStatus ] keep ;
-M: wince cpus ( -- n ) 1 ;
+M: wince-os cpus ( -- n ) 1 ;
-M: wince memory-load ( -- n )
+M: wince-os memory-load ( -- n )
memory-status MEMORYSTATUS-dwMemoryLoad ;
-M: wince physical-mem ( -- n )
+M: wince-os physical-mem ( -- n )
memory-status MEMORYSTATUS-dwTotalPhys ;
-M: wince available-mem ( -- n )
+M: wince-os available-mem ( -- n )
memory-status MEMORYSTATUS-dwAvailPhys ;
-M: wince total-page-file ( -- n )
+M: wince-os total-page-file ( -- n )
memory-status MEMORYSTATUS-dwTotalPageFile ;
-M: wince available-page-file ( -- n )
+M: wince-os available-page-file ( -- n )
memory-status MEMORYSTATUS-dwAvailPageFile ;
-M: wince total-virtual-mem ( -- n )
+M: wince-os total-virtual-mem ( -- n )
memory-status MEMORYSTATUS-dwTotalVirtual ;
-M: wince available-virtual-mem ( -- n )
+M: wince-os available-virtual-mem ( -- n )
memory-status MEMORYSTATUS-dwAvailVirtual ;
diff --git a/extra/http/server/templating/templating.factor b/extra/http/server/templating/templating.factor
index f5de4664a1..dc83562600 100755
--- a/extra/http/server/templating/templating.factor
+++ b/extra/http/server/templating/templating.factor
@@ -32,17 +32,18 @@ M: template-lexer skip-word
DEFER: <% delimiter
: check-<% ( lexer -- col )
- "<%" over line-text rot lexer-column start* ;
+ "<%" over lexer-line-text rot lexer-column start* ;
: found-<% ( accum lexer col -- accum )
[
- over line-text >r >r lexer-column r> r> subseq parsed
+ over lexer-line-text
+ >r >r lexer-column r> r> subseq parsed
\ write-html parsed
] 2keep 2 + swap set-lexer-column ;
: still-looking ( accum lexer -- accum )
[
- dup line-text swap lexer-column tail
+ dup lexer-line-text swap lexer-column tail
parsed \ print-html parsed
] keep next-line ;
diff --git a/extra/ldap/libldap/libldap.factor b/extra/ldap/libldap/libldap.factor
old mode 100644
new mode 100755
index 6113fe5b7e..492aed1a54
--- a/extra/ldap/libldap/libldap.factor
+++ b/extra/ldap/libldap/libldap.factor
@@ -40,9 +40,9 @@ IN: ldap.libldap
: LDAP_RES_UNSOLICITED 0 ; inline
! how many messages to retrieve results for
-: LDAP_MSG_ONE HEX: 00 ; inline
-: LDAP_MSG_ALL HEX: 01 ; inline
-: LDAP_MSG_RECEIVED HEX: 02 ; inline
+: LDAP_MSG_ONE HEX: 00 ; inline
+: LDAP_MSG_ALL HEX: 01 ; inline
+: LDAP_MSG_RECEIVED HEX: 02 ; inline
! the possible result types returned
: LDAP_RES_BIND HEX: 61 ; inline
@@ -71,7 +71,7 @@ IN: ldap.libldap
{ HEX: 79 "LDAP_RES_EXTENDED_PARTIAL" }
} ;
-: LDAP_OPT_PROTOCOL_VERSION HEX: 0011 ; inline
+: LDAP_OPT_PROTOCOL_VERSION HEX: 0011 ; inline
C-STRUCT: ldap
{ "char" "ld_lberoptions" }
diff --git a/extra/math/constants/constants-docs.factor b/extra/math/constants/constants-docs.factor
index 653444376a..42cdf0e8f1 100755
--- a/extra/math/constants/constants-docs.factor
+++ b/extra/math/constants/constants-docs.factor
@@ -4,7 +4,7 @@ IN: math.constants
ARTICLE: "math-constants" "Constants"
"Standard mathematical constants:"
{ $subsection e }
-{ $subsection gamma }
+{ $subsection euler }
{ $subsection phi }
{ $subsection pi }
"Various limits:"
@@ -17,7 +17,7 @@ ABOUT: "math-constants"
HELP: e
{ $values { "e" "base of natural logarithm" } } ;
-HELP: gamma
+HELP: euler
{ $values { "gamma" "Euler-Mascheroni constant" } }
{ $description "The Euler-Mascheroni constant, also called \"Euler's constant\" or \"the Euler constant\"." } ;
diff --git a/extra/math/constants/constants.factor b/extra/math/constants/constants.factor
index c4abeca0eb..c207eaa63c 100755
--- a/extra/math/constants/constants.factor
+++ b/extra/math/constants/constants.factor
@@ -3,7 +3,7 @@
IN: math.constants
: e ( -- e ) 2.7182818284590452354 ; inline
-: gamma ( -- gamma ) 0.57721566490153286060 ; inline
+: euler ( -- gamma ) 0.57721566490153286060 ; inline
: phi ( -- phi ) 1.61803398874989484820 ; inline
: pi ( -- pi ) 3.14159265358979323846 ; inline
: epsilon ( -- epsilon ) 2.2204460492503131e-16 ; inline
diff --git a/extra/math/matrices/elimination/elimination.factor b/extra/math/matrices/elimination/elimination.factor
index 73f6dd7e96..8ac9771767 100755
--- a/extra/math/matrices/elimination/elimination.factor
+++ b/extra/math/matrices/elimination/elimination.factor
@@ -1,7 +1,7 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.vectors math.matrices namespaces
-sequences parser ;
+sequences ;
IN: math.matrices.elimination
SYMBOL: matrix
@@ -20,6 +20,9 @@ SYMBOL: matrix
: cols ( -- n ) 0 nth-row length ;
+: skip ( i seq quot -- n )
+ over >r find* drop r> length or ; inline
+
: first-col ( row# -- n )
#! First non-zero column
0 swap nth-row [ zero? not ] skip ;
diff --git a/extra/nehe/5/5.factor b/extra/nehe/5/5.factor
old mode 100644
new mode 100755
index a792f04479..31a7d059ae
--- a/extra/nehe/5/5.factor
+++ b/extra/nehe/5/5.factor
@@ -108,10 +108,12 @@ M: nehe5-gadget draw-gadget* ( gadget -- )
: nehe5-update-thread ( gadget -- )
dup nehe5-gadget-quit? [
+ drop
+ ] [
redraw-interval sleep
dup relayout-1
nehe5-update-thread
- ] unless ;
+ ] if ;
M: nehe5-gadget graft* ( gadget -- )
[ f swap set-nehe5-gadget-quit? ] keep
diff --git a/extra/openssl/libcrypto/libcrypto.factor b/extra/openssl/libcrypto/libcrypto.factor
old mode 100644
new mode 100755
index 52cb06f62e..8378a11956
--- a/extra/openssl/libcrypto/libcrypto.factor
+++ b/extra/openssl/libcrypto/libcrypto.factor
@@ -49,7 +49,7 @@ C-STRUCT: bio
: BIO_CLOSE HEX: 01 ; inline
: RSA_3 HEX: 3 ; inline
-: RSA_F4 HEX: 10001 ; inline
+: RSA_F4 HEX: 10001 ; inline
: BIO_C_SET_SSL 109 ; inline
: BIO_C_GET_SSL 110 ; inline
diff --git a/extra/openssl/openssl-tests.factor b/extra/openssl/openssl-tests.factor
old mode 100644
new mode 100755
index f4576dca19..c40bc5628b
--- a/extra/openssl/openssl-tests.factor
+++ b/extra/openssl/openssl-tests.factor
@@ -1,6 +1,6 @@
USING: alien alien.c-types assocs bit-arrays hashtables io io.files
io.sockets kernel mirrors openssl.libcrypto openssl.libssl
-namespaces math math.parser openssl prettyprint sequences tools.test unix ;
+namespaces math math.parser openssl prettyprint sequences tools.test ;
! =========================================================
! Some crypto functions (still to be turned into words)
diff --git a/extra/openssl/openssl.factor b/extra/openssl/openssl.factor
old mode 100644
new mode 100755
index 3b5474ea9f..bfa7f32594
--- a/extra/openssl/openssl.factor
+++ b/extra/openssl/openssl.factor
@@ -4,7 +4,7 @@
! Tested with OpenSSL 0.9.8a_0 on Mac OS X 10.4.9 PowerPC
USING: alien alien.c-types assocs kernel libc namespaces
-openssl.libcrypto openssl.libssl sequences unix ;
+openssl.libcrypto openssl.libssl sequences ;
IN: openssl
diff --git a/extra/partial-continuations/partial-continuations.factor b/extra/partial-continuations/partial-continuations.factor
old mode 100644
new mode 100755
index 0dce7c2390..b80e3a9ddb
--- a/extra/partial-continuations/partial-continuations.factor
+++ b/extra/partial-continuations/partial-continuations.factor
@@ -6,7 +6,7 @@ USING: kernel continuations arrays sequences quotations ;
: breset ( quot -- )
[ 1array swap keep first continue-with ] callcc1 nip ;
-: (bshift) ( v r k -- )
+: (bshift) ( v r k -- obj )
>r dup first -rot r>
[
rot set-first
@@ -19,4 +19,4 @@ USING: kernel continuations arrays sequences quotations ;
over >r
[ (bshift) ] 2curry swap call
r> first continue-with
- ] callcc1 2nip ;
+ ] callcc1 2nip ; inline
diff --git a/extra/random-tester/random-tester.factor b/extra/random-tester/random-tester.factor
old mode 100644
new mode 100755
index c3a1ecbec4..8704687e34
--- a/extra/random-tester/random-tester.factor
+++ b/extra/random-tester/random-tester.factor
@@ -17,9 +17,9 @@ TUPLE: random-tester-error ;
: test-compiler ! ( data... quot -- ... )
errored off
dup quot set
- datastack clone >vector dup pop* before set
- [ call ] catch drop
- datastack clone after set
+ datastack 1 head* before set
+ [ call ] [ drop ] recover
+ datastack after set
clear
before get [ ] each
quot get [ compile-call ] [ errored on ] recover ;
diff --git a/extra/regexp/regexp.factor b/extra/regexp/regexp.factor
index ef88e84f05..fe1d87d9e9 100755
--- a/extra/regexp/regexp.factor
+++ b/extra/regexp/regexp.factor
@@ -77,7 +77,7 @@ PRIVATE>
: 'hex' ( -- parser )
"x" token 'hex-digit' 2 exactly-n &>
- "u" token 'hex-digit' 4 exactly-n &> <|>
+ "u" token 'hex-digit' 6 exactly-n &> <|>
[ hex> ] <@ ;
: satisfy-tokens ( assoc -- parser )
diff --git a/extra/serialize/serialize-tests.factor b/extra/serialize/serialize-tests.factor
old mode 100644
new mode 100755
index a713840a20..e0ecb5393a
--- a/extra/serialize/serialize-tests.factor
+++ b/extra/serialize/serialize-tests.factor
@@ -10,8 +10,6 @@ TUPLE: serialize-test a b ;
C: <serialize-test> serialize-test
-: CURRY< \ > parse-until first2 curry parsed ; parsing
-
: objects
{
f
@@ -33,7 +31,7 @@ C: <serialize-test> serialize-test
B{ 50 13 55 64 1 }
?{ t f t f f t f }
F{ 1.0 3.0 4.0 1.0 2.35 0.33 }
- CURRY< 1 [ 2 ] >
+ << 1 [ 2 ] curry parsed >>
{ { "a" "bc" } { "de" "fg" } }
H{ { "a" "bc" } { "de" "fg" } }
} ;
diff --git a/extra/state-parser/state-parser-tests.factor b/extra/state-parser/state-parser-tests.factor
old mode 100644
new mode 100755
index ff8ac91513..4e1ecaddfc
--- a/extra/state-parser/state-parser-tests.factor
+++ b/extra/state-parser/state-parser-tests.factor
@@ -1,4 +1,4 @@
-USING: tools.test state-parser kernel io strings ;
+USING: tools.test state-parser kernel io strings ascii ;
[ "hello" ] [ "hello" [ rest ] string-parse ] unit-test
[ 2 4 ] [ "12\n123" [ rest drop get-line get-column ] string-parse ] unit-test
diff --git a/extra/tuple-syntax/tuple-syntax-tests.factor b/extra/tuple-syntax/tuple-syntax-tests.factor
old mode 100644
new mode 100755
index b16c5b337d..0a9711c446
--- a/extra/tuple-syntax/tuple-syntax-tests.factor
+++ b/extra/tuple-syntax/tuple-syntax-tests.factor
@@ -1,4 +1,5 @@
USING: tools.test tuple-syntax ;
+IN: temporary
TUPLE: foo bar baz ;
diff --git a/extra/tuple-syntax/tuple-syntax.factor b/extra/tuple-syntax/tuple-syntax.factor
old mode 100644
new mode 100755
index 6082f529ac..2f0ba6bde5
--- a/extra/tuple-syntax/tuple-syntax.factor
+++ b/extra/tuple-syntax/tuple-syntax.factor
@@ -1,4 +1,5 @@
-USING: kernel sequences slots parser words classes ;
+USING: kernel sequences slots parser words classes
+slots.private ;
IN: tuple-syntax
! TUPLE: foo bar baz ;
@@ -7,15 +8,15 @@ IN: tuple-syntax
: parse-object ( -- object )
scan-word dup parsing? [ V{ } clone swap execute first ] when ;
-: parse-slot-writer ( tuple -- slot-setter )
+: parse-slot-writer ( tuple -- slot# )
scan dup "}" = [ 2drop f ] [
1 head* swap class "slots" word-prop
- [ slot-spec-name = ] with find nip slot-spec-writer
+ [ slot-spec-name = ] with find nip slot-spec-offset
] if ;
: parse-slots ( accum tuple -- accum tuple )
dup parse-slot-writer
- [ parse-object pick rot execute parse-slots ] when* ;
+ [ parse-object pick rot set-slot parse-slots ] when* ;
: TUPLE{
scan-word construct-empty parse-slots parsed ; parsing
diff --git a/extra/ui/gadgets/editors/editors.factor b/extra/ui/gadgets/editors/editors.factor
index 00b574f853..e2df6a343b 100755
--- a/extra/ui/gadgets/editors/editors.factor
+++ b/extra/ui/gadgets/editors/editors.factor
@@ -249,11 +249,11 @@ M: editor gadget-text* editor-string % ;
: extend-selection ( editor -- )
dup request-focus dup editor-caret click-loc ;
-: mouse-elt ( -- elelement )
+: mouse-elt ( -- element )
hand-click# get {
+ { 1 T{ one-char-elt } }
{ 2 T{ one-word-elt } }
- { 3 T{ one-line-elt } }
- } at T{ one-char-elt } or ;
+ } at T{ one-line-elt } or ;
: drag-direction? ( loc editor -- ? )
editor-mark* <=> 0 < ;
diff --git a/extra/xmode/utilities/utilities-tests.factor b/extra/xmode/utilities/utilities-tests.factor
old mode 100644
new mode 100755
index 89cb588336..713700bf7a
--- a/extra/xmode/utilities/utilities-tests.factor
+++ b/extra/xmode/utilities/utilities-tests.factor
@@ -1,6 +1,6 @@
IN: temporary
-USING: xmode.utilities tools.test xml xml.data
-kernel strings vectors sequences io.files prettyprint assocs ;
+USING: xmode.utilities tools.test xml xml.data kernel strings
+vectors sequences io.files prettyprint assocs unicode.case ;
[ "hi" 3 ] [
{ 1 2 3 4 5 6 7 8 } [ H{ { 3 "hi" } } at ] map-find