Merge branch 'master' of git://factorcode.org/git/factor

core/alien/alien-tests.factor

@@ -1,7 +1,7 @@
 IN: alien.tests
 USING: alien alien.accessors byte-arrays arrays kernel
 kernel.private namespaces tools.test sequences libc math system
-prettyprint ;
+prettyprint layouts ;
 
 [ t ] [ -1 <alien> alien-address 0 > ] unit-test
 

core/alien/c-types/c-types.factor

@@ -4,7 +4,7 @@ USING: bit-arrays byte-arrays float-arrays arrays
 generator.registers assocs kernel kernel.private libc math
 namespaces parser sequences strings words assocs splitting
 math.parser cpu.architecture alien alien.accessors quotations
-system compiler.units io.files io.encodings.binary ;
+layouts system compiler.units io.files io.encodings.binary ;
 IN: alien.c-types
 
 DEFER: <int>

core/alien/compiler/compiler.factor

@@ -6,7 +6,7 @@ inference.state inference.backend inference.dataflow system
 math.parser classes alien.arrays alien.c-types alien.structs
 alien.syntax cpu.architecture alien inspector quotations assocs
 kernel.private threads continuations.private libc combinators
-compiler.errors continuations ;
+compiler.errors continuations layouts ;
 IN: alien.compiler
 
 ! Common protocol for alien-invoke/alien-callback/alien-indirect

core/bootstrap/image/image.factor

@@ -191,7 +191,9 @@ M: bignum '
 M: fixnum '
     #! When generating a 32-bit image on a 64-bit system,
     #! some fixnums should be bignums.
