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

basis/alarms/alarms.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays calendar combinators generic init
-kernel math namespaces sequences heaps boxes threads debugger
+kernel math namespaces sequences heaps boxes threads
 quotations assocs math.order ;
 IN: alarms
 

basis/alien/prettyprint/prettyprint.factor

@@ -0,0 +1,14 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel combinators alien alien.strings alien.syntax
+prettyprint.backend prettyprint.custom prettyprint.sections ;
+IN: alien.prettyprint
+
+M: alien pprint*
+    {
+        { [ dup expired? ] [ drop \ BAD-ALIEN pprint-word ] }
+        { [ dup pinned-c-ptr? not ] [ drop "( displaced alien )" text ] }
+        [ \ ALIEN: [ alien-address pprint* ] pprint-prefix ]
+    } cond ;
+
+M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ;

basis/alien/strings/strings-docs.factor

@@ -31,10 +31,6 @@ HELP: string>symbol
 $nl
 "On Windows CE, symbols are represented as UCS2 strings, and on all other platforms they are ASCII strings." } ;
 
-HELP: utf16n
-{ $class-description "The encoding descriptor for UTF-16 without a byte order mark in native endian order. This is useful mostly for FFI calls which take input of strings of the type wchar_t*" }
-{ $see-also "encodings-introduction" } ;
-
 ARTICLE: "c-strings" "C strings"
 "C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
 $nl

basis/alien/strings/strings-tests.factor

@@ -1,6 +1,6 @@
 USING: alien.strings tools.test kernel libc
 io.encodings.8-bit io.encodings.utf8 io.encodings.utf16
-io.encodings.ascii alien io.encodings.string ;
+io.encodings.utf16n io.encodings.ascii alien io.encodings.string ;
 IN: alien.strings.tests
 
 [ "\u0000ff" ]

basis/alien/strings/strings.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays sequences kernel accessors math alien.accessors
 alien.c-types byte-arrays words io io.encodings
-io.streams.byte-array io.streams.memory io.encodings.utf8
+io.encodings.utf8 io.streams.byte-array io.streams.memory system
-io.encodings.utf16 system alien strings cpu.architecture fry ;
+alien strings cpu.architecture fry vocabs.loader combinators ;
 IN: alien.strings
 
 GENERIC# alien>string 1 ( c-ptr encoding -- string/f )
@@ -88,27 +88,22 @@ M: string-type c-type-getter
 M: string-type c-type-setter
     drop [ set-alien-cell ] ;
 
-! Native-order UTF-16
+HOOK: alien>native-string os ( alien -- string )
 
-SINGLETON: utf16n
+HOOK: native-string>alien os ( string -- alien )
-
-: utf16n ( -- descriptor )
-    little-endian? utf16le utf16be ? ; foldable
-
-M: utf16n <decoder> drop utf16n <decoder> ;
-
-M: utf16n <encoder> drop utf16n <encoder> ;
-
-: alien>native-string ( alien -- string )
-    os windows? [ utf16n ] [ utf8 ] if alien>string ;
 
 : dll-path ( dll -- string )
     path>> alien>native-string ;
 
 : string>symbol ( str -- alien )
-    [ os wince? [ utf16n ] [ utf8 ] if string>alien ]
+    dup string?
-    over string? [ call ] [ map ] if ;
+    [ native-string>alien ]
+    [ [ native-string>alien ] map ] if ;
 
 { "char*" utf8 } "char*" typedef
-{ "char*" utf16n } "wchar_t*" typedef
 "char*" "uchar*" typedef
+
+{
+    { [ os windows? ] [ "alien.strings.windows" require ] }
+    { [ os unix? ] [ "alien.strings.unix" require ] }
+} cond

basis/alien/strings/unix/unix.factor

@@ -0,0 +1,8 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.strings io.encodings.utf8 system ;
+IN: alien.strings.unix
+
+M: unix alien>native-string utf8 alien>string ;
+
+M: unix native-string>alien utf8 string>alien ;

basis/alien/strings/windows/windows.factor

@@ -0,0 +1,13 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.strings alien.c-types io.encodings.utf8
+io.encodings.utf16n system ;
+IN: alien.strings.windows
+
+M: windows alien>native-string utf16n alien>string ;
+
+M: wince native-string>alien utf16n string>alien ;
+
+M: winnt native-string>alien utf8 string>alien ;
+
+{ "char*" utf16n } "wchar_t*" typedef

basis/alien/syntax/syntax.factor

@@ -3,8 +3,7 @@
 USING: accessors arrays alien alien.c-types alien.structs
 alien.arrays alien.strings kernel math namespaces parser
 sequences words quotations math.parser splitting grouping
-effects prettyprint prettyprint.sections prettyprint.backend
+effects assocs combinators lexer strings.parser alien.parser ;
-assocs combinators lexer strings.parser alien.parser ;
 IN: alien.syntax
 
 : DLL" lexer get skip-blank parse-string dlopen parsed ; parsing
@@ -34,12 +33,3 @@ IN: alien.syntax
     dup length
     [ [ create-in ] dip 1quotation define ] 2each ;
     parsing
-
-M: alien pprint*
-    {
-        { [ dup expired? ] [ drop \ BAD-ALIEN pprint-word ] }
-        { [ dup pinned-c-ptr? not ] [ drop "( displaced alien )" text ] }
-        [ \ ALIEN: [ alien-address pprint* ] pprint-prefix ]
-    } cond ;
-
-M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ;

basis/bit-arrays/bit-arrays.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types accessors math alien.accessors kernel
 kernel.private locals sequences sequences.private byte-arrays
-parser prettyprint.backend fry ;
+parser prettyprint.custom fry ;
 IN: bit-arrays
 
 TUPLE: bit-array
@@ -73,11 +73,11 @@ M: bit-array byte-length length 7 + -3 shift ;
 :: integer>bit-array ( n -- bit-array ) 
     n zero? [ 0 <bit-array> ] [
         [let | out [ n log2 1+ <bit-array> ] i! [ 0 ] n'! [ n ] |
-            [ n' zero? not ] [
+            [ n' zero? ] [
                 n' out underlying>> i set-alien-unsigned-1
                 n' -8 shift n'!
                 i 1+ i!
-            ] [ ] while
+            ] [ ] until
             out
         ]
     ] if ;

basis/bit-vectors/bit-vectors.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel kernel.private math sequences
-sequences.private growable bit-arrays prettyprint.backend
+sequences.private growable bit-arrays prettyprint.custom
 parser accessors ;
 IN: bit-vectors
 

basis/bootstrap/bootstrap-error.factor

@@ -0,0 +1,8 @@
+USING: continuations kernel io debugger vocabs words system namespaces ;
+
+:c
+:error
+"listener" vocab
+[ restarts. vocab-main execute ]
+[ die ] if*
+1 exit

basis/bootstrap/compiler/compiler.factor

@@ -5,17 +5,22 @@ sequences namespaces parser kernel kernel.private classes
 classes.private arrays hashtables vectors classes.tuple sbufs
 hashtables.private sequences.private math classes.tuple.private
 growable namespaces.private assocs words command-line vocabs io
-io.encodings.string prettyprint libc splitting math.parser
+io.encodings.string libc splitting math.parser
 compiler.units math.order compiler.tree.builder
 compiler.tree.optimizer compiler.cfg.optimizer ;
 IN: bootstrap.compiler
 
 ! Don't bring this in when deploying, since it will store a
 ! reference to 'eval' in a global variable
-"deploy-vocab" get [
+"deploy-vocab" get "staging" get or [
     "alien.remote-control" require
 ] unless
 
+"prettyprint" vocab [
+    "stack-checker.errors.prettyprint" require
+    "alien.prettyprint" require
+] when
+
 "cpu." cpu name>> append require
 
 enable-compiler
@@ -86,7 +91,7 @@ nl
 "." write flush
 
 {
-    . malloc calloc free memcpy
+    malloc calloc free memcpy
 } compile-uncompiled
 
 "." write flush

basis/bootstrap/finish-bootstrap.factor

@@ -0,0 +1,16 @@
+USING: init command-line debugger system continuations
+namespaces eval kernel vocabs.loader io ;
+
+[
+    boot
+    do-init-hooks
+    [
+        (command-line) parse-command-line
+        load-vocab-roots
+        run-user-init
+        "e" get [ eval ] when*
+        ignore-cli-args? not script get and
+        [ run-script ] [ "run" get run ] if*
+        output-stream get [ stream-flush ] when*
+    ] [ print-error 1 exit ] recover
+] set-boot-quot

basis/bootstrap/finish-staging.factor

@@ -0,0 +1,10 @@
+USING: init command-line system namespaces kernel vocabs.loader
+io ;
+
+[
+    boot
+    do-init-hooks
+    (command-line) parse-command-line
+    "run" get run
+    output-stream get [ stream-flush ] when*
+] set-boot-quot

basis/bootstrap/math/math.factor

@@ -1,5 +1,7 @@
-USE: vocabs.loader
+USING: vocabs vocabs.loader kernel ;
 
 "math.ratios" require
 "math.floats" require
 "math.complex" require
+
+"prettyprint" vocab [ "math.complex.prettyprint" require ] when

basis/bootstrap/stage2.factor

@@ -2,10 +2,10 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors init namespaces words io
 kernel.private math memory continuations kernel io.files
-io.backend system parser vocabs sequences prettyprint
+io.backend system parser vocabs sequences
 vocabs.loader combinators splitting source-files strings
 definitions assocs compiler.errors compiler.units
-math.parser generic sets debugger command-line ;
+math.parser generic sets command-line ;
 IN: bootstrap.stage2
 
 SYMBOL: core-bootstrap-time
@@ -86,25 +86,18 @@ SYMBOL: bootstrap-time
     f error set-global
     f error-continuation set-global
 
+    millis swap - bootstrap-time set-global
+    print-report
+
     "deploy-vocab" get [
         "tools.deploy.shaker" run
     ] [
-        [
+        "staging" get [
-            boot
+            "resource:basis/bootstrap/finish-staging.factor" run-file
-            do-init-hooks
+        ] [
-            handle-command-line
+            "resource:basis/bootstrap/finish-bootstrap.factor" run-file
-        ] set-boot-quot
+        ] if
-
-        millis swap - bootstrap-time set-global
-        print-report
 
         "output-image" get save-image-and-exit
     ] if
-] [
+] [ drop "resource:basis/bootstrap/bootstrap-error.factor" run-file ] recover
-    :c
-    dup print-error flush
-    "listener" vocab
-    [ restarts. vocab-main execute ]
-    [ die ] if*
-    1 exit
-] recover

basis/bootstrap/threads/threads.factor

@@ -1,7 +1,11 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
+USING: vocabs vocabs.loader kernel ;
 IN: bootstrap.threads
 
 USE: io.thread
 USE: threads
-USE: debugger.threads
+
+"debugger" vocab [
+    "debugger.threads" require
+] when

basis/byte-vectors/byte-vectors.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel kernel.private math sequences
-sequences.private growable byte-arrays accessors ;
+sequences.private growable byte-arrays accessors parser
+prettyprint.custom ;
 IN: byte-vectors
 
 TUPLE: byte-vector