-    dup most-negative-fixnum most-positive-fixnum between?
+    dup
+    bootstrap-most-negative-fixnum
+    bootstrap-most-positive-fixnum between?
     [ tag-fixnum ] [ >bignum ' ] if ;
 
 ! Floats

core/classes/classes-docs.factor

@@ -7,11 +7,6 @@ IN: classes
 ARTICLE: "builtin-classes" "Built-in classes"
 "Every object is an instance of exactly one canonical " { $emphasis "built-in class" } " which defines its layout in memory and basic behavior."
 $nl
-"Corresponding to every built-in class is a built-in type number. An object can be asked for its built-in type number:"
-{ $subsection type }
-"Built-in type numbers can be converted to classes, and vice versa:"
-{ $subsection type>class }
-{ $subsection type-number }
 "The set of built-in classes is a class:"
 { $subsection builtin-class }
 { $subsection builtin-class? }

core/cpu/x86/32/32.factor

@@ -3,7 +3,7 @@
 USING: alien.c-types arrays cpu.x86.assembler
 cpu.x86.architecture cpu.x86.intrinsics cpu.x86.allot
 cpu.architecture kernel kernel.private math namespaces sequences
-generator.registers generator.fixup generator system
+generator.registers generator.fixup generator system layouts
 alien.compiler combinators command-line
 compiler compiler.units io vocabs.loader ;
 IN: cpu.x86.32

core/cpu/x86/assembler/assembler.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generator.fixup io.binary kernel
 combinators kernel.private math namespaces parser sequences
-words system ;
+words system layouts ;
 IN: cpu.x86.assembler
 
 ! A postfix assembler for x86 and AMD64.

core/generator/fixup/fixup.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generic assocs hashtables
 kernel kernel.private math namespaces sequences words
-quotations strings alien system combinators math.bitfields
-words.private cpu.architecture ;
+quotations strings alien layouts system combinators
+math.bitfields words.private cpu.architecture ;
 IN: generator.fixup
 
 : no-stack-frame -1 ; inline

core/inference/class/class-tests.factor

@@ -4,7 +4,7 @@ inference.dataflow optimizer tools.test kernel.private generic
 sequences words inference.class quotations alien
 alien.c-types strings sbufs sequences.private
 slots.private combinators definitions compiler.units
-system ;
+system layouts ;
 
 ! Make sure these compile even though this is invalid code
 [ ] [ [ 10 mod 3.0 /i ] dataflow optimize drop ] unit-test

core/kernel/kernel-docs.factor

@@ -127,12 +127,22 @@ ARTICLE: "conditionals" "Conditionals and logic"
 { $see-also "booleans" "bitwise-arithmetic" both? either? } ;
 
 ARTICLE: "equality" "Equality and comparison testing"
-"There are two distinct notions of ``sameness'' when it comes to objects. You can test if two references point to the same object, or you can test if two objects are equal in some sense, usually by being instances of the same class, and having equal slot values. Both notions of equality are equality relations in the mathematical sense."
+"There are two distinct notions of ``sameness'' when it comes to objects. You can test if two references point to the same object (" { $emphasis "identity comparison" } "), or you can test if two objects are equal in a domain-specific sense, usually by being instances of the same class, and having equal slot values (" { $emphasis "value comparison" } "). Both notions of equality are equality relations in the mathematical sense."
+$nl
+"Identity comparison:"
 { $subsection eq? }
+"Value comparison:"
 { $subsection = }
+"Generic words for custom value comparison methods:"
+{ $subsection equal? }
 "Some types of objects also have an intrinsic order allowing sorting using " { $link natural-sort } ":"
 { $subsection <=> }
 { $subsection compare }
+"Utilities for comparing objects:"
+{ $subsection after? }
+{ $subsection before? }
+{ $subsection after=? }
+{ $subsection before=? }
 "An object can be cloned; the clone has distinct identity but equal value:"
 { $subsection clone } ;
 
@@ -225,21 +235,18 @@ HELP: equal?
 { $contract
     "Tests if two objects are equal."
     $nl
-    "Method definitions should ensure that this is an equality relation:"
+    "User code should call " { $link = } " instead; that word first tests the case where the objects are " { $link eq? } ", and so by extension, methods defined on " { $link equal? } " assume they are never called on " { $link eq? } " objects."
+    $nl
+    "Method definitions should ensure that this is an equality relation, modulo the assumption that the two objects are not " { $link eq? } ". That is, for any three non-" { $link eq? } " objects " { $snippet "a" } ", " { $snippet "b" } " and " { $snippet "c" } ", we must have:"
     { $list
-        { $snippet "a = a" }
         { { $snippet "a = b" } " implies " { $snippet "b = a" } }
         { { $snippet "a = b" } " and " { $snippet "b = c" } " implies " { $snippet "a = c" } }
     }
-    "While user code can define methods for this generic word, it should not call it directly, since it does not handle the case where the two references point to the same object."
 }
 { $examples
-    "The most common reason for defining a method for this generic word to ensure that instances of a specific tuple class are only ever equal to themselves, overriding the default implementation which checks slot values for equality."
+    "To define a tuple class such that two instances are only equal if they are both the same instance, we can add a method to " { $link equal? } " which always returns " { $link f } ". Since " { $link = } " handles the case where the two objects are " { $link eq? } ", this method will never be called with two " { $link eq? } " objects, so such a definition is valid:"
     { $code "TUPLE: foo ;" "M: foo equal? 2drop f ;" }
-    "Note that with the above definition, calling " { $link equal? } " directly will give unexpected results:"
-    { $unchecked-example "T{ foo } dup equal? ." "f" }
-    { $unchecked-example "T{ foo } dup clone equal? ." "f" }
-    "As documented above, " { $link = } " should be called instead:"
+    "By calling " { $link = } " on instances of " { $snippet "foo" } " we get the results we expect:"
     { $unchecked-example "T{ foo } dup = ." "t" }
     { $unchecked-example "T{ foo } dup clone = ." "f" }
 } ;

core/layouts/layouts-docs.factor

@@ -1,5 +1,7 @@
-USING: layouts generic help.markup help.syntax kernel math
-memory namespaces sequences kernel.private classes ;
+USING: generic help.markup help.syntax kernel math
+memory namespaces sequences kernel.private classes
+sequences.private ;
+IN: layouts
 
 HELP: tag-bits
 { $var-description "Number of least significant bits reserved for a type tag in a tagged pointer." }
@@ -35,3 +37,88 @@ HELP: most-positive-fixnum
 
 HELP: most-negative-fixnum
 { $values { "n" "smallest negative integer representable by a fixnum" } } ;
+
+HELP: bootstrap-first-bignum
+{ $values { "n" "smallest positive integer not representable by a fixnum" } }
+{ $description "Outputs the value for the target architecture when bootstrapping." } ;
+
+HELP: bootstrap-most-positive-fixnum
+{ $values { "n" "largest positive integer representable by a fixnum" } } 
+{ $description "Outputs the value for the target architecture when bootstrapping." } ;
+
+HELP: bootstrap-most-negative-fixnum
+{ $values { "n" "smallest negative integer representable by a fixnum" } } 
+{ $description "Outputs the value for the target architecture when bootstrapping." } ;
+
+HELP: cell
+{ $values { "n" "a positive integer" } }
+{ $description "Outputs the pointer size in bytes of the current CPU architecture." } ;
+
+HELP: cells
+{ $values { "m" integer } { "n" integer } }
+{ $description "Computes the number of bytes used by " { $snippet "m" } " CPU operand-sized cells." } ;
+
+HELP: cell-bits
+{ $values { "n" integer } }
+{ $description "Outputs the number of bits in one CPU operand-sized cell." } ;
+
+HELP: bootstrap-cell
+{ $values { "n" "a positive integer" } }
+{ $description "Outputs the pointer size in bytes for the target image (if bootstrapping) or the current CPU architecture (otherwise)." } ;
+
+HELP: bootstrap-cells
+{ $values { "m" integer } { "n" integer } }
+{ $description "Computes the number of bytes used by " { $snippet "m" } " cells in the target image (if bootstrapping) or the current CPU architecture (otherwise)." } ;
+
+HELP: bootstrap-cell-bits
+{ $values { "n" integer } }
+{ $description "Outputs the number of bits in one cell in the target image (if bootstrapping) or the current CPU architecture (otherwise)." } ;
+
+ARTICLE: "layouts-types" "Type numbers"
+"Corresponding to every built-in class is a built-in type number. An object can be asked for its built-in type number:"
+{ $subsection type }
+"Built-in type numbers can be converted to classes, and vice versa:"
+{ $subsection type>class }
+{ $subsection type-number }
+{ $subsection num-types }
+{ $see-also "builtin-classes" } ;
+
+ARTICLE: "layouts-tags" "Tagged pointers"
+"Every pointer stored on the stack or in the heap has a " { $emphasis "tag" } ", which is a small integer identifying the type of the pointer. If the tag is not equal to one of the two special tags, the remaining bits contain the memory address of a heap-allocated object. The two special tags are the " { $link fixnum } " tag and the " { $link f } " tag."
+$nl
+"Getting the tag of an object:"
+{ $link tag }
+"Words for working with tagged pointers:"
+{ $subsection tag-bits }
+{ $subsection num-tags }
+{ $subsection tag-mask }
+{ $subsection tag-number }
+"The Factor VM does not actually expose any words for working with tagged pointers directly. The above words operate on integers; they are used in the bootstrap image generator and the optimizing compiler." ;
+
+ARTICLE: "layouts-limits" "Sizes and limits"
+"Processor cell size:"
+{ $subsection cell }
+{ $subsection cells }
+{ $subsection cell-bits }
+"Range of integers representable by " { $link fixnum } "s:"
+{ $subsection most-negative-fixnum }
+{ $subsection most-positive-fixnum }
+"Maximum array size:"
+{ $subsection max-array-capacity } ;
+
+ARTICLE: "layouts-bootstrap" "Bootstrap support"
+"Bootstrap support:"
+{ $subsection bootstrap-cell }
+{ $subsection bootstrap-cells }
+{ $subsection bootstrap-cell-bits }
+{ $subsection bootstrap-most-negative-fixnum }
+{ $subsection bootstrap-most-positive-fixnum } ;
+
+ARTICLE: "layouts" "VM memory layouts"
+"The words documented in this section do not ever need to be called by user code. They are documented for the benefit of those wishing to explore the internals of Factor's implementation."
+{ $subsection "layouts-types" }
+{ $subsection "layouts-tags" }
+{ $subsection "layouts-limits" }
+{ $subsection "layouts-bootstrap" } ;
+
+ABOUT: "layouts"

core/layouts/layouts-tests.factor

@@ -0,0 +1,5 @@
+IN: system.tests
+USING: layouts math tools.test ;
+
+[ t ] [ cell integer? ] unit-test
+[ t ] [ bootstrap-cell integer? ] unit-test

core/layouts/layouts.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces math words kernel assocs system classes ;
+USING: namespaces math words kernel assocs classes
+kernel.private ;
 IN: layouts
 
 SYMBOL: tag-mask
@@ -24,8 +25,23 @@ SYMBOL: type-numbers
 : tag-fixnum ( n -- tagged )
     tag-bits get shift ;
 
+: cell ( -- n ) 7 getenv ; foldable
+
+: cells ( m -- n ) cell * ; inline
+
+: cell-bits ( -- n ) 8 cells ; inline
+
+: bootstrap-cell \ cell get cell or ; inline
+
+: bootstrap-cells bootstrap-cell * ; inline
+
+: bootstrap-cell-bits 8 bootstrap-cells ; inline
+
+: (first-bignum) ( m -- n )
+    tag-bits get - 1 - 2^ ;
+
 : first-bignum ( -- n )
-    bootstrap-cell-bits tag-bits get - 1 - 2^ ;
+    cell-bits (first-bignum) ;
 
 : most-positive-fixnum ( -- n )
     first-bignum 1- ;
@@ -33,6 +49,15 @@ SYMBOL: type-numbers
 : most-negative-fixnum ( -- n )
     first-bignum neg ;
 
+: bootstrap-first-bignum ( -- n )
+    bootstrap-cell-bits (first-bignum) ;
+
+: bootstrap-most-positive-fixnum ( -- n )
+    bootstrap-first-bignum 1- ;
+
+: bootstrap-most-negative-fixnum ( -- n )
+    bootstrap-first-bignum neg ;
+
 M: bignum >integer
     dup most-negative-fixnum most-positive-fixnum between?
     [ >fixnum ] when ;

core/system/system-docs.factor

@@ -15,10 +15,6 @@ ARTICLE: "os" "System interface"
 { $subsection wince? }
 "Processor detection:"
 { $subsection cpu }
-"Processor cell size:"
-{ $subsection cell }
-{ $subsection cells }
-{ $subsection cell-bits }
 "Reading environment variables:"
 { $subsection os-env }
 { $subsection os-envs }
@@ -114,7 +110,15 @@ HELP: os-envs
 }
 { $errors "Windows CE has no concept of environment variables, so this word throws an error there." } ;
 
-{ os-env os-envs } related-words
+HELP: set-os-envs
+{ $values { "assoc" "an association mapping strings to strings" } }
+{ $description "Replaces the current set of environment variables." }
+{ $notes
+    "Names and values of environment variables are operating system-specific."
+}
+{ $errors "Windows CE has no concept of environment variables, so this word throws an error there." } ;
+
+{ os-env os-envs set-os-envs } related-words
 
 HELP: win32?
 { $values { "?" "a boolean" } }
@@ -135,27 +139,3 @@ HELP: vm
 HELP: unix?
 { $values { "?" "a boolean" } }
 { $description "Tests if Factor is running on a Unix-like system. While this is a rather vague notion, one can use it to make certain assumptions about system calls and file structure which are not valid on Windows." } ;
-
-HELP: cell
-{ $values { "n" "a positive integer" } }
-{ $description "Outputs the pointer size in bytes of the current CPU architecture." } ;
-
-HELP: cells
-{ $values { "m" integer } { "n" integer } }
-{ $description "Computes the number of bytes used by " { $snippet "m" } " CPU operand-sized cells." } ;
-
-HELP: cell-bits
-{ $values { "n" integer } }
-{ $description "Outputs the number of bits in one CPU operand-sized cell." } ;
-
-HELP: bootstrap-cell
-{ $values { "n" "a positive integer" } }
-{ $description "Outputs the pointer size in bytes for the target image (if bootstrapping) or the current CPU architecture (otherwise)." } ;
-
-HELP: bootstrap-cells
-{ $values { "m" integer } { "n" integer } }
-{ $description "Computes the number of bytes used by " { $snippet "m" } " cells in the target image (if bootstrapping) or the current CPU architecture (otherwise)." } ;
-
-HELP: bootstrap-cell-bits
-{ $values { "n" integer } }
-{ $description "Outputs the number of bits in one cell in the target image (if bootstrapping) or the current CPU architecture (otherwise)." } ;