@@ -41,4 +42,10 @@ M: byte-array like
 
 M: byte-array new-resizable drop <byte-vector> ;
 
+: BV{ \ } [ >byte-vector ] parse-literal ; parsing
+
+M: byte-vector pprint* pprint-object ;
+M: byte-vector pprint-delims drop \ BV{ \ } ;
+M: byte-vector >pprint-sequence ;
+
 INSTANCE: byte-vector growable

basis/calendar/format/format.factor

@@ -1,7 +1,8 @@
-USING: math math.order math.parser math.functions kernel sequences io
+! Copyright (C) 2008 Slava Pestov.
-accessors arrays io.streams.string splitting
+! See http://factorcode.org/license.txt for BSD license.
-combinators accessors debugger
+USING: math math.order math.parser math.functions kernel
-calendar calendar.format.macros ;
+sequences io accessors arrays io.streams.string splitting
+combinators accessors calendar calendar.format.macros present ;
 IN: calendar.format
 
 : pad-00 ( n -- str ) number>string 2 CHAR: 0 pad-left ;
@@ -288,3 +289,5 @@ ERROR: invalid-timestamp-format ;
             ]
         } formatted
     ] with-string-writer ;
+
+M: timestamp present timestamp>string ;

basis/checksums/md5/md5.factor

@@ -4,7 +4,7 @@ USING: kernel io io.binary io.files io.streams.byte-array math
 math.functions math.parser namespaces splitting grouping strings
 sequences byte-arrays locals sequences.private
 io.encodings.binary symbols math.bitwise checksums
-checksums.common ;
+checksums.common checksums.stream ;
 IN: checksums.md5
 
 ! See http://www.faqs.org/rfcs/rfc1321.html
@@ -180,7 +180,7 @@ PRIVATE>
 
 SINGLETON: md5
 
-INSTANCE: md5 checksum
+INSTANCE: md5 stream-checksum
 
 M: md5 checksum-stream ( stream -- byte-array )
     drop [ initialize-md5 stream>md5 get-md5 ] with-input-stream ;

basis/checksums/openssl/openssl.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors byte-arrays alien.c-types kernel continuations
-destructors sequences io openssl openssl.libcrypto checksums ;
+destructors sequences io openssl openssl.libcrypto checksums
+checksums.stream ;
 IN: checksums.openssl
 
 ERROR: unknown-digest name ;
@@ -12,7 +13,7 @@ TUPLE: openssl-checksum name ;
 
 : openssl-sha1 T{ openssl-checksum f "sha1" } ;
 
-INSTANCE: openssl-checksum checksum
+INSTANCE: openssl-checksum stream-checksum
 
 C: <openssl-checksum> openssl-checksum
 

basis/checksums/sha1/sha1.factor

@@ -3,7 +3,8 @@
 USING: arrays combinators kernel io io.encodings.binary io.files
 io.streams.byte-array math.vectors strings sequences namespaces
 make math parser sequences assocs grouping vectors io.binary
-hashtables symbols math.bitwise checksums checksums.common ;
+hashtables symbols math.bitwise checksums checksums.common
+checksums.stream ;
 IN: checksums.sha1
 
 ! Implemented according to RFC 3174.
@@ -113,7 +114,7 @@ SYMBOLS: h0 h1 h2 h3 h4 A B C D E w K ;
 
 SINGLETON: sha1
 
-INSTANCE: sha1 checksum
+INSTANCE: sha1 stream-checksum
 
 M: sha1 checksum-stream ( stream -- sha1 )
     drop [ initialize-sha1 stream>sha1 get-sha1 ] with-input-stream ;

basis/checksums/stream/stream.factor

@@ -0,0 +1,12 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.binary io.streams.byte-array kernel
+checksums ;
+IN: checksums.stream
+
+MIXIN: stream-checksum
+
+M: stream-checksum checksum-bytes
+    [ binary <byte-reader> ] dip checksum-stream ;
+
+INSTANCE: stream-checksum checksum

basis/cocoa/application/application.factor

@@ -1,9 +1,9 @@
-! Copyright (C) 2006, 2007 Slava Pestov
+! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.syntax io kernel namespaces core-foundation
 core-foundation.run-loop cocoa.messages cocoa cocoa.classes
-cocoa.runtime sequences threads debugger init summary
+cocoa.runtime sequences threads init summary kernel.private
-kernel.private assocs ;
+assocs ;
 IN: cocoa.application
 
 : <NSString> ( str -- alien ) <CFString> -> autorelease ;

basis/cocoa/messages/messages.factor

@@ -2,21 +2,17 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types alien.strings arrays assocs
 continuations combinators compiler compiler.alien kernel math
-namespaces make parser prettyprint prettyprint.sections
+namespaces make parser quotations sequences strings words
-quotations sequences strings words cocoa.runtime io macros
+cocoa.runtime io macros memoize io.encodings.utf8
-memoize debugger io.encodings.ascii effects libc libc.private
+effects libc libc.private parser lexer init core-foundation fry
-parser lexer init core-foundation fry generalizations
+generalizations specialized-arrays.direct.alien ;
-specialized-arrays.direct.alien ;
 IN: cocoa.messages
 
 : make-sender ( method function -- quot )
     [ over first , f , , second , \ alien-invoke , ] [ ] make ;
 
-: sender-stub-name ( method function -- string )
-    [ % "_" % unparse % ] "" make ;
-
 : sender-stub ( method function -- word )
-    [ sender-stub-name f <word> dup ] 2keep
+    [ "( sender-stub )" f <word> dup ] 2dip
     over first large-struct? [ "_stret" append ] when
     make-sender define ;
 
@@ -78,12 +74,8 @@ MACRO: (send) ( selector super? -- quot )
 
 : send ( receiver args... selector -- return... ) f (send) ; inline
 
-\ send soft "break-after" set-word-prop
-
 : super-send ( receiver args... selector -- return... ) t (send) ; inline
 
-\ super-send soft "break-after" set-word-prop
-
 ! Runtime introspection
 SYMBOL: class-init-hooks
 
@@ -188,7 +180,7 @@ assoc-union alien>objc-types set-global
 
 : method-arg-type ( method i -- type )
     method_copyArgumentType
-    [ ascii alien>string parse-objc-type ] keep
+    [ utf8 alien>string parse-objc-type ] keep
     (free) ;
 
 : method-arg-types ( method -- args )
@@ -197,7 +189,7 @@ assoc-union alien>objc-types set-global
 
 : method-return-type ( method -- ctype )
     method_copyReturnType
-    [ ascii alien>string parse-objc-type ] keep
+    [ utf8 alien>string parse-objc-type ] keep
     (free) ;
 
 : register-objc-method ( method -- )
@@ -216,17 +208,6 @@ assoc-union alien>objc-types set-global
 : register-objc-methods ( class -- )
     [ register-objc-method ] each-method-in-class ;
 
-: method. ( method -- )
-    {
-        [ method_getName sel_getName ]
-        [ method-return-type ]
-        [ method-arg-types ]
-        [ method_getImplementation ]
-    } cleave 4array . ;
-
-: methods. ( class -- )
-    [ method. ] each-method-in-class ;
-
 : class-exists? ( string -- class ) objc_getClass >boolean ;
 
 : define-objc-class-word ( quot name -- )
@@ -238,11 +219,8 @@ assoc-union alien>objc-types set-global
 
 : import-objc-class ( name quot -- )
     over define-objc-class-word
-    '[
+    [ objc-class register-objc-methods ]
-        _
+    [ objc-meta-class register-objc-methods ] bi ;
-        [ objc-class register-objc-methods ]
-        [ objc-meta-class register-objc-methods ] bi
-    ] try ;
 
 : root-class ( class -- root )
     dup class_getSuperclass [ root-class ] [ ] ?if ;

basis/cocoa/subclassing/subclassing.factor

@@ -3,12 +3,12 @@
 USING: alien alien.c-types alien.strings arrays assocs
 combinators compiler hashtables kernel libc math namespaces
 parser sequences words cocoa.messages cocoa.runtime locals
-compiler.units io.encodings.ascii continuations make fry ;
+compiler.units io.encodings.utf8 continuations make fry ;
 IN: cocoa.subclassing
 
 : init-method ( method -- sel imp types )
     first3 swap
-    [ sel_registerName ] [ execute ] [ ascii string>alien ]
+    [ sel_registerName ] [ execute ] [ utf8 string>alien ]
     tri* ;
 
 : throw-if-false ( obj what -- )

basis/command-line/command-line.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: init continuations debugger hashtables io
+USING: init continuations hashtables io io.encodings.utf8
-io.encodings.utf8 io.files kernel kernel.private namespaces
+io.files kernel kernel.private namespaces parser sequences
-parser sequences strings system splitting eval vocabs.loader ;
+strings system splitting vocabs.loader ;
 IN: command-line
 
 SYMBOL: script
@@ -31,8 +31,6 @@ SYMBOL: command-line
         ] [ drop ] if
     ] when ;
 
-<PRIVATE
-
 : var-param ( name value -- ) swap set-global ;
 
 : bool-param ( name -- ) "no-" ?head not var-param ;
@@ -43,8 +41,6 @@ SYMBOL: command-line
 : run-script ( file -- )
     t "quiet" set-global run-file ;
 