core/system/system-tests.factor

@@ -1,9 +1,6 @@
 USING: math tools.test system prettyprint namespaces kernel ;
 IN: system.tests
 
-[ t ] [ cell integer? ] unit-test
-[ t ] [ bootstrap-cell integer? ] unit-test
-
 wince? [
     [ ] [ os-envs . ] unit-test
 ] unless

core/system/system.factor

@@ -2,13 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: system
 USING: kernel kernel.private sequences math namespaces
-splitting assocs system.private ;
-
-: cell ( -- n ) 7 getenv ; foldable
-
-: cells ( m -- n ) cell * ; inline
-
-: cell-bits ( -- n ) 8 cells ; inline
+splitting assocs system.private layouts ;
 
 : cpu ( -- cpu ) 8 getenv ; foldable
 
@@ -51,12 +45,6 @@ splitting assocs system.private ;
 : solaris? ( -- ? )
     os "solaris" = ;
 
-: bootstrap-cell \ cell get cell or ; inline
-
-: bootstrap-cells bootstrap-cell * ; inline
-
-: bootstrap-cell-bits 8 bootstrap-cells ; inline
-
 : os-envs ( -- assoc )
     (os-envs) [ "=" split1 ] H{ } map>assoc ;
 

extra/alarms/alarms-tests.factor

@@ -1,6 +1,6 @@
 IN: alarms.tests
-USING: alarms kernel calendar sequences tools.test threads
-concurrency.count-downs ;
+USING: alarms alarms.private kernel calendar sequences
+tools.test threads concurrency.count-downs ;
 
 [ ] [
     1 <count-down>
@@ -15,3 +15,5 @@ concurrency.count-downs ;
         [ resume ] curry instant later drop
     ] "test" suspend drop
 ] unit-test
+
+\ alarm-thread-loop must-infer

extra/alarms/alarms.factor

@@ -38,7 +38,7 @@ SYMBOL: alarm-thread
 
 : call-alarm ( alarm -- )
     dup alarm-entry box> drop
-    dup alarm-quot try
+    dup alarm-quot "Alarm execution" spawn drop
     dup alarm-interval [ reschedule-alarm ] [ drop ] if ;
 
 : (trigger-alarms) ( alarms now -- )
@@ -62,8 +62,7 @@ SYMBOL: alarm-thread
 : alarm-thread-loop ( -- )
     alarms get-global
     dup next-alarm sleep-until
-    dup trigger-alarms
-    alarm-thread-loop ;
+    trigger-alarms ;
 
 : cancel-alarms ( alarms -- )
     [
@@ -72,7 +71,7 @@ SYMBOL: alarm-thread
 
 : init-alarms ( -- )
     alarms global [ cancel-alarms <min-heap> ] change-at
-    [ alarm-thread-loop ] "Alarms" spawn
+    [ alarm-thread-loop t ] "Alarms" spawn-server
     alarm-thread set-global ;
 
 [ init-alarms ] "alarms" add-init-hook

extra/combinators/cleave/cleave-docs.factor

@@ -0,0 +1,82 @@
+
+USING: kernel quotations help.syntax help.markup ;
+
+IN: combinators.cleave
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ARTICLE: "cleave-combinators" "Cleave Combinators"
+
+{ $subsection bi  }
+{ $subsection tri }
+
+{ $notes
+  "From the Merriam-Webster Dictionary: "
+  $nl
+  { $strong "cleave" }
+  { $list
+    { $emphasis "To divide by or as if by a cutting blow" }
+    { $emphasis "To separate into distinct parts and especially into "
+                "groups having divergent views" } }
+  $nl
+  "The Joy programming language has a " { $emphasis "cleave" } " combinator." }
+
+;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+HELP: bi
+
+  { $values { "x" object }
+            { "p" quotation }
+            { "q" quotation }
+          
+            { "p(x)" "p applied to x" }
+            { "q(x)" "q applied to x" } } ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+HELP: tri
+
+  { $values { "x" object }
+            { "p" quotation }
+            { "q" quotation }
+            { "r" quotation }
+          
+            { "p(x)" "p applied to x" }
+            { "q(x)" "q applied to x" }
+            { "r(x)" "r applied to x" } } ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ARTICLE: "spread-combinators" "Spread Combinators"
+
+{ $subsection bi* }
+{ $subsection tri* } ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+HELP: bi*
+
+  { $values { "x" object }
+            { "y" object }
+            { "p" quotation }
+            { "q" quotation }
+          
+            { "p(x)" "p applied to x" }
+            { "q(y)" "q applied to y" } } ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+HELP: tri*
+
+  { $values { "x" object }
+            { "y" object }
+            { "z" object }
+            { "p" quotation }
+            { "q" quotation }
+            { "r" quotation }
+          
+            { "p(x)" "p applied to x" }
+            { "q(y)" "q applied to y" }
+            { "r(z)" "r applied to z" } } ;

extra/combinators/cleave/cleave.factor

@@ -7,10 +7,8 @@ IN: combinators.cleave
 ! The cleaver family
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: bi ( obj quot quot -- val val ) >r keep r> call ; inline
-
-: tri ( obj quot quot quot -- val val val )
-  >r pick >r bi r> r> call ; inline
+: bi  ( x p q   -- p(x) q(x)      ) >r keep r> call          ; inline
+: tri ( x p q r -- p(x) q(x) r(x) ) >r pick >r bi r> r> call ; inline
 
 : tetra ( obj quot quot quot quot -- val val val val )
   >r >r pick >r bi r> r> r> bi ; inline
@@ -39,9 +37,9 @@ MACRO: cleave ( seq -- )
 ! The spread family
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: bi* ( obj obj quot quot -- val val ) >r swap slip r> call ; inline
+: bi* ( x y p q -- p(x) q(y) ) >r swap slip r> call ; inline
 
-: tri* ( obj obj obj quot quot quot -- val val val )
+: tri* ( x y z p q r -- p(x) q(y) r(z) )
   >r rot >r bi* r> r> call ; inline
 
 : tetra* ( obj obj obj obj quot quot quot quot -- val val val val )

extra/db/postgresql/postgresql-tests.factor

@@ -7,7 +7,7 @@ db.tuples db.types unicode.case ;
 IN: db.postgresql.tests
 
 : test-db ( -- postgresql-db )
-    { "localhost" "postgres" "" "factor-test" } postgresql-db ;
+    { "localhost" "postgres" "foob" "factor-test" } postgresql-db ;
 
 [ ] [ test-db [ ] with-db ] unit-test
 

extra/db/tuples/tuples-tests.factor

@@ -186,7 +186,7 @@ TUPLE: annotation n paste-id summary author mode contents ;
     >r "tuples-test.db" temp-file sqlite-db r> with-db ;
 
 : test-postgresql ( -- )
->r { "localhost" "postgres" "" "factor-test" } postgresql-db r> with-db ;
+>r { "localhost" "postgres" "foob" "factor-test" } postgresql-db r> with-db ;
 
 [ native-person-schema test-tuples ] test-sqlite
 [ assigned-person-schema test-tuples ] test-sqlite

extra/farkup/farkup-tests.factor

@@ -43,6 +43,16 @@ IN: farkup.tests
 [ "<p><strong>foo</strong>\n</p><h1>aheading</h1>\n<p>adfasd</p>" ]
 [ "*foo*\n=aheading=\nadfasd" convert-farkup ] unit-test
 
-[ "<p>=foo\n</p>" ] [ "=foo\n" convert-farkup ] unit-test
 [ "<h1>foo</h1>\n" ] [ "=foo=\n" convert-farkup ] unit-test
 [ "<p>lol</p><h1>foo</h1>\n" ] [ "lol=foo=\n" convert-farkup ] unit-test
+[ "<p>=foo\n</p>" ] [ "=foo\n" convert-farkup ] unit-test
+[ "<p>=foo</p>" ] [ "=foo" convert-farkup ] unit-test
+[ "<p>==foo</p>" ] [ "==foo" convert-farkup ] unit-test
+[ "<p>=</p><h1>foo</h1>" ] [ "==foo=" convert-farkup ] unit-test
+[ "<h2>foo</h2>" ] [ "==foo==" convert-farkup ] unit-test
+[ "<h2>foo</h2>" ] [ "==foo==" convert-farkup ] unit-test
+[ "<p>=</p><h2>foo</h2>" ] [ "===foo==" convert-farkup ] unit-test
+
+
+[ "<h1>foo</h1><p>=</p>" ] [ "=foo==" convert-farkup ] unit-test
+

extra/farkup/farkup.factor

@@ -42,6 +42,15 @@ MEMO: h2 ( -- parser ) "==" "h2" delimited ;
 MEMO: h3 ( -- parser ) "===" "h3" delimited ;
 MEMO: h4 ( -- parser ) "====" "h4" delimited ;
 
+MEMO: eq ( -- parser )
+    [
+        h1 ensure-not ,
+        h2 ensure-not ,
+        h3 ensure-not ,
+        h4 ensure-not ,
+        "=" token ,
+    ] seq* ;
+
 : render-code ( string mode -- string' )
     >r string-lines r>
     [ [ htmlize-lines ] with-html-stream ] with-string-writer ;
@@ -105,7 +114,7 @@ MEMO: line ( -- parser )
     [
         text , strong , emphasis , link ,
         superscript , subscript , inline-code ,
-        escaped-char , delimiter ,
+        escaped-char , delimiter , eq ,
     ] choice* repeat1 ;
 
 MEMO: paragraph ( -- parser )

extra/help/handbook/handbook.factor

@@ -116,6 +116,7 @@ ARTICLE: "objects" "Objects"
 { $subsection "classes" }
 { $subsection "tuples" }
 { $subsection "generic" }
+{ $subsection "slots" }
 { $subsection "mirrors" } ;
 
 USE: random
@@ -235,7 +236,7 @@ ARTICLE: "program-org" "Program organization"
 USING: help.cookbook help.tutorial ;
 
 ARTICLE: "handbook" "Factor documentation"
-"Welcome to Factor. Factor is dynamically-typed, stack-based, and very expressive. It is one of the most powerful and flexible programming languages ever invented. Have fun with Factor!"
+"Welcome to Factor."
 { $heading "Starting points" }
 { $subsection "cookbook" }
 { $subsection "first-program" }
@@ -261,6 +262,7 @@ ARTICLE: "handbook" "Factor documentation"
 { $subsection "help" }
 { $subsection "inference" }
 { $subsection "compiler" }
+{ $subsection "layouts" }
 { $heading "User interface" }
 { $about "ui" }
 { $about "ui.tools" }

extra/help/help-docs.factor

@@ -344,7 +344,7 @@ HELP: $side-effects
 
 HELP: $notes
 { $values { "element" "a markup element" } }
-{ $description "Prints the errors subheading found on the help page of some words. This section should usage tips and pitfalls." } ;
+{ $description "Prints the notes subheading found on the help page of some words. This section should document usage tips and pitfalls." } ;
 
 HELP: $see
 { $values { "element" "a markup element of the form " { $snippet "{ word }" } } }

extra/locals/locals-tests.factor

@@ -116,6 +116,12 @@ write-test-2 "q" set
 
 [ ] [ 5 write-test-4 drop ] unit-test
 
+! Not really a write test; just enforcing consistency
+:: write-test-5 ( x -- y )
+    [wlet | fun! [ x + ] | 5 fun! ] ;
+
+[ 9 ] [ 4 write-test-5 ] unit-test
+
 SYMBOL: a
 
 :: use-test ( a b c -- a b c )
@@ -160,3 +166,15 @@ M:: string lambda-generic ( a b -- c ) a b lambda-generic-2 ;
 [ ] [ \ lambda-generic-2 see ] unit-test
 
 [ ] [ \ lambda-generic see ] unit-test
+
+[ "[let | a! [ ] | ]" ] [
+    [let | a! [ ] | ] unparse
+] unit-test
+
+[ "[wlet | a! [ ] | ]" ] [
+    [wlet | a! [ ] | ] unparse
+] unit-test
+
+[ "[| a! | ]" ] [
+    [| a! | ] unparse
+] unit-test

extra/locals/locals.factor

@@ -317,7 +317,7 @@ M: lambda pprint*
     \ | pprint-word
     t <inset
     <block
-    values [ <block >r pprint-word r> pprint* block> ] 2each
+    values [ <block >r pprint-var r> pprint* block> ] 2each
     block>
     \ | pprint-word
     <block pprint-elements block>
@@ -329,7 +329,7 @@ M: let pprint*
     \ ] pprint-word ;
 
 M: wlet pprint*
-    \ [let pprint-word
+    \ [wlet pprint-word
     { wlet-body wlet-vars wlet-bindings } get-slots pprint-let
     \ ] pprint-word ;
 

extra/math/constants/constants-docs.factor

@@ -1,4 +1,4 @@
-USING: help.markup help.syntax kernel layouts ;
+USING: help.markup help.syntax kernel ;
 IN: math.constants
 
 ARTICLE: "math-constants" "Constants"
@@ -7,9 +7,6 @@ ARTICLE: "math-constants" "Constants"
 { $subsection euler }
 { $subsection phi }
 { $subsection pi }
-"Various limits:"
-{ $subsection most-positive-fixnum }
-{ $subsection most-negative-fixnum }
 { $subsection epsilon } ;
 
 ABOUT: "math-constants"

extra/peg/parsers/parsers-docs.factor

@@ -1,9 +1,19 @@
-! Copyright (C) 2007 Chris Double.
+! Copyright (C) 2008 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: help.markup help.syntax peg peg.parsers.private
 unicode.categories ;
 IN: peg.parsers
 
+HELP: 1token
+{ $values
+    { "ch" "a character" }
+    { "parser" "a parser" }
+} { $description
+    "Calls 1string on a character and returns a parser that matches that character."
+} { $examples
+    { $example "USING: peg peg.parsers prettyprint ;" "\"a\" CHAR: a 1token parse parse-result-ast ." "\"a\"" }
+} { $see-also 'string' } ;
+
 HELP: (list-of)
 { $values
     { "items" "a sequence" }

extra/peg/parsers/parsers.factor

@@ -21,6 +21,8 @@ M: just-parser compile ( parser -- quot )
 MEMO: just ( parser -- parser )
   just-parser construct-boa init-parser ;
 
+MEMO: 1token ( ch -- parser ) 1string token ;
+
 <PRIVATE
 MEMO: (list-of) ( items separator repeat1? -- parser )
   >r over 2seq r> [ repeat1 ] [ repeat0 ] if [ concat ] action 2seq

extra/semantic-db/type/type.factor

@@ -1,48 +0,0 @@
-! Copyright (C) 2008 Alex Chapman
-! See http://factorcode.org/license.txt for BSD license.
-USING: arrays db db.types kernel semantic-db sequences sequences.lib ;
-IN: semantic-db.type
-
-! types:
-!  - have type 'type' in context 'semantic-db'
-!  - have a context in context 'semantic-db'
-
-: assign-type ( type nid -- arc-id )
-    has-type-relation spin arc-id ;
-
-: create-node-of-type ( type content -- node-id )
-    node-id [ assign-type drop ] keep ;
-
-: select-nodes-of-type ( type -- node-ids )
-    ":type" INTEGER param
-    has-type-relation ":has_type" INTEGER param 2array
-    "select a.subject from arc a where a.relation = :has_type and a.object = :type"
-    single-int-results ;
-
-: select-node-of-type ( type -- node-id )
-    select-nodes-of-type ?first ;
-
-: select-nodes-of-type-with-content ( type content -- node-ids )
-    ! find nodes with the given content that are the subjects of arcs with:
-    !     relation = has-type-relation
-    !     object = type
-    ":name" TEXT param
-    swap ":type" INTEGER param
-    has-type-relation ":has_type" INTEGER param 3array
-    "select n.id from node n, arc a where n.content = :name and n.id = a.subject and a.object = :type and a.relation = :has_type"
-    single-int-results ;
-
-: select-node-of-type-with-content ( type content -- node-id/f )
-    select-nodes-of-type-with-content ?first ;
-
-: ensure-node-of-type ( type content -- node-id )
-    [ select-node-of-type-with-content ] [ create-node-of-type ] ensure2 ;
-    ! 2dup select-node-of-type-with-content [ 2nip ] [ create-node-of-type ] if* ;
-
-
-: ensure-type ( type -- node-id )
-    dup "type" = [
-        drop type-type
-    ] [
-        type-type swap ensure-node-of-type
-    ] if ;

extra/serialize/serialize.factor

@@ -104,7 +104,7 @@ M: ratio (serialize) ( obj -- )
 M: string (serialize) ( obj -- )
     [ CHAR: s serialize-string ] serialize-shared ;
 
-: serialize-elements
+: serialize-elements ( seq -- )
     [ (serialize) ] each CHAR: . write1 ;
 
 M: tuple (serialize) ( obj -- )

extra/ui/ui.factor

@@ -148,7 +148,7 @@ SYMBOL: ui-thread
     \ ui-running get-global ;
 
 : update-ui-loop ( -- )
-    ui-running? ui-thread get-global self eq? [
+    ui-running? ui-thread get-global self eq? and [
         ui-notify-flag get lower-flag
         [ update-ui ] ui-try
         update-ui-loop

extra/unix/stat/linux/linux.factor

@@ -1,5 +1,5 @@
 
-USING: system combinators vocabs.loader ;
+USING: layouts combinators vocabs.loader ;
 
 IN: unix.stat