-PRIVATE>
-
 : parse-command-line ( args -- )
     [ command-line off script off ] [
         unclip "-" ?head
@@ -76,15 +72,4 @@ SYMBOL: main-vocab-hook
 
 : script-mode ( -- ) ;
 
-: handle-command-line ( -- )
-    [
-        (command-line) parse-command-line
-        load-vocab-roots
-        run-user-init
-        "e" get [ eval ] when*
-        ignore-cli-args? not script get and
-        [ run-script ] [ "run" get run ] if*
-        output-stream get [ stream-flush ] when*
-    ] [ print-error 1 exit ] recover ;
-
 [ default-cli-args ] "command-line" add-init-hook

basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor

@@ -1,6 +1,6 @@
 USING: compiler.cfg.instructions compiler.cfg.registers
-compiler.cfg.alias-analysis cpu.architecture tools.test
+compiler.cfg.alias-analysis compiler.cfg.debugger
-kernel ;
+cpu.architecture tools.test kernel ;
 IN: compiler.cfg.alias-analysis.tests
 
 [ ] [

basis/compiler/cfg/dead-code/dead-code-tests.factor

@@ -1,5 +1,6 @@
 USING: compiler.cfg.dead-code compiler.cfg.instructions
-compiler.cfg.registers cpu.architecture tools.test ;
+compiler.cfg.registers compiler.cfg.debugger
+cpu.architecture tools.test ;
 IN: compiler.cfg.dead-code.tests
 
 [ { } ] [

basis/compiler/cfg/debugger/debugger.factor

@@ -2,10 +2,12 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel words sequences quotations namespaces io
 classes.tuple accessors prettyprint prettyprint.config
-compiler.tree.builder compiler.tree.optimizer
+prettyprint.backend prettyprint.custom prettyprint.sections
+parser compiler.tree.builder compiler.tree.optimizer
 compiler.cfg.builder compiler.cfg.linearization
-compiler.cfg.stack-frame compiler.cfg.linear-scan
+compiler.cfg.registers compiler.cfg.stack-frame
-compiler.cfg.two-operand compiler.cfg.optimizer ;
+compiler.cfg.linear-scan compiler.cfg.two-operand
+compiler.cfg.optimizer ;
 IN: compiler.cfg.debugger
 
 GENERIC: test-cfg ( quot -- cfgs )
@@ -40,3 +42,15 @@ SYMBOL: allocate-registers?
         instructions>> [ insn. ] each
         nl
     ] each ;
+
+! Prettyprinting
+M: vreg pprint*
+    <block
+    \ V pprint-word [ reg-class>> pprint* ] [ n>> pprint* ] bi
+    block> ;
+
+: pprint-loc ( loc word -- ) <block pprint-word n>> pprint* block> ;
+
+M: ds-loc pprint* \ D pprint-loc ;
+
+M: rs-loc pprint* \ R pprint-loc ;

basis/compiler/cfg/registers/registers.factor

@@ -1,7 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors namespaces kernel arrays
+USING: accessors namespaces kernel arrays parser ;
-parser prettyprint.backend prettyprint.sections ;
 IN: compiler.cfg.registers
 
 ! Virtual registers, used by CFG and machine IRs
@@ -18,20 +17,6 @@ C: <ds-loc> ds-loc
 TUPLE: rs-loc < loc ;
 C: <rs-loc> rs-loc
 
-! Prettyprinting
 : V scan-word scan-word vreg boa parsed ; parsing
-
-M: vreg pprint*
-    <block
-    \ V pprint-word [ reg-class>> pprint* ] [ n>> pprint* ] bi
-    block> ;
-
-: pprint-loc ( loc word -- ) <block pprint-word n>> pprint* block> ;
-
 : D scan-word <ds-loc> parsed ; parsing
-
-M: ds-loc pprint* \ D pprint-loc ;
-
 : R scan-word <rs-loc> parsed ; parsing
-
-M: rs-loc pprint* \ R pprint-loc ;

basis/compiler/cfg/value-numbering/value-numbering-tests.factor

@@ -1,7 +1,8 @@
 IN: compiler.cfg.value-numbering.tests
 USING: compiler.cfg.value-numbering compiler.cfg.instructions
-compiler.cfg.registers cpu.architecture tools.test kernel math
+compiler.cfg.registers compiler.cfg.debugger cpu.architecture
-combinators.short-circuit accessors sequences ;
+tools.test kernel math combinators.short-circuit accessors
+sequences ;
 
 : trim-temps ( insns -- insns )
     [

basis/compiler/cfg/write-barrier/write-barrier-tests.factor

@@ -1,5 +1,6 @@
 USING: compiler.cfg.write-barrier compiler.cfg.instructions
-compiler.cfg.registers cpu.architecture arrays tools.test ;
+compiler.cfg.registers compiler.cfg.debugger cpu.architecture
+arrays tools.test ;
 IN: compiler.cfg.write-barrier.tests
 
 [

basis/compiler/codegen/fixup/fixup.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays byte-arrays generic assocs hashtables io.binary
+USING: arrays byte-arrays byte-vectors generic assocs hashtables
-kernel kernel.private math namespaces make sequences words
+io.binary kernel kernel.private math namespaces make sequences
-quotations strings alien.accessors alien.strings layouts system
+words quotations strings alien.accessors alien.strings layouts
-combinators math.bitwise words.private math.order accessors
+system combinators math.bitwise words.private math.order
-growable cpu.architecture compiler.constants ;
+accessors growable cpu.architecture compiler.constants ;
 IN: compiler.codegen.fixup
 
 GENERIC: fixup* ( obj -- )

basis/compiler/compiler.factor

@@ -1,15 +1,14 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel namespaces arrays sequences io debugger
+USING: accessors kernel namespaces arrays sequences io
-words fry continuations vocabs assocs dlists definitions
+words fry continuations vocabs assocs dlists definitions math
-math threads graphs generic combinators deques search-deques
+threads graphs generic combinators deques search-deques io
-prettyprint io stack-checker stack-checker.state
+stack-checker stack-checker.state stack-checker.inlining
-stack-checker.inlining compiler.errors compiler.units
+compiler.errors compiler.units compiler.tree.builder
-compiler.tree.builder compiler.tree.optimizer
+compiler.tree.optimizer compiler.cfg.builder
-compiler.cfg.builder compiler.cfg.optimizer
+compiler.cfg.optimizer compiler.cfg.linearization
-compiler.cfg.linearization compiler.cfg.two-operand
+compiler.cfg.two-operand compiler.cfg.linear-scan
-compiler.cfg.linear-scan compiler.cfg.stack-frame
+compiler.cfg.stack-frame compiler.codegen ;
-compiler.codegen ;
 IN: compiler
 
 SYMBOL: compile-queue
@@ -45,7 +44,7 @@ SYMBOL: +failed+
     2bi ;
 
 : start ( word -- )
-    "trace-compilation" get [ dup . flush ] when
+    "trace-compilation" get [ dup name>> print flush ] when
     H{ } clone dependencies set
     H{ } clone generic-dependencies set
     f swap compiler-error ;

basis/compiler/tree/dead-code/recursive/recursive.factor

@@ -22,14 +22,11 @@ M: #call-recursive compute-live-values*
     [ out-d>> ] [ label>> return>> in-d>> ] bi look-at-mapping ;
 
 :: drop-dead-inputs ( inputs outputs -- #shuffle )
-    [let* | live-inputs [ inputs filter-live ]
+    inputs filter-live
-            new-live-inputs [ outputs inputs filter-corresponding make-values ] |
+    outputs inputs filter-corresponding make-values
-        live-inputs
+    outputs
-        new-live-inputs
+    inputs
-        outputs
+    drop-values ;
-        inputs
-        drop-values
-    ] ;
 
 M: #enter-recursive remove-dead-code*
     [ filter-live ] change-out-d ;
@@ -79,12 +76,12 @@ M: #call-recursive remove-dead-code*
         bi
     ] ;
 
-M:: #recursive remove-dead-code* ( node -- nodes )
+M: #recursive remove-dead-code* ( node -- nodes )
-    [let* | drop-inputs [ node drop-recursive-inputs ]
+    [ drop-recursive-inputs ]
-            drop-outputs [ node drop-recursive-outputs ] |
+    [
-         node [ (remove-dead-code) ] change-child drop
+        [ (remove-dead-code) ] change-child
-         node label>> [ filter-live ] change-enter-out drop
+        dup label>> [ filter-live ] change-enter-out drop
-         { drop-inputs node drop-outputs }
+    ]
-    ] ;
+    [ drop-recursive-outputs ] tri 3array ;
 
 M: #return-recursive remove-dead-code* ;

basis/compiler/tree/debugger/debugger.factor

@@ -2,8 +2,9 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel assocs match fry accessors namespaces make effects
 sequences sequences.private quotations generic macros arrays
-prettyprint prettyprint.backend prettyprint.sections math words
+prettyprint prettyprint.backend prettyprint.custom
-combinators combinators.short-circuit io sorting hints qualified
+prettyprint.sections math words combinators
+combinators.short-circuit io sorting hints qualified
 compiler.tree
 compiler.tree.recursive
 compiler.tree.normalization

basis/compiler/tree/propagation/inlining/inlining.factor

@@ -48,9 +48,11 @@ M: callable splicing-nodes
     ] [ 2drop f >>method f >>body f >>class drop f ] if ;
 
 : inlining-standard-method ( #call word -- class/f method/f )
-    [ in-d>> <reversed> ] [ [ dispatch# ] keep ] bi*
+    dup "methods" word-prop assoc-empty? [ 2drop f f ] [
-    [ swap nth value-info class>> dup ] dip
+        [ in-d>> <reversed> ] [ [ dispatch# ] keep ] bi*
-    specific-method ;
+        [ swap nth value-info class>> dup ] dip
+        specific-method
+    ] if ;
 
 : inline-standard-method ( #call word -- ? )
     dupd inlining-standard-method eliminate-dispatch ;

basis/concurrency/combinators/combinators.factor

@@ -22,7 +22,7 @@ PRIVATE>
     ] (parallel-each) ; inline
 
 : parallel-filter ( seq quot -- newseq )
-    over [ pusher [ each ] dip ] dip like ; inline
+    over [ pusher [ parallel-each ] dip ] dip like ; inline
 
 <PRIVATE
 

basis/core-foundation/core-foundation-tests.factor

@@ -0,0 +1,9 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: core-foundation tools.test kernel ;
+IN: core-foundation
+
+[ ] [ "Hello" <CFString> CFRelease ] unit-test
+[ "Hello" ] [ "Hello" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
+[ "Hello\u003456" ] [ "Hello\u003456" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
+[ "Hello\u013456" ] [ "Hello\u013456" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test

basis/core-foundation/core-foundation.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings alien.syntax kernel
-math sequences io.encodings.utf16 destructors accessors combinators ;
+math sequences io.encodings.utf8 destructors accessors
+combinators byte-arrays ;
 IN: core-foundation
 
 TYPEDEF: void* CFAllocatorRef
@@ -69,12 +70,53 @@ FUNCTION: CFURLRef CFURLCreateWithString ( CFAllocatorRef allocator, CFStringRef
 
 FUNCTION: CFURLRef CFURLCopyFileSystemPath ( CFURLRef url, int pathStyle ) ;
 
-FUNCTION: CFStringRef CFStringCreateWithCharacters ( CFAllocatorRef allocator, wchar_t* cStr, CFIndex numChars ) ;
+TYPEDEF: int CFStringEncoding
+: kCFStringEncodingMacRoman HEX: 0 ;
+: kCFStringEncodingWindowsLatin1 HEX: 0500 ;
+: kCFStringEncodingISOLatin1 HEX: 0201 ;
+: kCFStringEncodingNextStepLatin HEX: 0B01 ;
+: kCFStringEncodingASCII HEX: 0600 ;
+: kCFStringEncodingUnicode HEX: 0100 ;
+: kCFStringEncodingUTF8 HEX: 08000100 ;
+: kCFStringEncodingNonLossyASCII HEX: 0BFF ;
+: kCFStringEncodingUTF16 HEX: 0100 ;
+: kCFStringEncodingUTF16BE HEX: 10000100 ;
+: kCFStringEncodingUTF16LE HEX: 14000100 ;
+: kCFStringEncodingUTF32 HEX: 0c000100 ;
+: kCFStringEncodingUTF32BE HEX: 18000100 ;
+: kCFStringEncodingUTF32LE HEX: 1c000100 ;
+
+FUNCTION: CFStringRef CFStringCreateFromExternalRepresentation (
+   CFAllocatorRef alloc,
+   CFDataRef data,
+   CFStringEncoding encoding
+) ;
+
+FUNCTION: CFStringRef CFStringCreateWithBytes (
+   CFAllocatorRef alloc,
+   UInt8* bytes,
+   CFIndex numBytes,
+   CFStringEncoding encoding,
+   Boolean isExternalRepresentation
+) ;
 
 FUNCTION: CFIndex CFStringGetLength ( CFStringRef theString ) ;
 
 FUNCTION: void CFStringGetCharacters ( void* theString, CFIndex start, CFIndex length, void* buffer ) ;
 
+FUNCTION: Boolean CFStringGetCString (
+   CFStringRef theString,
+   char* buffer,
+   CFIndex bufferSize,
+   CFStringEncoding encoding
+) ;
+
+FUNCTION: CFStringRef CFStringCreateWithCString (
+   CFAllocatorRef alloc,
+   char* cStr,
+   CFStringEncoding encoding
+) ;
+
 FUNCTION: CFNumberRef CFNumberCreate ( CFAllocatorRef allocator, CFNumberType theType, void* valuePtr ) ;
 
 FUNCTION: CFDataRef CFDataCreate ( CFAllocatorRef allocator, uchar* bytes, CFIndex length ) ;
@@ -97,12 +139,16 @@ FUNCTION: CFTypeID CFGetTypeID ( CFTypeRef cf ) ;
     [ [ dupd ] dip CFArraySetValueAtIndex ] 2each ;
 
 : <CFString> ( string -- alien )
-    f swap dup length CFStringCreateWithCharacters ;
+    f swap utf8 string>alien kCFStringEncodingUTF8 CFStringCreateWithCString
+    [ "CFStringCreateWithCString failed" throw ] unless* ;
 
 : CF>string ( alien -- string )
-    dup CFStringGetLength 1+ "ushort" <c-array> [
+    dup CFStringGetLength 4 * 1 + <byte-array> [
-        [ 0 over CFStringGetLength ] dip CFStringGetCharacters
+        dup length
-    ] keep utf16n alien>string ;
+        kCFStringEncodingUTF8
+        CFStringGetCString
+        [ "CFStringGetCString failed" throw ] unless
+    ] keep utf8 alien>string ;
 
 : CF>string-array ( alien -- seq )
     CF>array [ CF>string ] map ;

basis/core-foundation/run-loop/run-loop.factor

@@ -1,7 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel threads init namespaces alien
+USING: alien alien.syntax core-foundation kernel namespaces ;
-core-foundation calendar ;
 IN: core-foundation.run-loop
 
 : kCFRunLoopRunFinished 1 ; inline
@@ -40,11 +39,3 @@ FUNCTION: void CFRunLoopAddSource (
         "kCFRunLoopDefaultMode" <CFString>
         dup \ CFRunLoopDefaultMode set-global
     ] when ;
-
-: run-loop-thread ( -- )
-    CFRunLoopDefaultMode 0 f CFRunLoopRunInMode
-    kCFRunLoopRunHandledSource = [ 1 seconds sleep ] unless
-    run-loop-thread ;
-
-: start-run-loop-thread ( -- )
-    [ run-loop-thread t ] "CFRunLoop dispatcher" spawn-server drop ;

basis/core-foundation/run-loop/thread/thread.factor

@@ -1,8 +1,16 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: init core-foundation.run-loop ;
+USING: calendar core-foundation.run-loop init kernel threads ;
 IN: core-foundation.run-loop.thread
 
 ! Load this vocabulary if you need a run loop running.
 
+: run-loop-thread ( -- )
+    CFRunLoopDefaultMode 0 f CFRunLoopRunInMode
+    kCFRunLoopRunHandledSource = [ 1 seconds sleep ] unless
+    run-loop-thread ;
+
+: start-run-loop-thread ( -- )
+    [ run-loop-thread t ] "CFRunLoop dispatcher" spawn-server drop ;
+
 [ start-run-loop-thread ] "core-foundation.run-loop.thread" add-init-hook

basis/cpu/x86/assembler/assembler.factor

@@ -346,7 +346,7 @@ M: label JUMPcc (JUMPcc) label-fixup ;
 : LEAVE ( -- ) HEX: c9 , ;
 
 : RET ( n -- )
-    dup zero? [ drop HEX: c3 , ] [ HEX: C2 , 2, ] if ;
+    dup zero? [ drop HEX: c3 , ] [ HEX: c2 , 2, ] if ;
 
 ! Arithmetic
 

basis/debugger/debugger.factor

@@ -22,9 +22,6 @@ M: tuple error-help class ;
 
 M: string error. print ;
 
-: :error ( -- )
-    error get error. ;
-
 : :s ( -- )
     error-continuation get data>> stack. ;
 
@@ -63,6 +60,9 @@ M: string error. print ;
     [ global [ "Error in print-error!" print drop ] bind ]
     recover ;
 
+: :error ( -- )
+    error get print-error ;
+
 : print-error-and-restarts ( error -- )
     print-error
     restarts.

basis/delegate/delegate.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors parser generic kernel classes classes.tuple
 words slots assocs sequences arrays vectors definitions
-prettyprint math hashtables sets generalizations namespaces make ;
+math hashtables sets generalizations namespaces make ;
 IN: delegate
 
 : protocol-words ( protocol -- words )
@@ -100,6 +100,4 @@ M: protocol definition protocol-words show-words ;
 
 M: protocol definer drop \ PROTOCOL: \ ; ;
 
-M: protocol synopsis* word-synopsis ; ! Necessary?
-
 M: protocol group-words protocol-words ;

basis/delegate/protocols/protocols.factor

@@ -1,8 +1,7 @@
 ! Copyright (C) 2007 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: delegate sequences.private sequences assocs
-prettyprint.sections io definitions kernel continuations
+io definitions kernel continuations ;
-listener ;
 IN: delegate.protocols
 
 PROTOCOL: sequence-protocol
@@ -16,7 +15,7 @@ PROTOCOL: assoc-protocol
 
 PROTOCOL: input-stream-protocol
     stream-read1 stream-read stream-read-partial stream-readln
-    stream-read-until stream-read-quot ;
+    stream-read-until ;
 
 PROTOCOL: output-stream-protocol
     stream-flush stream-write1 stream-write stream-format

basis/environment/winnt/winnt.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.strings fry io.encodings.utf16 kernel
+USING: alien.strings fry io.encodings.utf16n kernel
 splitting windows windows.kernel32 system environment
 alien.c-types sequences windows.errors io.streams.memory
 io.encodings io ;

basis/functors/functors.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel locals.private quotations classes.tuple make
+USING: kernel quotations classes.tuple make combinators generic
-combinators generic words interpolate namespaces sequences
+words interpolate namespaces sequences io.streams.string fry
-io.streams.string fry classes.mixin effects lexer parser
+classes.mixin effects lexer parser classes.tuple.parser
-classes.tuple.parser effects.parser ;
+effects.parser locals.types locals.parser locals.rewrite.closures ;
 IN: functors
 
 : scan-param ( -- obj )
@@ -99,8 +99,8 @@ DEFER: ;FUNCTOR delimiter
 
 : (FUNCTOR:) ( -- word def )
     CREATE
-    parse-locals
+    parse-locals dup push-locals
     parse-functor-body swap pop-locals <lambda>
-    lambda-rewrite first ;
+    rewrite-closures first ;
 
 : FUNCTOR: (FUNCTOR:) define ; parsing

basis/generalizations/generalizations-docs.factor

@@ -1,5 +1,5 @@
 USING: help.syntax help.markup kernel sequences quotations
-math arrays ;
+math arrays combinators ;
 IN: generalizations
 
 HELP: nsequence
@@ -234,6 +234,18 @@ HELP: napply
     }
 } ;
 
+HELP: ncleave
+{ $values { "quots" "a sequence of quotations" } { "n" integer } }
+{ $description "A generalization of " { $link cleave } " and " { $link 2cleave } " that can work for any quotation arity."
+} 
+{ $examples
+  "Some core words expressed in terms of " { $link ncleave } ":"
+    { $table
+        { { $link cleave } { $snippet "1 ncleave" } }
+        { { $link 2cleave } { $snippet "2 ncleave" } }
+    }
+} ;
+
 HELP: mnswap
 { $values { "m" integer } { "n" integer } }
 { $description "Swaps the top " { $snippet "m" } " stack elements with the " { $snippet "n" } " elements directly underneath." }
@@ -269,6 +281,7 @@ $nl
 { $subsection nslip }
 { $subsection nkeep }
 { $subsection napply }
+{ $subsection ncleave }
 "Generalized quotation construction:"
 { $subsection ncurry } 
 { $subsection nwith } ;

basis/generalizations/generalizations.factor

@@ -69,6 +69,10 @@ MACRO: ncurry ( n -- )
 MACRO: nwith ( n -- )
     [ with ] n*quot ;
 
+MACRO: ncleave ( quots n -- )
+    [ '[ _ '[ _ _ nkeep ] ] map [ ] join ] [ '[ _ ndrop ] ] bi
+    compose ;
+
 MACRO: napply ( n -- )
     2 [a,b]
     [ [ 1- ] [ ] bi '[ _ ntuck _ nslip ] ]

basis/help/definitions/definitions.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors definitions help help.topics help.syntax
-prettyprint.backend prettyprint words kernel effects ;
+prettyprint.backend prettyprint.custom prettyprint words kernel
+effects ;
 IN: help.definitions
 
 ! Definition protocol implementation

basis/help/handbook/handbook.factor

@@ -1,7 +1,7 @@
 USING: help help.markup help.syntax help.definitions help.topics
 namespaces words sequences classes assocs vocabs kernel arrays
-prettyprint.backend kernel.private io generic math system
+prettyprint.backend prettyprint.custom kernel.private io generic
-strings sbufs vectors byte-arrays quotations
+math system strings sbufs vectors byte-arrays quotations
 io.streams.byte-array classes.builtin parser lexer
 classes.predicate classes.union classes.intersection
 classes.singleton classes.tuple tools.vocabs.browser math.parser

basis/help/lint/lint.factor

@@ -150,7 +150,7 @@ M: help-error error.
     ] [
         [
             swap vocab-heading.
-            [ error. nl ] each
+            [ print-error nl ] each
         ] assoc-each
     ] if-empty ;
 

basis/http/client/client.factor

@@ -3,14 +3,14 @@
 USING: accessors assocs kernel math math.parser namespaces make
 sequences io io.sockets io.streams.string io.files io.timeouts
 strings splitting calendar continuations accessors vectors
-math.order hashtables byte-arrays prettyprint destructors
+math.order hashtables byte-arrays destructors
 io.encodings
 io.encodings.string
 io.encodings.ascii
 io.encodings.8-bit
 io.encodings.binary
 io.streams.duplex
-fry debugger summary ascii urls urls.encoding present
+fry ascii urls urls.encoding present
 http http.parsers ;
 IN: http.client
 
@@ -84,10 +84,6 @@ M: f >post-data ;
 
 ERROR: too-many-redirects ;
 
-M: too-many-redirects summary
-    drop
-    [ "Redirection limit of " % max-redirects # " exceeded" % ] "" make ;
-
 <PRIVATE
 
 DEFER: (with-http-request)
@@ -161,10 +157,6 @@ PRIVATE>
 
 ERROR: download-failed response ;
 
-M: download-failed error.
-    "HTTP request failed:" print nl
-    response>> . ;
-
 : check-response ( response -- response )
     dup code>> success? [ download-failed ] unless ;
 
@@ -203,3 +195,7 @@ M: download-failed error.
 
 : http-post ( post-data url -- response data )
     <post-request> http-request ;
+
+USING: vocabs vocabs.loader ;
+
+"debugger" vocab [ "http.client.debugger" require ] when

basis/http/client/debugger/debugger.factor

@@ -0,0 +1,13 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel summary debugger io make math.parser
+prettyprint http.client accessors ;
+IN: http.client.debugger
+
+M: too-many-redirects summary
+    drop
+    [ "Redirection limit of " % max-redirects # " exceeded" % ] "" make ;
+
+M: download-failed error.
+    "HTTP request failed:" print nl
+    response>> . ;

basis/http/http.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel combinators math namespaces make
+USING: accessors kernel combinators math namespaces make assocs
-assocs sequences splitting sorting sets debugger
+sequences splitting sorting sets strings vectors hashtables
-strings vectors hashtables quotations arrays byte-arrays
+quotations arrays byte-arrays math.parser calendar
-math.parser calendar calendar.format present urls
+calendar.format present urls
 
 io io.encodings io.encodings.iana io.encodings.binary
 io.encodings.8-bit

basis/io/encodings/utf16/utf16-tests.factor

@@ -23,9 +23,3 @@ IN: io.encodings.utf16.tests
 [ { CHAR: x } ] [ { HEX: fe HEX: ff 0 CHAR: x } utf16 decode >array ] unit-test
 
 [ { HEX: ff HEX: fe 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16 encode >array ] unit-test
-
-: correct-endian
-    code>> little-endian? [ utf16le = ] [ utf16be = ] if ;
-
-[ t ] [ B{ } utf16n <byte-reader> correct-endian ] unit-test
-[ t ] [ utf16n <byte-writer> correct-endian ] unit-test

basis/io/encodings/utf16n/utf16n-docs.factor

@@ -0,0 +1,6 @@
+USING: help.markup help.syntax ;
+IN: io.encodings.utf16n
+
+HELP: utf16n
+{ $class-description "The encoding descriptor for UTF-16 without a byte order mark in native endian order. This is useful mostly for FFI calls which take input of strings of the type wchar_t*" }
+{ $see-also "encodings-introduction" } ;

basis/io/encodings/utf16n/utf16n-tests.factor

@@ -0,0 +1,9 @@
+USING: accessors alien.c-types kernel
+io.encodings.utf16 io.streams.byte-array tools.test ;
+IN: io.encodings.utf16n
+
+: correct-endian
+    code>> little-endian? [ utf16le = ] [ utf16be = ] if ;
+
+[ t ] [ B{ } utf16n <byte-reader> correct-endian ] unit-test
+[ t ] [ utf16n <byte-writer> correct-endian ] unit-test

basis/io/encodings/utf16n/utf16n.factor

@@ -0,0 +1,15 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types io.encodings io.encodings.utf16 kernel ;
+IN: io.encodings.utf16n
+
+! Native-order UTF-16
+
+SINGLETON: utf16n
+
+: utf16n ( -- descriptor )
+    little-endian? utf16le utf16be ? ; foldable
+
+M: utf16n <decoder> drop utf16n <decoder> ;
+
+M: utf16n <encoder> drop utf16n <encoder> ;

basis/io/files/unique/backend/backend.factor

@@ -1,5 +0,0 @@
-USING: io.backend ;
-IN: io.files.unique.backend
-
-HOOK: (make-unique-file) io-backend ( path -- )
-HOOK: temporary-path io-backend ( -- path )

basis/io/files/unique/unique-docs.factor

@@ -2,12 +2,40 @@ USING: help.markup help.syntax io io.ports kernel math
 io.files.unique.private math.parser io.files ;
 IN: io.files.unique
 
+HELP: temporary-path
+{ $values
+     { "path" "a pathname string" }
+}
+{ $description "A hook that returns the path of the temporary directory in a platform-specific way. Does not guarantee that path is writable by your user." } ;
+
+HELP: touch-unique-file
+{ $values
+     { "path" "a pathname string" }
+}
+{ $description "Creates a unique file in a platform-specific way. The file is guaranteed not to exist and is openable by your user." } ;
+
+HELP: unique-length
+{ $description "A symbol storing the number of random characters inserted between the prefix and suffix of a random file name." } ;
+
+HELP: unique-retries
+{ $description "The number of times to try creating a unique file in case of a name collision. The odds of a name collision are extremely low with a sufficient " { $link unique-length } "." } ;
+
+{ unique-length unique-retries } related-words
+
 HELP: make-unique-file ( prefix suffix -- path )
 { $values { "prefix" "a string" } { "suffix" "a string" }
 { "path" "a pathname string" } }
 { $description "Creates a file that is guaranteed not to exist in a platform-specific temporary directory. The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." }
-{ $errors "Throws an error if a new unique file cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." }
+{ $errors "Throws an error if a new unique file cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." } ;
-{ $see-also with-unique-file } ;
+
+HELP: make-unique-file*
+{ $values
+     { "prefix" null } { "suffix" null }
+     { "path" "a pathname string" }
+}
+{ $description "Creates a file that is guaranteed not to exist in the directory in the " { $link current-directory } " variable. The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." } ;
+
+{ make-unique-file make-unique-file* with-unique-file } related-words
 
 HELP: with-unique-file ( prefix suffix quot: ( path -- ) -- )
 { $values { "prefix" "a string" } { "suffix" "a string" }
@@ -18,8 +46,7 @@ HELP: with-unique-file ( prefix suffix quot: ( path -- ) -- )
 HELP: make-unique-directory ( -- path )
 { $values { "path" "a pathname string" } }
 { $description "Creates a directory that is guaranteed not to exist in a platform-specific temporary directory and returns the full pathname." }
-{ $errors "Throws an error if the directory cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." }
+{ $errors "Throws an error if the directory cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." } ;
-{ $see-also with-unique-directory } ;
 
 HELP: with-unique-directory ( quot -- )
 { $values { "quot" "a quotation" } }
@@ -30,6 +57,7 @@ ARTICLE: "io.files.unique" "Temporary files"
 "The " { $vocab-link "io.files.unique" } " vocabulary implements cross-platform temporary file creation in a high-level and secure way." $nl
 "Files:"
 { $subsection make-unique-file }
+{ $subsection make-unique-file* }
 { $subsection with-unique-file }
 "Directories:"
 { $subsection make-unique-directory }

basis/io/files/unique/unique.factor

@@ -1,11 +1,13 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.bitwise math.parser
+USING: kernel math math.bitwise math.parser random sequences
-random sequences continuations namespaces
+continuations namespaces io.files io arrays system
-io.files io arrays io.files.unique.backend system
+combinators vocabs.loader fry io.backend ;
-combinators vocabs.loader fry ;
 IN: io.files.unique
 
+HOOK: touch-unique-file io-backend ( path -- )
+HOOK: temporary-path io-backend ( -- path )
+
 SYMBOL: unique-length
 SYMBOL: unique-retries
 
@@ -26,12 +28,17 @@ SYMBOL: unique-retries
 
 PRIVATE>
 
+: (make-unique-file) ( path prefix suffix -- path )
+    '[
+        _ _ _ unique-length get random-name glue append-path
+        dup touch-unique-file
+    ] unique-retries get retry ;
+
 : make-unique-file ( prefix suffix -- path )
-    temporary-path -rot
+    [ temporary-path ] 2dip (make-unique-file) ;
-    [
+
-        unique-length get random-name glue append-path
+: make-unique-file* ( prefix suffix -- path )
-        dup (make-unique-file)
+    [ current-directory get ] 2dip (make-unique-file) ;
-    ] 3curry unique-retries get retry ;
 
 : with-unique-file ( prefix suffix quot: ( path -- ) -- )
     [ make-unique-file ] dip [ delete-file ] bi ; inline

basis/io/paths/paths-tests.factor

@@ -0,0 +1,11 @@
+USING: io.paths kernel tools.test io.files.unique sequences
+io.files namespaces sorting ;
+IN: io.paths.tests
+
+[ t ] [
+    [
+        10 [ "io.paths.test" "gogogo" make-unique-file* ] replicate
+        current-directory get t [ ] find-all-files
+    ] with-unique-directory
+    [ natural-sort ] bi@ =
+] unit-test

basis/io/paths/paths.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays deques dlists io.files io.paths.private
+USING: accessors arrays deques dlists io.files
 kernel sequences system vocabs.loader fry continuations ;
 IN: io.paths
 

basis/io/ports/ports.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: math kernel io sequences io.buffers io.timeouts generic
 byte-vectors system io.encodings math.order io.backend
-continuations debugger classes byte-arrays namespaces splitting
+continuations classes byte-arrays namespaces splitting
 grouping dlists assocs io.encodings.binary summary accessors
 destructors combinators ;
 IN: io.ports

basis/io/servers/connection/connection.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: continuations destructors kernel math math.parser
-namespaces parser sequences strings prettyprint debugger
+namespaces parser sequences strings prettyprint
 quotations combinators logging calendar assocs present
 fry accessors arrays io io.sockets io.encodings.ascii
 io.sockets.secure io.files io.streams.duplex io.timeouts

basis/io/sockets/secure/openssl/openssl.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors byte-arrays kernel debugger sequences
+USING: accessors byte-arrays kernel sequences
 namespaces math math.order combinators init alien alien.c-types
-alien.strings libc continuations destructors debugger summary
+alien.strings libc continuations destructors summary
 splitting assocs random math.parser locals unicode.case openssl
 openssl.libcrypto openssl.libssl io.backend io.ports io.files
 io.encodings.8-bit io.timeouts io.sockets.secure ;

basis/io/sockets/sockets.factor

@@ -4,7 +4,7 @@
 USING: generic kernel io.backend namespaces continuations
 sequences arrays io.encodings io.ports io.streams.duplex
 io.encodings.ascii alien.strings io.binary accessors destructors
-classes debugger byte-arrays system combinators parser
+classes byte-arrays system combinators parser
 alien.c-types math.parser splitting grouping math assocs summary
 system vocabs.loader combinators present fry ;
 IN: io.sockets

basis/io/streams/duplex/duplex.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel continuations destructors io io.encodings
-io.encodings.private io.timeouts io.ports debugger summary
+io.encodings.private io.timeouts io.ports summary
-listener accessors delegate delegate.protocols ;
+accessors delegate delegate.protocols ;
 IN: io.streams.duplex
 
 TUPLE: duplex-stream in out ;

basis/io/streams/limited/limited.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math io io.encodings destructors accessors
-sequences namespaces ;
+sequences namespaces byte-vectors ;
 IN: io.streams.limited
 
 TUPLE: limited-stream stream count limit ;

basis/io/styles/styles.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: hashtables io colors ;
+USING: hashtables io colors summary make accessors splitting
+kernel ;
 IN: io.styles
 
 SYMBOL: plain
@@ -43,4 +44,11 @@ TUPLE: input string ;
 
 C: <input> input
 
+M: input summary
+    [
+        "Input: " %
+        string>> "\n" split1 swap %
+        "..." "" ? %
+    ] "" make ;
+
 : write-object ( str obj -- ) presented associate format ;

basis/io/unix/files/unique/unique.factor

@@ -1,13 +1,13 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel io.ports io.unix.backend math.bitwise
-unix io.files.unique.backend system ;
+unix system io.files.unique ;
 IN: io.unix.files.unique
 
 : open-unique-flags ( -- flags )
     { O_RDWR O_CREAT O_EXCL } flags ;
 
-M: unix (make-unique-file) ( path -- )
+M: unix touch-unique-file ( path -- )
     open-unique-flags file-mode open-file close-file ;
 
 M: unix temporary-path ( -- path ) "/tmp" ;

basis/io/unix/launcher/launcher.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces math system sequences debugger
+USING: kernel namespaces math system sequences
 continuations arrays assocs combinators alien.c-types strings
 threads accessors environment
 io io.backend io.launcher io.ports io.files
@@ -36,9 +36,6 @@ USE: unix
 : redirect-fd ( oldfd fd -- )
     2dup = [ 2drop ] [ dup2 io-error ] if ;
 
-: redirect-inherit ( obj mode fd -- )
-    3drop ;
-
 : redirect-file ( obj mode fd -- )
     [ [ normalize-path ] dip file-mode open-file ] dip redirect-fd ;
 
@@ -50,7 +47,7 @@ USE: unix
 
 : redirect ( obj mode fd -- )
     {
-        { [ pick not ] [ redirect-inherit ] }
+        { [ pick not ] [ 3drop ] }
         { [ pick string? ] [ redirect-file ] }
         { [ pick appender? ] [ redirect-file-append ] }
         { [ pick +closed+ eq? ] [ redirect-closed ] }

basis/io/unix/sockets/secure/secure.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors unix byte-arrays kernel debugger sequences
+USING: accessors unix byte-arrays kernel sequences
 namespaces math math.order combinators init alien alien.c-types
 alien.strings libc continuations destructors openssl
 openssl.libcrypto openssl.libssl io io.files io.ports

basis/io/windows/files/files.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types io.binary io.backend io.files io.buffers
-io.windows kernel math splitting fry alien.strings
+io.encodings.utf16n io.ports io.windows kernel math splitting
-windows windows.kernel32 windows.time calendar combinators
+fry alien.strings windows windows.kernel32 windows.time calendar
-math.functions sequences namespaces make words symbols system
+combinators math.functions sequences namespaces make words
-io.ports destructors accessors math.bitwise continuations
+symbols system destructors accessors math.bitwise continuations
 windows.errors arrays byte-arrays ;
 IN: io.windows.files
 

basis/io/windows/files/unique/unique.factor

@@ -1,9 +1,9 @@
-USING: kernel system io.files.unique.backend
+USING: kernel system windows.kernel32 io.windows
-windows.kernel32 io.windows io.windows.files io.ports windows
+io.windows.files io.ports windows destructors environment
-destructors environment ;
+io.files.unique ;
 IN: io.windows.files.unique
 
-M: windows (make-unique-file) ( path -- )
+M: windows touch-unique-file ( path -- )
     GENERIC_WRITE CREATE_NEW 0 open-file dispose ;
 
 M: windows temporary-path ( -- path )

basis/io/windows/nt/files/files.factor

@@ -1,10 +1,10 @@
 USING: continuations destructors io.buffers io.files io.backend
-io.timeouts io.ports io.windows io.windows.files
+io.timeouts io.ports io.files.private io.windows
-io.windows.nt.backend windows windows.kernel32
+io.windows.files io.windows.nt.backend io.encodings.utf16n
-kernel libc math threads system environment
+windows windows.kernel32 kernel libc math threads system
-alien.c-types alien.arrays alien.strings sequences combinators
+environment alien.c-types alien.arrays alien.strings sequences
-combinators.short-circuit ascii splitting alien strings
+combinators combinators.short-circuit ascii splitting alien
-assocs namespaces make io.files.private accessors tr ;
+strings assocs namespaces make accessors tr ;
 IN: io.windows.nt.files
 
 M: winnt cwd

basis/io/windows/nt/monitors/monitors.factor

@@ -5,8 +5,8 @@ kernel math assocs namespaces make continuations sequences
 hashtables sorting arrays combinators math.bitwise strings
 system accessors threads splitting io.backend io.windows
 io.windows.nt.backend io.windows.nt.files io.monitors io.ports
-io.buffers io.files io.timeouts io.encodings.string io
+io.buffers io.files io.timeouts io.encodings.string
-windows windows.kernel32 windows.types ;
+io.encodings.utf16n io windows windows.kernel32 windows.types ;
 IN: io.windows.nt.monitors
 
 : open-directory ( path -- handle )

basis/locals/definitions/definitions.factor

@@ -0,0 +1,57 @@
+! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors definitions effects generic kernel locals
+macros memoize prettyprint prettyprint.backend words ;
+IN: locals.definitions
+
+PREDICATE: lambda-word < word "lambda" word-prop >boolean ;
+
+M: lambda-word definer drop \ :: \ ; ;
+
+M: lambda-word definition
+    "lambda" word-prop body>> ;
+
+M: lambda-word reset-word
+    [ call-next-method ] [ f "lambda" set-word-prop ] bi ;
+
+INTERSECTION: lambda-macro macro lambda-word ;
+
+M: lambda-macro definer drop \ MACRO:: \ ; ;
+
+M: lambda-macro definition
+    "lambda" word-prop body>> ;
+
+M: lambda-macro reset-word
+    [ call-next-method ] [ f "lambda" set-word-prop ] bi ;
+
+INTERSECTION: lambda-method method-body lambda-word ;
+
+M: lambda-method definer drop \ M:: \ ; ;
+
+M: lambda-method definition
+    "lambda" word-prop body>> ;
+
+M: lambda-method reset-word
+    [ call-next-method ] [ f "lambda" set-word-prop ] bi ;
+
+INTERSECTION: lambda-memoized memoized lambda-word ;
+
+M: lambda-memoized definer drop \ MEMO:: \ ; ;
+
+M: lambda-memoized definition
+    "lambda" word-prop body>> ;
+
+M: lambda-memoized reset-word
+    [ call-next-method ] [ f "lambda" set-word-prop ] bi ;
+
+: method-stack-effect ( method -- effect )
+    dup "lambda" word-prop vars>>
+    swap "method-generic" word-prop stack-effect
+    dup [ out>> ] when
+    <effect> ;
+
+M: lambda-method synopsis*
+    dup dup dup definer.
+    "method-class" word-prop pprint-word
+    "method-generic" word-prop pprint-word
+    method-stack-effect effect>string comment. ;

basis/locals/errors/errors.factor

@@ -0,0 +1,40 @@
+! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel summary ;
+IN: locals.errors
+
+ERROR: >r/r>-in-lambda-error ;
+
+M: >r/r>-in-lambda-error summary
+    drop
+    "Explicit retain stack manipulation is not permitted in lambda bodies" ;
+
+ERROR: binding-form-in-literal-error ;
+
+M: binding-form-in-literal-error summary
+    drop "[let, [let* and [wlet not permitted inside literals" ;
+
+ERROR: local-writer-in-literal-error ;
+
+M: local-writer-in-literal-error summary
+    drop "Local writer words not permitted inside literals" ;
+
+ERROR: local-word-in-literal-error ;
+
+M: local-word-in-literal-error summary
+    drop "Local words not permitted inside literals" ;
+
+ERROR: :>-outside-lambda-error ;
+
+M: :>-outside-lambda-error summary
+    drop ":> cannot be used outside of lambda expressions" ;
+
+ERROR: bad-lambda-rewrite output ;
+
+M: bad-lambda-rewrite summary
+    drop "You have found a bug in locals. Please report." ;
+
+ERROR: bad-local args obj ;
+
+M: bad-local summary
+    drop "You have bound a bug in locals. Please report." ;

basis/locals/fry/fry.factor

@@ -0,0 +1,18 @@
+! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors fry fry.private generalizations kernel
+locals.types make sequences ;
+IN: locals.fry
+
+! Support for mixing locals with fry
+
+M: binding-form count-inputs body>> count-inputs ;
+
+M: lambda count-inputs body>> count-inputs ;
+
+M: lambda deep-fry
+    clone [ shallow-fry swap ] change-body
+    [ [ vars>> length ] keep '[ _ _ mnswap @ ] , ] [ drop [ncurry] % ] 2bi ;
+
+M: binding-form deep-fry
+    clone [ fry '[ @ call ] ] change-body , ;

basis/locals/locals-docs.factor

@@ -63,6 +63,33 @@ HELP: [wlet
     }
 } ;
 
+HELP: :>
+{ $syntax ":> binding" }
+{ $description "Introduces a new binding, lexically scoped to the enclosing quotation or definition." }
+{ $notes
+    "Lambda and let forms are really just syntax sugar for " { $link POSTPONE: :> } "."
+    $nl
+    "Lambdas desugar as follows:"
+    { $code
+        "[| a b | a b + b / ]"
+        "[ :> b :> a a b + b / ]"
+    }
+    "Let forms desugar as follows:"
+    { $code
+        "[|let | x [ 10 random ] | { x x } ]"
+        "10 random :> x { x x }"
+    }
+}
+{ $examples
+    { $code
+        "USING: locals math kernel ;"
+        "IN: scratchpad"
+        ":: quadratic ( a b c -- x y )"
+        "    b sq 4 a c * * - sqrt :> disc"
+        "    b neg disc [ + ] [ - ] 2bi [ 2 a * / ] bi@ ;"
+    }
+} ;
+
 HELP: ::
 { $syntax ":: word ( bindings... -- outputs... ) body... ;" }
 { $description "Defines a word with named inputs; it reads stack values into bindings from left to right, then executes the body with those bindings in lexical scope." }
@@ -209,6 +236,8 @@ $nl
 { $subsection POSTPONE: [wlet }
 "Lambda abstractions:"
 { $subsection POSTPONE: [| }
+"Lightweight binding form:"
+{ $subsection POSTPONE: :> }
 "Additional topics:"
 { $subsection "locals-literals" }
 { $subsection "locals-mutable" }

basis/locals/locals-tests.factor

@@ -441,6 +441,16 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 
 [ "USE: locals [| | [wlet | a [ 0 ] | { a } ] ]" eval ] must-fail
 
+[ "USE: locals [| | { :> a } ]" eval ] must-fail
+
+[ "USE: locals 3 :> a" eval ] must-fail
+
+[ 3 ] [ 3 [| | :> a a ] call ] unit-test
+
+[ 3 ] [ 3 [| | :> a! a ] call ] unit-test
+
+[ 3 ] [ 2 [| | :> a! a 1+ a! a ] call ] unit-test
+
 :: wlet-&&-test ( a -- ? )
     [wlet | is-integer? [ a integer? ]
             is-even? [ a even? ]

basis/locals/locals.factor

@@ -1,397 +1,13 @@
 ! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces make sequences sequences.private assocs
+USING: lexer macros memoize parser sequences vocabs
-math vectors strings classes.tuple generalizations parser words
+vocabs.loader words kernel namespaces locals.parser locals.types
-quotations debugger macros arrays macros splitting combinators
+locals.errors ;
-prettyprint.backend definitions prettyprint hashtables
-prettyprint.sections sets sequences.private effects
-effects.parser generic generic.parser compiler.units accessors
-locals.backend memoize macros.expander lexer classes summary fry
-fry.private ;
 IN: locals
 
-ERROR: >r/r>-in-lambda-error ;
+: :>
-
+    scan locals get [ :>-outside-lambda-error ] unless*
-M: >r/r>-in-lambda-error summary
+    [ make-local ] bind <def> parsed ; parsing
-    drop
-    "Explicit retain stack manipulation is not permitted in lambda bodies" ;
-
-ERROR: binding-form-in-literal-error ;
-
-M: binding-form-in-literal-error summary
-    drop "[let, [let* and [wlet not permitted inside literals" ;
-
-ERROR: local-writer-in-literal-error ;
-
-M: local-writer-in-literal-error summary
-    drop "Local writer words not permitted inside literals" ;
-
-ERROR: local-word-in-literal-error ;
-
-M: local-word-in-literal-error summary
-    drop "Local words not permitted inside literals" ;
-
-ERROR: bad-lambda-rewrite output ;
-
-M: bad-lambda-rewrite summary
-    drop "You have found a bug in locals. Please report." ;
-
-<PRIVATE
-
-TUPLE: lambda vars body ;
-
-C: <lambda> lambda
-
-TUPLE: binding-form bindings body ;
-
-TUPLE: let < binding-form ;
-
-C: <let> let
-
-TUPLE: let* < binding-form ;
-
-C: <let*> let*
-
-TUPLE: wlet < binding-form ;
-
-C: <wlet> wlet
-
-M: lambda expand-macros clone [ expand-macros ] change-body ;
-
-M: lambda expand-macros* expand-macros literal ;
-
-M: binding-form expand-macros
-    clone
-        [ [ expand-macros ] assoc-map ] change-bindings
-        [ expand-macros ] change-body ;
-
-M: binding-form expand-macros* expand-macros literal ;
-
-PREDICATE: local < word "local?" word-prop ;
-
-: <local> ( name -- word )
-    #! Create a local variable identifier
-    f <word>
-    dup t "local?" set-word-prop ;
-
-PREDICATE: local-word < word "local-word?" word-prop ;
-
-: <local-word> ( name -- word )
-    f <word> dup t "local-word?" set-word-prop ;
-
-PREDICATE: local-reader < word "local-reader?" word-prop ;
-
-: <local-reader> ( name -- word )
-    f <word>
-    dup t "local-reader?" set-word-prop ;
-
-PREDICATE: local-writer < word "local-writer?" word-prop ;
-
-: <local-writer> ( reader -- word )
-    dup name>> "!" append f <word> {
-        [ nip t "local-writer?" set-word-prop ]
-        [ swap "local-reader" set-word-prop ]
-        [ "local-writer" set-word-prop ]
-        [ nip ]
-    } 2cleave ;
-
-TUPLE: quote local ;
-
-C: <quote> quote
-
-: local-index ( obj args -- n )
-    [ dup quote? [ local>> ] when eq? ] with find drop ;
-
-: read-local-quot ( obj args -- quot )
-    local-index neg [ get-local ] curry ;
-
-GENERIC# localize 1 ( obj args -- quot )
-
-M: local localize read-local-quot ;
-
-M: quote localize [ local>> ] dip read-local-quot ;
-
-M: local-word localize read-local-quot [ call ] append ;
-
-M: local-reader localize read-local-quot [ local-value ] append ;
-
-M: local-writer localize
-    [ "local-reader" word-prop ] dip
-    read-local-quot [ set-local-value ] append ;
-
-M: object localize drop 1quotation ;
-
-UNION: special local quote local-word local-reader local-writer ;
-
-: load-locals-quot ( args -- quot )
-    [ [ ] ] [
-        dup [ local-reader? ] contains? [
-            dup [ local-reader? [ 1array ] [ ] ? ] map spread>quot
-        ] [ [ ] ] if swap length [ load-locals ] curry append
-    ] if-empty ;
-
-: drop-locals-quot ( args -- quot )
-    [ [ ] ] [ length [ drop-locals ] curry ] if-empty ;
-
-: point-free-body ( quot args -- newquot )
-    [ but-last-slice ] dip '[ _ localize ] map concat ;
-
-: point-free-end ( quot args -- newquot )
-    over peek special?
-    [ dup drop-locals-quot [ [ peek ] dip localize ] dip append ]
-    [ drop-locals-quot swap peek suffix ]
-    if ;
-
-: (point-free) ( quot args -- newquot )
-    [ nip load-locals-quot ]
-    [ reverse point-free-body ]
-    [ reverse point-free-end ]
-    2tri [ ] 3append-as ;
-
-: point-free ( quot args -- newquot )
-    over empty? [ nip length '[ _ ndrop ] ] [ (point-free) ] if ;
-
-UNION: lexical local local-reader local-writer local-word ;
-
-GENERIC: free-vars* ( form -- )
-
-: free-vars ( form -- vars )
-    [ free-vars* ] { } make prune ;
-
-M: local-writer free-vars* "local-reader" word-prop , ;
-
-M: lexical free-vars* , ;
-
-M: quote free-vars* , ;
-
-M: object free-vars* drop ;
-
-M: quotation free-vars* [ free-vars* ] each ;
-
-M: lambda free-vars* [ vars>> ] [ body>> ] bi free-vars swap diff % ;
-
-GENERIC: lambda-rewrite* ( obj -- )
-
-GENERIC: local-rewrite* ( obj -- )
-
-: lambda-rewrite ( form -- form' )
-    expand-macros
-    [ local-rewrite* ] [ ] make
-    [ [ lambda-rewrite* ] each ] [ ] make ;
-
-UNION: block callable lambda ;
-
-GENERIC: block-vars ( block -- seq )
-
-GENERIC: block-body ( block -- quot )
-
-M: callable block-vars drop { } ;
-
-M: callable block-body ;
-
-M: callable local-rewrite*
-    [ [ local-rewrite* ] each ] [ ] make , ;
-
-M: lambda block-vars vars>> ;
-
-M: lambda block-body body>> ;
-
-M: lambda local-rewrite*
-    [ vars>> ] [ body>> ] bi
-    [ [ local-rewrite* ] each ] [ ] make <lambda> , ;
-
-M: block lambda-rewrite*
-    #! Turn free variables into bound variables, curry them
-    #! onto the body
-    dup free-vars [ <quote> ] map dup % [
-        over block-vars prepend
-        swap block-body [ [ lambda-rewrite* ] each ] [ ] make
-        swap point-free ,
-    ] keep length \ curry <repetition> % ;
-
-GENERIC: rewrite-literal? ( obj -- ? )
-
-M: special rewrite-literal? drop t ;
-
-M: array rewrite-literal? [ rewrite-literal? ] contains? ;
-
-M: quotation rewrite-literal? [ rewrite-literal? ] contains? ;
-
-M: wrapper rewrite-literal? drop t ;
-
-M: hashtable rewrite-literal? drop t ;
-
-M: vector rewrite-literal? drop t ;
-
-M: tuple rewrite-literal? drop t ;
-
-M: object rewrite-literal? drop f ;
-
-GENERIC: rewrite-element ( obj -- )
-
-: rewrite-elements ( seq -- )
-    [ rewrite-element ] each ;
-
-: rewrite-sequence ( seq -- )
-    [ rewrite-elements ] [ length , ] [ 0 head , ] tri \ nsequence , ;
-
-M: array rewrite-element
-    dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;
-
-M: vector rewrite-element rewrite-sequence ;
-
-M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
-
-M: tuple rewrite-element
-    [ tuple-slots rewrite-elements ] [ class literalize , ] bi \ boa , ;
-
-M: quotation rewrite-element local-rewrite* ;
-
-M: lambda rewrite-element local-rewrite* ;
-
-M: binding-form rewrite-element binding-form-in-literal-error ;
-
-M: local rewrite-element , ;
-
-M: local-reader rewrite-element , ;
-
-M: local-writer rewrite-element
-    local-writer-in-literal-error ;
-
-M: local-word rewrite-element
-    local-word-in-literal-error ;
-
-M: word rewrite-element literalize , ;
-
-M: wrapper rewrite-element
-    dup rewrite-literal? [ wrapped>> rewrite-element ] [ , ] if ;
-
-M: object rewrite-element , ;
-
-M: array local-rewrite* rewrite-element ;
-
-M: vector local-rewrite* rewrite-element ;
-
-M: tuple local-rewrite* rewrite-element ;
-
-M: hashtable local-rewrite* rewrite-element ;
-
-M: wrapper local-rewrite* rewrite-element ;
-
-M: word local-rewrite*
-    dup { >r r> load-locals get-local drop-locals } memq?
-    [ >r/r>-in-lambda-error ] [ call-next-method ] if ;
-
-M: object lambda-rewrite* , ;
-
-M: object local-rewrite* , ;
-
-: make-local ( name -- word )
-    "!" ?tail [
-        <local-reader>
-        dup <local-writer> dup name>> set
-    ] [ <local> ] if
-    dup dup name>> set ;
-
-: make-locals ( seq -- words assoc )
-    [ [ make-local ] map ] H{ } make-assoc ;
-
-: make-local-word ( name def -- word )
-    [ <local-word> [ dup name>> set ] [ ] [ ] tri ] dip
-    "local-word-def" set-word-prop ;
-
-: push-locals ( assoc -- )
-    use get push ;
-
-: pop-locals ( assoc -- )
-    use get delete ;
-
-SYMBOL: in-lambda?
-
-: (parse-lambda) ( assoc end -- quot )
-    t in-lambda? [ parse-until ] with-variable
-    >quotation swap pop-locals ;
-
-: parse-lambda ( -- lambda )
-    "|" parse-tokens make-locals dup push-locals
-    \ ] (parse-lambda) <lambda> ;
-
-: parse-binding ( end -- pair/f )
-    scan {
-        { [ dup not ] [ unexpected-eof ] }
-        { [ 2dup = ] [ 2drop f ] }
-        [ nip scan-object 2array ]
-    } cond ;
-
-: (parse-bindings) ( end -- )
-    dup parse-binding dup [
-        first2 [ make-local ] dip 2array ,
-        (parse-bindings)
-    ] [ 2drop ] if ;
-
-: parse-bindings ( end -- bindings vars )
-    [
-        [ (parse-bindings) ] H{ } make-assoc
-        dup push-locals
-    ] { } make swap ;
-
-: parse-bindings* ( end -- words assoc )
-    [
-        [
-            namespace push-locals
-
-            (parse-bindings)
-        ] { } make-assoc
-    ] { } make swap ;
-
-: (parse-wbindings) ( end -- )
-    dup parse-binding dup [
-        first2 [ make-local-word ] keep 2array ,
-        (parse-wbindings)
-    ] [ 2drop ] if ;
-
-: parse-wbindings ( end -- bindings vars )
-    [
-        [ (parse-wbindings) ] H{ } make-assoc
-        dup push-locals
-    ] { } make swap ;
-
-: let-rewrite ( body bindings -- )
-    <reversed> [
-        [ 1array ] dip spin <lambda> '[ @ @ ]
-    ] assoc-each local-rewrite* \ call , ;
-
-M: let local-rewrite*
-    [ body>> ] [ bindings>> ] bi let-rewrite ;
-
-M: let* local-rewrite*
-    [ body>> ] [ bindings>> ] bi let-rewrite ;
-
-M: wlet local-rewrite*
-    [ body>> ] [ bindings>> ] bi
-    [ '[ _ ] ] assoc-map
-    let-rewrite ;
-
-: parse-locals ( -- vars assoc )
-    "(" expect ")" parse-effect
-    word [ over "declared-effect" set-word-prop ] when*
-    in>> [ dup pair? [ first ] when ] map make-locals dup push-locals ;
-
-: parse-locals-definition ( word -- word quot )
-    parse-locals \ ; (parse-lambda) <lambda>
-    2dup "lambda" set-word-prop
-    lambda-rewrite dup length 1 = [ first ] [ bad-lambda-rewrite ] if ;
-
-: (::) ( -- word def ) CREATE-WORD parse-locals-definition ;
-
-: (M::) ( -- word def )
-    CREATE-METHOD
-    [ parse-locals-definition ] with-method-definition ;
-
-: parsed-lambda ( accum form -- accum )
-    in-lambda? get [ parsed ] [ lambda-rewrite over push-all ] if ;
-
-PRIVATE>
 
 : [| parse-lambda parsed-lambda ; parsing
 
@@ -415,110 +31,12 @@ PRIVATE>
 
 : MEMO:: (::) define-memoized ; parsing
 
-<PRIVATE
+{
+    "locals.macros"
+    "locals.fry"
+} [ require ] each
 
-! Pretty-printing locals
+"prettyprint" vocab [
-SYMBOL: |
+    "locals.definitions" require
-
+    "locals.prettyprint" require
-: pprint-var ( var -- )
+] when
-    #! Prettyprint a read/write local as its writer, just like
-    #! in the input syntax: [| x! | ... x 3 + x! ]
-    dup local-reader? [
-        "local-writer" word-prop
-    ] when pprint-word ;
-
-: pprint-vars ( vars -- ) [ pprint-var ] each ;
-
-M: lambda pprint*
-    <flow
-    \ [| pprint-word
-    dup vars>> pprint-vars
-    \ | pprint-word
-    f <inset body>> pprint-elements block>
-    \ ] pprint-word
-    block> ;
-
-: pprint-let ( let word -- )
-    pprint-word
-    [ body>> ] [ bindings>> ] bi
-    \ | pprint-word
-    t <inset
-    <block
-    [ <block [ pprint-var ] dip pprint* block> ] assoc-each
-    block>
-    \ | pprint-word
-    <block pprint-elements block>
-    block>
-    \ ] pprint-word ;
-
-M: let pprint* \ [let pprint-let ;
-
-M: wlet pprint* \ [wlet pprint-let ;
-
-M: let* pprint* \ [let* pprint-let ;
-
-PREDICATE: lambda-word < word "lambda" word-prop >boolean ;
-
-M: lambda-word definer drop \ :: \ ; ;
-
-M: lambda-word definition
-    "lambda" word-prop body>> ;
-
-M: lambda-word reset-word
-    [ call-next-method ] [ f "lambda" set-word-prop ] bi ;
-
-INTERSECTION: lambda-macro macro lambda-word ;
-
-M: lambda-macro definer drop \ MACRO:: \ ; ;
-
-M: lambda-macro definition
-    "lambda" word-prop body>> ;
-
-M: lambda-macro reset-word
-    [ call-next-method ] [ f "lambda" set-word-prop ] bi ;
-
-INTERSECTION: lambda-method method-body lambda-word ;
-
-M: lambda-method definer drop \ M:: \ ; ;
-
-M: lambda-method definition
-    "lambda" word-prop body>> ;
-
-M: lambda-method reset-word
-    [ call-next-method ] [ f "lambda" set-word-prop ] bi ;
-
-INTERSECTION: lambda-memoized memoized lambda-word ;
-
-M: lambda-memoized definer drop \ MEMO:: \ ; ;
-
-M: lambda-memoized definition
-    "lambda" word-prop body>> ;
-
-M: lambda-memoized reset-word
-    [ call-next-method ] [ f "lambda" set-word-prop ] bi ;
-
-: method-stack-effect ( method -- effect )
-    dup "lambda" word-prop vars>>
-    swap "method-generic" word-prop stack-effect
-    dup [ out>> ] when
-    <effect> ;
-
-M: lambda-method synopsis*
-    dup dup dup definer.
-    "method-class" word-prop pprint-word
-    "method-generic" word-prop pprint-word
-    method-stack-effect effect>string comment. ;
-
-PRIVATE>
-
-! Locals and fry
-M: binding-form count-inputs body>> count-inputs ;
-
-M: lambda count-inputs body>> count-inputs ;
-
-M: lambda deep-fry
-    clone [ shallow-fry swap ] change-body
-    [ [ vars>> length ] keep '[ _ _ mnswap @ ] , ] [ drop [ncurry] % ] 2bi ;
-
-M: binding-form deep-fry
-    clone [ fry '[ @ call ] ] change-body , ;

basis/locals/macros/macros.factor

@@ -0,0 +1,16 @@
+! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs kernel locals.types macros.expander ;
+IN: locals.macros
+
+M: lambda expand-macros clone [ expand-macros ] change-body ;
+
+M: lambda expand-macros* expand-macros literal ;
+
+M: binding-form expand-macros
+    clone
+        [ [ expand-macros ] assoc-map ] change-bindings
+        [ expand-macros ] change-body ;
+
+M: binding-form expand-macros* expand-macros literal ;
+

basis/locals/parser/parser.factor

@@ -0,0 +1,101 @@
+! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays combinators effects.parser
+generic.parser kernel lexer locals.errors
+locals.rewrite.closures locals.types make namespaces parser
+quotations sequences splitting words ;
+IN: locals.parser
+
+: make-local ( name -- word )
+    "!" ?tail [
+        <local-reader>
+        dup <local-writer> dup name>> set
+    ] [ <local> ] if
+    dup dup name>> set ;
+
+: make-locals ( seq -- words assoc )
+    [ [ make-local ] map ] H{ } make-assoc ;
+
+: make-local-word ( name def -- word )
+    [ <local-word> [ dup name>> set ] [ ] [ ] tri ] dip
+    "local-word-def" set-word-prop ;
+
+SYMBOL: locals
+
+: push-locals ( assoc -- )
+    use get push ;
+
+: pop-locals ( assoc -- )
+    use get delete ;
+
+SYMBOL: in-lambda?
+
+: (parse-lambda) ( assoc end -- quot )
+    [
+        in-lambda? on
+        over locals set
+        over push-locals
+        parse-until >quotation
+        swap pop-locals
+    ] with-scope ;
+
+: parse-lambda ( -- lambda )
+    "|" parse-tokens make-locals
+    \ ] (parse-lambda) <lambda> ;
+
+: parse-binding ( end -- pair/f )
+    scan {
+        { [ dup not ] [ unexpected-eof ] }
+        { [ 2dup = ] [ 2drop f ] }
+        [ nip scan-object 2array ]
+    } cond ;
+
+: (parse-bindings) ( end -- )
+    dup parse-binding dup [
+        first2 [ make-local ] dip 2array ,
+        (parse-bindings)
+    ] [ 2drop ] if ;
+
+: parse-bindings ( end -- bindings vars )
+    [
+        [ (parse-bindings) ] H{ } make-assoc
+    ] { } make swap ;
+
+: parse-bindings* ( end -- words assoc )
+    [
+        [
+            namespace push-locals
+            (parse-bindings)
+            namespace pop-locals
+        ] { } make-assoc
+    ] { } make swap ;
+
+: (parse-wbindings) ( end -- )
+    dup parse-binding dup [
+        first2 [ make-local-word ] keep 2array ,
+        (parse-wbindings)
+    ] [ 2drop ] if ;
+
+: parse-wbindings ( end -- bindings vars )
+    [
+        [ (parse-wbindings) ] H{ } make-assoc
+    ] { } make swap ;
+
+: parse-locals ( -- vars assoc )
+    "(" expect ")" parse-effect
+    word [ over "declared-effect" set-word-prop ] when*
+    in>> [ dup pair? [ first ] when ] map make-locals ;
+
+: parse-locals-definition ( word -- word quot )
+    parse-locals \ ; (parse-lambda) <lambda>
+    2dup "lambda" set-word-prop
+    rewrite-closures dup length 1 = [ first ] [ bad-lambda-rewrite ] if ;
+
+: (::) ( -- word def ) CREATE-WORD parse-locals-definition ;
+
+: (M::) ( -- word def )
+    CREATE-METHOD
+    [ parse-locals-definition ] with-method-definition ;
+
+: parsed-lambda ( accum form -- accum )
+    in-lambda? get [ parsed ] [ rewrite-closures over push-all ] if ;

basis/locals/prettyprint/prettyprint.factor

@@ -0,0 +1,48 @@
+! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs kernel locals locals.types
+prettyprint.backend prettyprint.sections prettyprint.custom
+sequences words ;
+IN: locals.prettyprint
+
+SYMBOL: |
+
+: pprint-var ( var -- )
+    #! Prettyprint a read/write local as its writer, just like
+    #! in the input syntax: [| x! | ... x 3 + x! ]
+    dup local-reader? [
+        "local-writer" word-prop
+    ] when pprint-word ;
+
+: pprint-vars ( vars -- ) [ pprint-var ] each ;
+
+M: lambda pprint*
+    <flow
+    \ [| pprint-word
+    dup vars>> pprint-vars
+    \ | pprint-word
+    f <inset body>> pprint-elements block>
+    \ ] pprint-word
+    block> ;
+
+: pprint-let ( let word -- )
+    pprint-word
+    [ body>> ] [ bindings>> ] bi
+    \ | pprint-word
+    t <inset
+    <block
+    [ <block [ pprint-var ] dip pprint* block> ] assoc-each
+    block>
+    \ | pprint-word
+    <block pprint-elements block>
+    block>
+    \ ] pprint-word ;
+
+M: let pprint* \ [let pprint-let ;
+
+M: wlet pprint* \ [wlet pprint-let ;
+
+M: let* pprint* \ [let* pprint-let ;
+
+M: def pprint*
+    <block \ :> pprint-word local>> pprint-word block> ;