Merge git://factorcode.org/git/factor

Conflicts:

	Makefile

Makefile

@@ -63,9 +63,9 @@ default:
 	@echo "macosx-ppc"
 	@echo "solaris-x86-32"
 	@echo "solaris-x86-64"
-	@echo "windows-ce-arm"
-	@echo "windows-nt-x86-32"
-	@echo "windows-nt-x86-64"
+	@echo "wince-arm"
+	@echo "winnt-x86-32"
+	@echo "winnt-x86-64"
 	@echo ""
 	@echo "Additional modifiers:"
 	@echo ""
@@ -123,13 +123,17 @@ solaris-x86-32:
 solaris-x86-64:
 	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.solaris.x86.64
 
-windows-nt-x86-32:
+winnt-x86-32:
 	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
 
+<<<<<<< HEAD:Makefile
 windows-nt-x86-64:
 	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64
 
 windows-ce-arm:
+=======
+wince-arm:
+>>>>>>> 1eda70f1ad1f0d744ed846ce8c975a1cd4b28fb6:Makefile
 	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.ce.arm
 
 macosx.app: factor

core/bootstrap/image/image.factor

@@ -203,14 +203,8 @@ M: f '
 
 ! Words
 
-DEFER: emit-word
-
-: emit-generic ( generic -- )
-    dup "default-method" word-prop method-word emit-word
-    "methods" word-prop [ nip method-word emit-word ] assoc-each ;
-
 : emit-word ( word -- )
-    dup generic? [ dup emit-generic ] when
+    dup subwords [ emit-word ] each
     [
         dup hashcode ' ,
         dup word-name ' ,

core/bootstrap/primitives.factor

@@ -553,8 +553,6 @@ builtins get num-tags get tail f union-class define-class
     { "millis" "system" }
     { "type" "kernel.private" }
     { "tag" "kernel.private" }
-    { "cwd" "io.files" }
-    { "cd" "io.files" }
     { "modify-code-heap" "compiler.units" }
     { "dlopen" "alien" }
     { "dlsym" "alien" }

core/bootstrap/stage2.factor

@@ -1,11 +1,11 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: init command-line namespaces words debugger io
 kernel.private math memory continuations kernel io.files
 io.backend system parser vocabs sequences prettyprint
 vocabs.loader combinators splitting source-files strings
 definitions assocs compiler.errors compiler.units
-math.parser ;
+math.parser generic ;
 IN: bootstrap.stage2
 
 ! Wrap everything in a catch which starts a listener so
@@ -24,6 +24,7 @@ IN: bootstrap.stage2
         "Cross-referencing..." print flush
         H{ } clone crossref set-global
         xref-words
+        xref-generics
         xref-sources
     ] unless
 
@@ -87,5 +88,7 @@ IN: bootstrap.stage2
         "output-image" get resource-path save-image-and-exit
     ] if
 ] [
-    print-error :c "listener" vocab-main execute
+    print-error :c restarts.
+    "listener" vocab-main execute
+    1 exit
 ] recover

core/compiler/units/units-docs.factor

@@ -28,9 +28,7 @@ HELP: redefine-error
 
 HELP: remember-definition
 { $values { "definition" "a definition specifier" } { "loc" "a " { $snippet "{ path line# }" } " pair" } }
-{ $description "Saves the location of a definition and associates this definition with the current source file."
-$nl
-"This is the book-keeping required to detect " { $link redefine-error } " and " { $link forward-error } "." } ;
+{ $description "Saves the location of a definition and associates this definition with the current source file." } ;
 
 HELP: old-definitions
 { $var-description "Stores an assoc where the keys form the set of definitions which were defined by " { $link file } " the most recent time it was loaded." } ;
@@ -38,11 +36,6 @@ HELP: old-definitions
 HELP: new-definitions
 { $var-description "Stores an assoc where the keys form the set of definitions which were defined so far by the current parsing of " { $link file } "." } ;
 
-HELP: forward-error
-{ $values { "word" word } }
-{ $description "Throws a " { $link forward-error } "." }
-{ $description "Indicates a word is being referenced prior to the location of its most recent definition. This can only happen if a source file is loaded, and subsequently edited such that two dependent definitions are reversed." } ;
-
 HELP: with-compilation-unit
 { $values { "quot" quotation } }
 { $description "Calls a quotation in a new compilation unit. The quotation can define new words and classes, as well as forget words. When the quotation returns, any changed words are recompiled, and changes are applied atomically." }

core/compiler/units/units.factor

@@ -26,11 +26,6 @@ TUPLE: redefine-error def ;
     over new-definitions get first key? [ dup redefine-error ] when
     new-definitions get second (remember-definition) ;
 
-TUPLE: forward-error word ;
-
-: forward-error ( word -- )
-    \ forward-error construct-boa throw ;
-
 : forward-reference? ( word -- ? )
     dup old-definitions get assoc-stack
     [ new-definitions get assoc-stack not ]

core/debugger/debugger.factor

@@ -87,7 +87,32 @@ TUPLE: assert got expect ;
 
 : depth ( -- n ) datastack length ;
 
-: assert-depth ( quot -- ) depth slip depth swap assert= ;
+: trim-datastacks ( seq1 seq2 -- seq1' seq2' )
+    2dup [ length ] 2apply min tuck tail >r tail r> ;
+
+TUPLE: relative-underflow stack ;
+
+: relative-underflow ( before after -- * )
+    trim-datastacks nip \ relative-underflow construct-boa throw ;
+
+M: relative-underflow summary
+    drop "Too many items removed from data stack" ;
+
+TUPLE: relative-overflow stack ;
+
+M: relative-overflow summary
+    drop "Superfluous items pushed to data stack" ;
+
+: relative-overflow ( before after -- * )
+    trim-datastacks drop \ relative-overflow construct-boa throw ;
+
+: assert-depth ( quot -- )
+    >r datastack r> swap slip >r datastack r>
+    2dup [ length ] compare sgn {
+        { -1 [ relative-underflow ] }
+        { 0 [ 2drop ] }
+        { 1 [ relative-overflow ] }
+    } case ; inline
 
 : expired-error. ( obj -- )
     "Object did not survive image save/load: " write third . ;
@@ -222,9 +247,6 @@ M: redefine-error error.
     "Re-definition of " write
     redefine-error-def . ;
 
-M: forward-error error.
-    "Forward reference to " write forward-error-word . ;
-
 M: undefined summary
     drop "Calling a deferred word before it has been defined" ;
 

core/definitions/definitions-docs.factor

@@ -52,9 +52,7 @@ $nl
 $nl
 "If the parser did not have special checks for this case, then the modified source file would still load, because when the definition of " { $snippet "hello-world" } " on line 4 is being parsed, the " { $snippet "world" } " word is already present in the dictionary from an earlier run. The developer would then not discover this mistake until attempting to load the source file into a fresh image."
 $nl
-"Since this is undesirable, the parser explicitly raises an error if a source file refers to a word which is in the dictionary, but defined after it is used."
-{ $subsection forward-error }
-"If a source file raises a " { $link forward-error } " when loaded into a development image, then it would have raised a " { $link no-word } " error when loaded into a fresh image."
+"Since this is undesirable, the parser explicitly raises a " { $link no-word } " error if a source file refers to a word which is in the dictionary, but defined after it is used."
 $nl
 "The parser also catches duplicate definitions. If an artifact is defined twice in the same source file, the earlier definition will never be accessible, and this is almost always a mistake, perhaps due to a bad choice of word names, or a copy and paste error. The parser raises an error in this case."
 { $subsection redefine-error } ;

core/definitions/definitions-tests.factor

@@ -6,6 +6,8 @@ TUPLE: combination-1 ;
 
 M: combination-1 perform-combination 2drop { } [ ] each [ ] ;
 
+M: combination-1 make-default-method 2drop [ "No method" throw ] ;
+
 SYMBOL: generic-1
 
 [
@@ -20,7 +22,7 @@ SYMBOL: generic-1
     ] with-compilation-unit
 ] unit-test
 
-GENERIC: some-generic
+GENERIC: some-generic ( a -- b )
 
 USE: arrays
 

core/generic/generic-tests.factor

@@ -177,7 +177,7 @@ M: f tag-and-f 4 ;
 TUPLE: debug-combination ;
 
 M: debug-combination make-default-method
-    2drop [ "Oops" throw ] when ;
+    2drop [ "Oops" throw ] ;
 
 M: debug-combination perform-combination
     drop

core/generic/generic.factor

@@ -73,7 +73,8 @@ M: method-body stack-effect
 : <method-word> ( quot class generic -- word )
     [ make-method-def ] 2keep
     method-word-name f <word>
-    dup rot define ;
+    dup rot define
+    dup xref ;
 
 : <method> ( quot class generic -- method )
     check-method
@@ -135,12 +136,14 @@ M: assoc update-methods ( assoc -- )
         make-generic
     ] if ;
 
-: subwords ( generic -- seq )
+GENERIC: subwords ( word -- seq )
+
+M: word subwords drop f ;
+
+M: generic subwords
     dup "methods" word-prop values
     swap "default-method" word-prop add
     [ method-word ] map ;
 
 : xref-generics ( -- )
-    all-words
-    [ generic? ] subset
-    [ subwords [ xref ] each ] each ;
+    all-words [ subwords [ xref ] each ] each ;

core/generic/standard/standard.factor

@@ -91,7 +91,7 @@ TUPLE: no-method object generic ;
 
 : class-hash-dispatch-quot ( methods quot picker -- quot )
     >r >r hash-methods r> map
-    hash-dispatch-quot r> [ class-hash ] rot 3append ;
+    hash-dispatch-quot r> [ class-hash ] rot 3append ; inline
 
 : big-generic ( methods -- quot )
     [ small-generic ] picker class-hash-dispatch-quot ;

core/inference/inference.factor

@@ -1,9 +1,9 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: inference.backend inference.state inference.dataflow
 inference.known-words inference.transforms inference.errors
-sequences prettyprint io effects kernel namespaces quotations
-words vocabs ;
+kernel io effects namespaces sequences quotations vocabs
+generic words ;
 IN: inference
 
 GENERIC: infer ( quot -- effect )
@@ -28,4 +28,7 @@ M: callable dataflow-with
     ] with-infer nip ;
 
 : forget-errors ( -- )
-    all-words [ f "no-effect" set-word-prop ] each ;
+    all-words [
+        dup subwords [ f "no-effect" set-word-prop ] each
+        f "no-effect" set-word-prop
+    ] each ;

core/io/files/files-docs.factor

@@ -52,12 +52,12 @@ HELP: <file-appender>
 { $description "Outputs an output stream for writing to the specified pathname. The stream begins writing at the end of the file." }
 { $errors "Throws an error if the file cannot be opened for writing." } ;
 
-HELP: cwd ( -- path )
+HELP: cwd
 { $values { "path" "a pathname string" } }
 { $description "Outputs the current working directory of the Factor process." }
 { $errors "Windows CE has no concept of ``current directory'', so this word throws an error there." } ;
 
-HELP: cd ( path -- )
+HELP: cd
 { $values { "path" "a pathname string" } }
 { $description "Changes the current working directory of the Factor process." }
 { $errors "Windows CE has no concept of ``current directory'', so this word throws an error there." } ;

core/io/files/files.factor

@@ -1,10 +1,14 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: io.files
 USING: io.backend io.files.private io hashtables kernel math
 memory namespaces sequences strings assocs arrays definitions
 system combinators splitting sbufs ;
 
+HOOK: cd io-backend ( path -- )
+
+HOOK: cwd io-backend ( -- path )
+
 HOOK: <file-reader> io-backend ( path -- stream )
 
 HOOK: <file-writer> io-backend ( path -- stream )
@@ -25,12 +29,15 @@ HOOK: root-directory? io-backend ( path -- ? )
 
 M: object root-directory? ( path -- ? ) path-separator? ;
 
-: trim-path-separators ( str -- newstr )
+: right-trim-separators ( str -- newstr )
     [ path-separator? ] right-trim ;
 
+: left-trim-separators ( str -- newstr )
+    [ path-separator? ] left-trim ;
+
 : path+ ( str1 str2 -- str )
-    >r trim-path-separators "/" r>
-    [ path-separator? ] left-trim 3append ;
+    >r right-trim-separators "/" r>
+    left-trim-separators 3append ;
 
 : stat ( path -- directory? permissions length modified )
     normalize-pathname (stat) ;
@@ -65,7 +72,7 @@ TUPLE: no-parent-directory path ;
     \ no-parent-directory construct-boa throw ;
 
 : parent-directory ( path -- parent )
-    trim-path-separators {
+    right-trim-separators {
         { [ dup empty? ] [ drop "/" ] }
         { [ dup root-directory? ] [ ] }
         { [ dup [ path-separator? ] contains? not ] [ drop "." ] }
@@ -86,7 +93,7 @@ TUPLE: no-parent-directory path ;
     "resource:" ?head [ resource-path ] when ;
 
 : make-directories ( path -- )
-    normalize-pathname trim-path-separators {
+    normalize-pathname right-trim-separators {
         { [ dup "." = ] [ ] }
         { [ dup root-directory? ] [ ] }
         { [ dup empty? ] [ ] }

core/optimizer/backend/backend.factor

@@ -256,7 +256,7 @@ M: #dispatch optimize-node*
     tuck dispatching-class dup [
         swap [ 2array ] 2keep
         method method-word
-        dup word-def flat-length 5 >=
+        dup word-def flat-length 6 >=
         [ 1quotation ] [ word-def ] if
     ] [
         2drop t t

core/parser/parser-docs.factor

@@ -202,9 +202,7 @@ HELP: location
 
 HELP: save-location
 { $values { "definition" "a definition specifier" } }
-{ $description "Saves the location of a definition and associates this definition with the current source file."
-$nl
-"This is the book-keeping required to detect " { $link redefine-error } " and " { $link forward-error } "." } ;
+{ $description "Saves the location of a definition and associates this definition with the current source file." } ;
 
 HELP: parser-notes
 { $var-description "A boolean controlling whether the parser will print various notes and warnings. Switched on by default. If a source file is being run for its effect on the " { $link stdio } " stream, this variable should be switched off, to prevent parser notes from polluting the output." } ;

core/parser/parser-tests.factor

@@ -342,7 +342,7 @@ IN: temporary
         [
             "IN: temporary \\ class-fwd-test"
             <string-reader> "redefining-a-class-3" parse-stream drop
-        ] catch [ forward-error? ] is?
+        ] catch [ no-word? ] is?
     ] unit-test
 
     [ ] [
@@ -354,7 +354,7 @@ IN: temporary
         [
             "IN: temporary \\ class-fwd-test"
             <string-reader> "redefining-a-class-3" parse-stream drop
-        ] catch [ forward-error? ] is?
+        ] catch [ no-word? ] is?
     ] unit-test
 
     [ t ] [

core/parser/parser.factor

@@ -235,7 +235,8 @@ M: no-word summary
 
 : no-word ( name -- newword )
     dup \ no-word construct-boa
-    swap words-named word-restarts throw-restarts
+    swap words-named [ forward-reference? not ] subset
+    word-restarts throw-restarts
     dup word-vocabulary (use+) ;
 
 : check-forward ( str word -- word )
@@ -244,7 +245,7 @@ M: no-word summary
         dup use get
         [ at ] with map [ ] subset
         [ forward-reference? not ] find nip
-        [ ] [ forward-error ] ?if
+        [ ] [ no-word ] ?if
     ] [
         nip
     ] if ;
@@ -415,11 +416,6 @@ SYMBOL: interactive-vocabs
         over stack.
     ] when 2drop ;
 
-: outside-usages ( seq -- usages )
-    dup [
-        over usage [ pathname? not ] subset seq-diff
-    ] curry { } map>assoc ;
-
 : filter-moved ( assoc -- newassoc )
     [
         drop where dup [ first ] when

core/source-files/source-files.factor

@@ -96,3 +96,17 @@ SYMBOL: file
         source-file-definitions old-definitions set
         [ ] [ file get rollback-source-file ] cleanup
     ] with-scope ; inline
+
+: smart-usage ( word -- definitions )
+    \ f or usage [
+        dup method-body? [
+            "method" word-prop
+            { method-specializer method-generic } get-slots
+            2array
+        ] when
+    ] map ;
+
+: outside-usages ( seq -- usages )
+    dup [
+        over smart-usage [ pathname? not ] subset seq-diff
+    ] curry { } map>assoc ;

core/system/system-docs.factor

@@ -51,7 +51,8 @@ HELP: os
         "openbsd"
         "netbsd"
         "solaris"
-        "windows"
+        "wince"
+        "winnt"
     }
 } ;
 

core/system/system.factor

@@ -22,7 +22,7 @@ splitting assocs ;
     os "wince" = ; foldable
 
 : winnt? ( -- ? )
-    os "windows" = ; foldable
+    os "winnt" = ; foldable
 
 : windows? ( -- ? )
     wince? winnt? or ; foldable

core/vocabs/loader/loader-docs.factor

@@ -124,15 +124,12 @@ HELP: refresh
 { $values { "prefix" string } }
 { $description "Reloads source files and documentation belonging to loaded vocabularies whose names are prefixed by " { $snippet "prefix" } " which have been modified on disk." } ;
 
+HELP: require-all-error
+{ $values { "vocabs" "a sequence of vocabularies" } }
+{ $description "Throws a " { $link require-all-error } "." }
+{ $error-description "Thrown by " { $link require-all } " if one or more vocabulary failed to load." } ;
+
 HELP: refresh-all
 { $description "Reloads source files and documentation for all loaded vocabularies which have been modified on disk." } ;
 
 { refresh refresh-all } related-words
-
-HELP: vocab-file-contents
-{ $values { "vocab" "a vocabulary specifier" } { "name" string } { "seq" "a sequence of lines, or " { $link f } } }
-{ $description "Outputs the contents of the file named " { $snippet "name" } " from the vocabulary's directory, or " { $link f } " if the file does not exist." } ;
-
-HELP: set-vocab-file-contents
-{ $values { "seq" "a sequence of lines" } { "vocab" "a vocabulary specifier" } { "name" string } }
-{ $description "Stores a sequence of lines to the file named " { $snippet "name" } " from the vocabulary's directory." } ;

core/vocabs/loader/loader-tests.factor

@@ -79,7 +79,7 @@ IN: temporary
         <string-reader>
         "resource:core/vocabs/loader/test/a/a.factor"
         parse-stream
-    ] catch [ forward-error? ] is?
+    ] catch [ no-word? ] is?
 ] unit-test
 
 0 "count-me" set-global

core/vocabs/loader/loader.factor

@@ -148,16 +148,31 @@ SYMBOL: load-help?
     dup update-roots
     dup modified-sources swap modified-docs ;
 
-: require-restart { { "Ignore this vocabulary" t } } ;
+: load-error. ( vocab error -- )
+    "While loading " rot dup >vocab-link write-object ":" print
+    print-error ;
 
-: require-all ( seq -- )
-    [
+TUPLE: require-all-error vocabs ;
+
+: require-all-error ( vocabs -- )
+    \ require-all-error construct-boa throw ;
+
+M: require-all-error summary
+    drop "The require-all operation failed" ;
+
+: require-all ( vocabs -- )
+    dup length 1 = [ first require ] [
         [
-            [ require ]
-            [ require-restart rethrow-restarts 2drop ]
-            recover
-        ] each
-    ] with-compiler-errors ;
+            [
+                [ [ require ] [ 2array , ] recover ] each
+            ] { } make
+            dup empty? [ drop ] [
+                "==== LOAD ERRORS:" print
+                dup [ nl load-error. ] assoc-each
+                keys require-all-error
+            ] if
+        ] with-compiler-errors
+    ] if ;
 
 : do-refresh ( modified-sources modified-docs -- )
     2dup
@@ -190,22 +205,3 @@ load-vocab-hook set-global
 M: vocab where vocab-where ;
 
 M: vocab-link where vocab-where ;
-
-: vocab-file-contents ( vocab name -- seq )
-    vocab-path+ dup [
-        ?resource-path dup exists? [
-            <file-reader> lines
-        ] [
-            drop f
-        ] if
-    ] when ;
-
-: set-vocab-file-contents ( seq vocab name -- )
-    dupd vocab-path+ [
-        ?resource-path
-        <file-writer> [ [ print ] each ] with-stream
-    ] [
-        "The " swap vocab-name
-        " vocabulary was not loaded from the file system"
-        3append throw
-    ] ?if ;

core/words/words-tests.factor

@@ -87,7 +87,8 @@ FORGET: foe
 ] unit-test
 
 [ t ] [
-    \ * usage [ word? ] subset [ interned? not ] subset empty?
+    \ * usage [ word? ] subset
+    [ dup interned? swap method-body? or ] all?
 ] unit-test
 
 DEFER: calls-a-gensym

extra/bootstrap/io/io.factor

@@ -10,3 +10,5 @@ IN: bootstrap.io
         { [ wince? ] [ "windows.ce" ] }
     } cond append require
 ] when
+
+"vocabs.monitor" require

extra/builder/builder.factor

@@ -1,7 +1,8 @@
 
-USING: kernel io io.files io.launcher tools.deploy.backend
-       system namespaces sequences splitting math.parser
-       unix prettyprint tools.time calendar bake vars ;
+USING: kernel io io.files io.launcher hashtables tools.deploy.backend
+       system continuations namespaces sequences splitting math.parser
+       prettyprint tools.time calendar bake vars http.client
+       combinators ;
 
 IN: builder
 
@@ -13,102 +14,122 @@ IN: builder
          ,[ dup timestamp-day    ]
          ,[ dup timestamp-hour   ]
          ,[     timestamp-minute ] }
-  [ number>string 2 CHAR: 0 pad-left ] map "-" join ;
+  [ pad-00 ] map "-" join ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 SYMBOL: builder-recipients
 
-: quote ( str -- str ) "'" swap "'" 3append ;
-
 : email-file ( subject file -- )
   `{
-     "cat"       ,
-     "| mutt -s" ,[ quote ]
-     "-x"        %[ builder-recipients get ]
-   }
-   " " join system drop ;
-  
+    { +stdin+ , }
+    { +arguments+ { "mutt" "-s" , %[ builder-recipients get ] } }
+  }
+  >hashtable run-process drop ;
+
+: email-string ( subject -- )
+  `{ "mutt" "-s" , %[ builder-recipients get ] }
+  [ ] with-process-stream drop ;
+
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
+: factor-binary ( -- name )
+  os
+  { { "macosx" [ "./Factor.app/Contents/MacOS/factor" ] }
+    { "windows" [ "./factor-nt.exe" ] }
+    [ drop "./factor" ] }
+  case ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 VAR: stamp
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : build ( -- )
 
-datestamp >stamp
+  datestamp >stamp
 
-"/builds/factor" cd
-"git pull git://factorcode.org/git/factor.git" system
-0 =
-[ ]
-[
-  "builder: git pull" "/dev/null" email-file
-  "builder: git pull" throw
-]
-if
+  "/builds/factor" cd
+  
+  { "git" "pull" "--no-summary" "git://factorcode.org/git/factor.git" }
+  run-process process-status
+  0 =
+  [ ]
+  [
+    "builder: git pull" email-string
+    "builder: git pull" throw
+  ]
+  if
 
-"/builds/" stamp> append make-directory
-"/builds/" stamp> append cd
-"git clone /builds/factor" system drop
+  "/builds/" stamp> append make-directory
+  "/builds/" stamp> append cd
 
-"factor" cd
+  { "git" "clone" "/builds/factor" } run-process drop
 
-{ "git" "show" } <process-stream>
-[ readln ] with-stream
-" " split second
-"../git-id" <file-writer> [ print ] with-stream
+  "factor" cd
 
-"make clean" system drop
+  { "git" "show" } <process-stream>
+  [ readln ] with-stream
+  " " split second
+  "../git-id" <file-writer> [ print ] with-stream
 
-"make " target " > ../compile-log" 3append system
-0 =
-[ ]
-[
-  "builder: vm compile" "../compile-log" email-file
-  "builder: vm compile" throw
-] if
+  { "make" "clean" } run-process drop
 
-"wget http://factorcode.org/images/latest/" boot-image-name append system
-0 =
-[ ]
-[
-  "builder: image download" "/dev/null" email-file
-  "builder: image download" throw
-] if
+  `{
+     { +arguments+ { "make" ,[ target ] } }
+     { +stdout+    "../compile-log" }
+     { +stderr+    +stdout+ }
+   }
+  >hashtable run-process process-status
+  0 =
+  [ ]
+  [
+    "builder: vm compile" "../compile-log" email-file
+    "builder: vm compile" throw
+  ] if
 
-[
-  "./factor -i=" boot-image-name " -no-user-init > ../boot-log"
-  3append
-  system
-]
-benchmark nip
-"../boot-time" <file-writer> [ . ] with-stream
-0 =
-[ ]
-[
-  "builder: bootstrap" "../boot-log" email-file
-  "builder: bootstrap" throw
-] if
+  [ "http://factorcode.org/images/latest/" boot-image-name append download ]
+  [ "builder: image download" email-string ]
+  recover
 
-[
-  "./factor -e='USE: tools.browser load-everything' > ../load-everything-log"
-  system
-] benchmark nip
-"../load-everything-time" <file-writer> [ . ] with-stream
-0 =
-[ ]
-[
-  "builder: load-everything" "../load-everything-log" email-file
-  "builder: load-everything" throw
-] if
+  `{
+     { +arguments+ {
+                     ,[ factor-binary ]
+                     ,[ "-i=" boot-image-name append ]
+                     "-no-user-init"
+                   } }
+     { +stdout+   "../boot-log" }
+     { +stderr+   +stdout+ }
+   }
+  >hashtable
+  [ run-process process-status ]
+  benchmark nip "../boot-time" <file-writer> [ . ] with-stream
+  0 =
+  [ ]
+  [
+    "builder: bootstrap" "../boot-log" email-file
+    "builder: bootstrap" throw
+  ] if
 
-;
+  `{
+     { +arguments+
+       { ,[ factor-binary ] "-e=USE: tools.browser load-everything" } }
+     { +stdout+    "../load-everything-log" }
+     { +stderr+    +stdout+ }
+   }
+  >hashtable [ run-process process-status ] benchmark nip
+  "../load-everything-time" <file-writer> [ . ] with-stream
+  0 =
+  [ ]
+  [
+    "builder: load-everything" "../load-everything-log" email-file
+    "builder: load-everything" throw
+  ] if ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

extra/delegate/delegate.factor

@@ -39,7 +39,7 @@ M: tuple-class group-words
 : define-mimic ( group mimicker mimicked -- )
     >r >r group-words r> r> [
         pick "methods" word-prop at dup
-        [ method-def <method> spin define-method ] [ 3drop ] if
+        [ method-def spin define-method ] [ 3drop ] if
     ] 2curry each ; 
 
 : MIMIC:

extra/help/handbook/handbook.factor

@@ -137,7 +137,7 @@ ARTICLE: "collections" "Collections"
 { $subsection "graphs" }
 { $subsection "buffers" } ;
 
-USING: io.sockets io.launcher io.mmap io.monitor ;
+USING: io.sockets io.launcher io.mmap io.monitors ;
 
 ARTICLE: "io" "Input and output" 
 { $subsection "streams" }
@@ -155,7 +155,7 @@ ARTICLE: "io" "Input and output"
 "Advanced features:"
 { $subsection "io.launcher" }
 { $subsection "io.mmap" }
-{ $subsection "io.monitor" } ;
+{ $subsection "io.monitors" } ;
 
 ARTICLE: "tools" "Developer tools"
 { $subsection "tools.annotations" }

extra/help/help.factor

@@ -96,6 +96,9 @@ M: word set-article-parent swap "help-parent" set-word-prop ;
     article-content print-content nl ;
 
 : about ( vocab -- )
+    dup vocab [ ] [
+        "No such vocabulary: " swap append throw
+    ] ?if
     dup vocab-help [
         help
     ] [

extra/io/launcher/launcher-docs.factor

@@ -24,11 +24,11 @@ $nl
 HELP: +environment-mode+
 { $description "Launch descriptor key. Must equal of the following:"
     { $list
-        { $link prepend-environment }
-        { $link replace-environment }
-        { $link append-environment }
+        { $link +prepend-environment+ }
+        { $link +replace-environment+ }
+        { $link +append-environment+ }
     }
-"Default value is " { $link append-environment } "."
+"Default value is " { $link +append-environment+ } "."
 } ;
 
 HELP: +stdin+
@@ -61,17 +61,17 @@ HELP: +stderr+
 HELP: +closed+
 { $description "Possible value for " { $link +stdin+ } ", " { $link +stdout+ } ", and " { $link +stderr+ } " launch descriptors." } ;
 
-HELP: prepend-environment
+HELP: +prepend-environment+
 { $description "Possible value of " { $link +environment-mode+ } " launch descriptor key. The child process environment consists of the value of the " { $link +environment+ } " key together with the current environment, with entries from the current environment taking precedence."
 $nl
 "This is used in situations where you want to spawn a child process with some default environment variables set, but allowing the user to override these defaults by changing the environment before launching Factor." } ;
 
-HELP: replace-environment
+HELP: +replace-environment+
 { $description "Possible value of " { $link +environment-mode+ } " launch descriptor key. The child process environment consists of the value of the " { $link +environment+ } " key."
 $nl
 "This is used in situations where you want full control over a child process environment, perhaps for security or testing." } ;
 
-HELP: append-environment
+HELP: +append-environment+
 { $description "Possible value of " { $link +environment-mode+ } " launch descriptor key. The child process environment consists of the current environment together with the value of the " { $link +environment+ } " key, with entries from the " { $link +environment+ } " key taking precedence."
 $nl
 "This is used in situations where you want a spawn child process with some overridden environment variables." } ;

extra/io/launcher/launcher.factor

@@ -35,9 +35,9 @@ SYMBOL: +stdout+
 SYMBOL: +stderr+
 SYMBOL: +closed+
 
-SYMBOL: prepend-environment
-SYMBOL: replace-environment
-SYMBOL: append-environment
+SYMBOL: +prepend-environment+
+SYMBOL: +replace-environment+
+SYMBOL: +append-environment+
 
 : default-descriptor
     H{
@@ -45,7 +45,7 @@ SYMBOL: append-environment
         { +arguments+ f }
         { +detached+ f }
         { +environment+ H{ } }
-        { +environment-mode+ append-environment }
+        { +environment-mode+ +append-environment+ }
     } ;
 
 : with-descriptor ( desc quot -- )
@@ -53,14 +53,14 @@ SYMBOL: append-environment
 
 : pass-environment? ( -- ? )
     +environment+ get assoc-empty? not
-    +environment-mode+ get replace-environment eq? or ;
+    +environment-mode+ get +replace-environment+ eq? or ;
 
 : get-environment ( -- env )
     +environment+ get
     +environment-mode+ get {
-        { prepend-environment [ os-envs union ] }
-        { append-environment [ os-envs swap union ] }
-        { replace-environment [ ] }
+        { +prepend-environment+ [ os-envs union ] }
+        { +append-environment+ [ os-envs swap union ] }
+        { +replace-environment+ [ ] }
     } case ;
 
 GENERIC: >descriptor ( desc -- desc )

extra/io/monitors/monitors-docs.factor

@@ -1,4 +1,4 @@
-IN: io.monitor
+IN: io.monitors
 USING: help.markup help.syntax continuations ;
 
 HELP: <monitor>
@@ -9,7 +9,7 @@ $nl
 
 HELP: next-change
 { $values { "monitor" "a monitor" } { "path" "a pathname string" } { "changes" "a change descriptor" } }
-{ $description "Waits for file system changes and outputs the pathname of the first changed file. The change descriptor is aq sequence of symbols documented in " { $link "io.monitor.descriptors" } "." } ;
+{ $description "Waits for file system changes and outputs the pathname of the first changed file. The change descriptor is aq sequence of symbols documented in " { $link "io.monitors.descriptors" } "." } ;
 
 HELP: with-monitor
 { $values { "path" "a pathname string" } { "recursive?" "a boolean" } { "quot" "a quotation with stack effect " { $snippet "( monitor -- )" } } }
@@ -27,7 +27,7 @@ HELP: +modify-file+
 HELP: +rename-file+
 { $description "Indicates that file has been renamed." } ;
 
-ARTICLE: "io.monitor.descriptors" "File system change descriptors"
+ARTICLE: "io.monitors.descriptors" "File system change descriptors"
 "Change descriptors output by " { $link next-change } ":"
 { $subsection +add-file+ }
 { $subsection +remove-file+ }
@@ -35,24 +35,24 @@ ARTICLE: "io.monitor.descriptors" "File system change descriptors"
 { $subsection +rename-file+ }
 { $subsection +add-file+ } ;
 
-ARTICLE: "io.monitor" "File system change monitors"
+ARTICLE: "io.monitors" "File system change monitors"
 "File system change monitors listen for changes to file names, attributes and contents under a specified directory. They can optionally be recursive, in which case subdirectories are also monitored."
 $nl
 "Creating a file system change monitor and listening for changes:"
 { $subsection <monitor> }
 { $subsection next-change }
-{ $subsection "io.monitor.descriptors" }
+{ $subsection "io.monitors.descriptors" }
 "Monitors are closed by calling " { $link dispose } " or " { $link with-disposal } "."
 $nl
 "A utility combinator which opens a monitor and cleans it up after:"
 { $subsection with-monitor }
 "An example which watches the Factor directory for changes:"
 { $code
-    "USE: io.monitor"
+    "USE: io.monitors"
     ": watch-loop ( monitor -- )"
     "    dup next-change . . nl nl flush watch-loop ;"
     ""
     "\"\" resource-path f [ watch-loop ] with-monitor"
 } ;
 
-ABOUT: "io.monitor"
+ABOUT: "io.monitors"

extra/io/monitors/monitors.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.backend kernel continuations namespaces sequences
 assocs hashtables sorting arrays ;
-IN: io.monitor
+IN: io.monitors
 
 <PRIVATE
 

extra/io/server/server.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2003, 2007 Slava Pestov.
+! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io io.sockets io.files continuations kernel math
 math.parser namespaces parser sequences strings
@@ -9,11 +9,14 @@ IN: io.server
 
 SYMBOL: log-stream
 
+: with-log-stream ( quot -- )
+    log-stream get swap with-stream* ; inline
+
 : log-message ( str -- )
-    log-stream get [
+    [
         "[" write now timestamp>string write "] " write
         print flush
-    ] with-stream* ;
+    ] with-log-stream ;
 
 : log-error ( str -- ) "Error: " swap append log-message ;
 
@@ -24,15 +27,13 @@ SYMBOL: log-stream
 : log-file ( service -- path )
     ".log" append resource-path ;
 
-: with-log-stream ( stream quot -- )
-    log-stream swap with-variable ; inline
-
 : with-log-file ( file quot -- )
     >r <file-appender> r>
-    [ with-log-stream ] curry with-disposal ; inline
+    [ log-stream swap with-variable ] curry
+    with-disposal ; inline
 
 : with-log-stdio ( quot -- )
-    stdio get swap with-log-stream ;
+    stdio get log-stream rot with-variable ; inline
 
 : with-logging ( service quot -- )
     over [

extra/io/unix/files/files.factor

@@ -1,9 +1,17 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.backend io.nonblocking io.unix.backend io.files io
-unix kernel math continuations math.bitfields ;
+unix kernel math continuations math.bitfields byte-arrays
+alien ;
 IN: io.unix.files
 
+M: unix-io cwd
+    MAXPATHLEN dup <byte-array> getcwd
+    [ alien>char-string ] [ (io-error) ] if* ;
+
+M: unix-io cd
+    chdir io-error ;
+
 : read-flags O_RDONLY ; inline
 
 : open-read ( path -- fd )

extra/io/unix/linux/linux.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel io.backend io.monitor io.monitor.private io.files
+USING: kernel io.backend io.monitors io.monitors.private io.files
 io.buffers io.nonblocking io.unix.backend io.unix.select
 io.unix.launcher unix.linux.inotify assocs namespaces threads
 continuations init math alien.c-types alien ;
@@ -25,8 +25,6 @@ TUPLE: inotify watches ;
 
 : wd>monitor ( wd -- monitor ) watches at ;
 
-: wd>path ( wd -- path ) wd>monitor linux-monitor-path ;
-
 : <inotify> ( -- port )
     H{ } clone
     inotify_init dup io-error inotify <buffered-port>
@@ -89,12 +87,8 @@ M: linux-monitor dispose ( monitor -- )
     ] { } make ;
 
 : parse-file-notify ( buffer -- changed path )
-    {
-        inotify-event-wd
-        inotify-event-name
-        inotify-event-mask
-    } get-slots
-    parse-action -rot alien>char-string >r wd>path r> path+ ;
+    { inotify-event-name inotify-event-mask } get-slots
+    parse-action swap alien>char-string ;
 
 : events-exhausted? ( i buffer -- ? )
     buffer-fill >= ;

extra/io/windows/nt/backend/backend.factor

@@ -2,45 +2,10 @@ USING: alien alien.c-types arrays assocs combinators
 continuations destructors io io.backend io.nonblocking
 io.windows libc kernel math namespaces sequences
 threads tuples.lib windows windows.errors windows.kernel32
-strings splitting io.files qualified ascii ;
+strings splitting io.files qualified ascii combinators.lib ;
 QUALIFIED: windows.winsock
 IN: io.windows.nt.backend
 
-: unicode-prefix ( -- seq )
-    "\\\\?\\" ; inline
-
-M: windows-nt-io root-directory? ( path -- ? )
-    dup length 2 = [
-        dup first Letter?
-        swap second CHAR: : = and
-    ] [
-        drop f
-    ] if ;
-
-M: windows-nt-io normalize-pathname ( string -- string )
-    dup string? [ "pathname must be a string" throw ] unless
-    "/" split "\\" join
-    {
-        ! empty
-        { [ dup empty? ] [ "empty path" throw ] }
-        ! .\\foo
-        { [ dup ".\\" head? ] [
-            >r unicode-prefix cwd r> 1 tail 3append
-        ] }
-        ! c:\\foo
-        { [ dup 1 tail ":" head? ] [ >r unicode-prefix r> append ] }
-        ! \\\\?\\c:\\foo
-        { [ dup unicode-prefix head? ] [ ] }
-        ! foo.txt ..\\foo.txt
-        { [ t ] [
-            [
-                unicode-prefix % cwd %
-                dup first CHAR: \\ = [ CHAR: \\ , ] unless %
-            ] "" make
-        ] }
-    } cond [ "/\\." member? ] right-trim
-    dup peek CHAR: : = [ "\\" append ] when ;
-
 SYMBOL: io-hash
 
 TUPLE: io-callback port continuation ;

extra/io/windows/nt/files/files.factor

@@ -1,8 +1,70 @@
-USING: continuations destructors io.buffers io.nonblocking
-io.windows io.windows.nt.backend kernel libc math threads
-windows windows.kernel32 ;
+USING: continuations destructors io.buffers io.files io.backend
+io.nonblocking io.windows io.windows.nt.backend kernel libc math
+threads windows windows.kernel32 alien.c-types alien.arrays
+sequences combinators combinators.lib sequences.lib ascii
+splitting alien strings ;
 IN: io.windows.nt.files
 
+M: windows-nt-io cwd
+    MAX_UNICODE_PATH dup "ushort" <c-array>
+    [ GetCurrentDirectory win32-error=0/f ] keep
+    alien>u16-string ;
+
+M: windows-nt-io cd
+    SetCurrentDirectory win32-error=0/f ;
+
+: unicode-prefix ( -- seq )
+    "\\\\?\\" ; inline
+
+M: windows-nt-io root-directory? ( path -- ? )
+    dup length 2 = [
+        dup first Letter?
+        swap second CHAR: : = and
+    ] [
+        drop f
+    ] if ;
+
+: root-directory ( string -- string' )
+    {
+        [ dup length 2 >= ]
+        [ dup second CHAR: : = ]
+        [ dup first Letter? ]
+    } && [ 2 head ] [ "Not an absolute path" throw ] if ;
+
+: prepend-prefix ( string -- string' )
+    unicode-prefix swap append ;
+
+: windows-path+ ( cwd path -- newpath )
+    {
+        ! empty
+        { [ dup empty? ] [ drop ] }
+        ! ..
+        { [ dup ".." = ] [ drop parent-directory prepend-prefix ] }
+        ! \\\\?\\c:\\foo
+        { [ dup unicode-prefix head? ] [ nip ] }
+        ! ..\\foo
+        { [ dup "..\\" head? ] [ >r parent-directory r> 3 tail windows-path+ ] }
+        ! .\\foo
+        { [ dup ".\\" head? ] [ 1 tail append prepend-prefix ] }
+        ! \\foo
+        { [ dup "\\" head? ] [ >r root-directory r> append prepend-prefix ] }
+        ! c:\\foo
+        { [ dup ?second CHAR: : = ] [ nip prepend-prefix ] }
+        ! foo.txt
+        { [ t ] [
+            >r right-trim-separators "\\" r>
+            left-trim-separators
+            3append prepend-prefix
+        ] }
+    } cond ;
+
+M: windows-nt-io normalize-pathname ( string -- string )
+    dup string? [ "pathname must be a string" throw ] unless
+    "/" split "\\" join
+    cwd swap windows-path+
+    [ "/\\." member? ] right-trim
+    dup peek CHAR: : = [ "\\" append ] when ;
+
 M: windows-nt-io CreateFile-flags ( DWORD -- DWORD )
     FILE_FLAG_OVERLAPPED bitor ;
 

extra/io/windows/nt/monitors/monitors.factor

@@ -3,9 +3,9 @@
 USING: alien.c-types destructors io.windows
 io.windows.nt.backend kernel math windows windows.kernel32
 windows.types libc assocs alien namespaces continuations
-io.monitor io.monitor.private io.nonblocking io.buffers io.files
+io.monitors io.monitors.private io.nonblocking io.buffers io.files
 io sequences hashtables sorting arrays combinators ;
-IN: io.windows.nt.monitor
+IN: io.windows.nt.monitors
 
 : open-directory ( path -- handle )
     FILE_LIST_DIRECTORY
@@ -65,20 +65,19 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
         { [ t ] [ +modify-file+ ] }
     } cond nip ;
 
-: parse-file-notify ( directory buffer -- changed path )
+: parse-file-notify ( buffer -- changed path )
     {
         FILE_NOTIFY_INFORMATION-FileName
         FILE_NOTIFY_INFORMATION-FileNameLength
         FILE_NOTIFY_INFORMATION-Action
-    } get-slots parse-action 1array -rot
-    memory>u16-string path+ ;
+    } get-slots parse-action 1array -rot memory>u16-string ;
 
-: (changed-files) ( directory buffer -- )
-    2dup parse-file-notify changed-file
+: (changed-files) ( buffer -- )
+    dup parse-file-notify changed-file
     dup FILE_NOTIFY_INFORMATION-NextEntryOffset dup zero?
-    [ 3drop ] [ swap <displaced-alien> (changed-files) ] if ;
+    [ 2drop ] [ swap <displaced-alien> (changed-files) ] if ;
 
 M: windows-nt-io fill-queue ( monitor -- )
-    dup win32-monitor-path over buffer-ptr pick read-changes
-    [ zero? [ 2drop ] [ (changed-files) ] if ] H{ } make-assoc
+    dup buffer-ptr over read-changes
+    [ zero? [ drop ] [ (changed-files) ] if ] H{ } make-assoc
     swap set-monitor-queue ;

extra/io/windows/nt/nt-tests.factor

@@ -1,4 +1,5 @@
-USING: io.files kernel tools.test ;
+USING: io.files kernel tools.test io.backend
+io.windows.nt.files splitting ;
 IN: temporary
 
 [ "c:\\foo\\" ] [ "c:\\foo\\bar" parent-directory ] unit-test
@@ -9,8 +10,27 @@ IN: temporary
 [ "Z:" ] [ "Z:\\" parent-directory ] unit-test
 [ "c:" ] [ "c:" parent-directory ] unit-test
 [ "Z:" ] [ "Z:" parent-directory ] unit-test
-[ t ] [ "c:\\" trim-path-separators root-directory? ] unit-test
-[ t ] [ "Z:\\" trim-path-separators root-directory? ] unit-test
+[ t ] [ "c:\\" right-trim-separators root-directory? ] unit-test
+[ t ] [ "Z:\\" right-trim-separators root-directory? ] unit-test
 [ f ] [ "c:\\foo" root-directory? ] unit-test
 [ f ] [ "." root-directory? ] unit-test
 [ f ] [ ".." root-directory? ] unit-test
+
+[ ] [ "" resource-path cd ] unit-test
+
+[ "\\foo\\bar" ] [ "/foo/bar" normalize-pathname ":" split1 nip ] unit-test
+
+[ "\\\\?\\C:\\builds\\factor\\log.txt" ] [
+    "C:\\builds\\factor\\12345\\"
+    "..\\log.txt" windows-path+
+] unit-test
+
+[ "\\\\?\\C:\\builds\\" ] [
+    "C:\\builds\\factor\\12345\\"
+    "..\\.." windows-path+
+] unit-test
+
+[ "\\\\?\\C:\\builds\\" ] [
+    "C:\\builds\\factor\\12345\\"
+    "..\\.." windows-path+
+] unit-test

extra/io/windows/nt/nt.factor

@@ -5,7 +5,7 @@ USE: io.windows
 USE: io.windows.nt.backend
 USE: io.windows.nt.files
 USE: io.windows.nt.launcher
-USE: io.windows.nt.monitor
+USE: io.windows.nt.monitors
 USE: io.windows.nt.sockets
 USE: io.windows.mmap
 USE: io.backend

extra/log-viewer/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

extra/log-viewer/log-viewer.factor

@@ -0,0 +1,14 @@
+USING: kernel io io.files io.monitors ;
+IN: log-viewer
+
+: read-lines ( stream -- )
+    dup stream-readln dup
+    [ print read-lines ] [ 2drop flush ] if ;
+
+: tail-file-loop ( stream monitor -- )
+    dup next-change 2drop over read-lines tail-file-loop ;
+
+: tail-file ( file -- )
+    dup <file-reader> dup read-lines
+    swap parent-directory f <monitor>
+    tail-file-loop ;

extra/log-viewer/summary.txt

@@ -0,0 +1 @@
+Simple log file watcher demo using io.monitors

extra/log-viewer/tags.txt

@@ -0,0 +1 @@
+demos

extra/memoize/memoize.factor

@@ -50,3 +50,6 @@ M: memoized definition "memo-quot" word-prop ;
 : memoize-quot ( quot effect -- memo-quot )
     gensym swap dupd "declared-effect" set-word-prop
     dup rot define-memoized 1quotation ;
+
+: reset-memoized ( word -- )
+    "memoize" word-prop clear-assoc ;

extra/opengl/tags.txt

@@ -1,4 +1 @@
-opengl.glu
-opengl.gl
-opengl
 bindings

extra/state-parser/state-parser.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io io.streams.string kernel math namespaces sequences
-strings circular prettyprint debugger unicode.categories ;
+strings circular prettyprint debugger ascii ;
 IN: state-parser
 
 ! * Basic underlying words

extra/tools/browser/browser-docs.factor

@@ -2,16 +2,34 @@ USING: help.markup help.syntax io strings ;
 IN: tools.browser
 
 ARTICLE: "vocab-index" "Vocabulary index"
-{ $tags,authors }
+{ $tags }
+{ $authors }
 { $describe-vocab "" } ;
 
 ARTICLE: "tools.browser" "Vocabulary browser"
 "Getting and setting vocabulary meta-data:"
+{ $subsection vocab-file-contents }
+{ $subsection set-vocab-file-contents }
 { $subsection vocab-summary }
 { $subsection set-vocab-summary }
 { $subsection vocab-tags }
 { $subsection set-vocab-tags }
-{ $subsection add-vocab-tags } ;
+{ $subsection add-vocab-tags }
+"Global meta-data:"
+{ $subsection all-vocabs }
+{ $subsection all-vocabs-seq }
+{ $subsection all-tags }
+{ $subsection all-authors }
+"Because loading the above data is expensive, it is cached. The cache is flushed by the " { $vocab-link "vocabs.monitor" } " vocabulary. It can also be flushed manually when file system change monitors are not available:"
+{ $subsection reset-cache } ;
+
+HELP: vocab-file-contents
+{ $values { "vocab" "a vocabulary specifier" } { "name" string } { "seq" "a sequence of lines, or " { $link f } } }
+{ $description "Outputs the contents of the file named " { $snippet "name" } " from the vocabulary's directory, or " { $link f } " if the file does not exist." } ;
+
+HELP: set-vocab-file-contents
+{ $values { "seq" "a sequence of lines" } { "vocab" "a vocabulary specifier" } { "name" string } }
+{ $description "Stores a sequence of lines to the file named " { $snippet "name" } " from the vocabulary's directory." } ;
 
 HELP: vocab-summary
 { $values { "vocab" "a vocabulary specifier" } { "summary" "a string or " { $link f } } }

extra/tools/browser/browser.factor

@@ -1,13 +1,30 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces splitting sequences io.files kernel assocs
 words vocabs vocabs.loader definitions parser continuations
 inspector debugger io io.styles io.streams.lines hashtables
 sorting prettyprint source-files arrays combinators strings
 system math.parser help.markup help.topics help.syntax
-help.stylesheet ;
+help.stylesheet memoize ;
 IN: tools.browser
 
+MEMO: (vocab-file-contents) ( path -- lines )
+    ?resource-path dup exists?
+    [ <file-reader> lines ] [ drop f ] if ;
+
+: vocab-file-contents ( vocab name -- seq )
+    vocab-path+ dup [ (vocab-file-contents) ] when ;
+
+: set-vocab-file-contents ( seq vocab name -- )
+    dupd vocab-path+ [
+        ?resource-path
+        <file-writer> [ [ print ] each ] with-stream
+    ] [
+        "The " swap vocab-name
+        " vocabulary was not loaded from the file system"
+        3append throw
+    ] ?if ;
+
 : vocab-summary-path ( vocab -- string )
     vocab-dir "summary.txt" path+ ;
 
@@ -86,7 +103,7 @@ M: vocab-link summary vocab-summary ;
         dup [ "" vocabs-in-dir ] { } make
     ] { } map>assoc ;
 
-: all-vocabs-seq ( -- seq )
+MEMO: all-vocabs-seq ( -- seq )
     all-vocabs values concat ;
 
 : dangerous? ( name -- ? )
@@ -238,7 +255,7 @@ C: <vocab-author> vocab-author
 : vocab-xref ( vocab quot -- vocabs )
     >r dup vocab-name swap words r> map
     [ [ word? ] subset [ word-vocabulary ] map ] map>set
-    remove [ vocab ] map ; inline
+    remove [ ] subset [ vocab ] map ; inline
 
 : vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ;
 
@@ -288,20 +305,20 @@ C: <vocab-author> vocab-author
 : $tagged-vocabs ( element -- )
     first tagged vocabs. ;
 
-: all-tags ( vocabs -- seq ) [ vocab-tags ] map>set ;
+MEMO: all-tags ( -- seq )
+    all-vocabs-seq [ vocab-tags ] map>set ;
 
 : $authored-vocabs ( element -- )
     first authored vocabs. ;
 
-: all-authors ( vocabs -- seq ) [ vocab-authors ] map>set ;
+MEMO: all-authors ( -- seq )
+    all-vocabs-seq [ vocab-authors ] map>set ;
 
-: $tags,authors ( element -- )
-    drop
-    all-vocabs-seq
-    "Tags" $heading
-    dup all-tags tags.
-    "Authors" $heading
-    all-authors authors. ;
+: $tags ( element -- )
+    drop "Tags" $heading all-tags tags. ;
+
+: $authors ( element -- )
+    drop "Authors" $heading all-authors authors. ;
 
 M: vocab-spec article-title vocab-name " vocabulary" append ;
 
@@ -339,3 +356,9 @@ M: vocab-author article-content
 M: vocab-author article-parent drop "vocab-index" ;
 
 M: vocab-author summary article-title ;
+
+: reset-cache ( -- )
+    \ (vocab-file-contents) reset-memoized
+    \ all-vocabs-seq reset-memoized
+    \ all-authors reset-memoized
+    \ all-tags reset-memoized ;

extra/tools/crossref/crossref.factor

@@ -3,7 +3,7 @@
 USING: arrays definitions assocs io kernel
 math namespaces prettyprint sequences strings io.styles words
 generic tools.completion quotations parser inspector
-sorting hashtables vocabs ;
+sorting hashtables vocabs parser source-files ;
 IN: tools.crossref
 
 : synopsis-alist ( definitions -- alist )
@@ -12,21 +12,6 @@ IN: tools.crossref
 : definitions. ( alist -- )
     [ write-object nl ] assoc-each ;
 
-: (method-usage) ( word generic -- methods )
-    tuck methods
-    [ second uses member? ] with subset keys
-    swap [ 2array ] curry map ;
-
-: method-usage ( word seq -- methods )
-    [ generic? ] subset [ (method-usage) ] with map concat ;
-
-: compound-usage ( words -- seq )
-    [ generic? not ] subset ;
-
-: smart-usage ( word -- definitions )
-    \ f or
-    dup usage dup compound-usage -rot method-usage append ;
-
 : usage. ( word -- )
     smart-usage synopsis-alist sort-keys definitions. ;
 

extra/tools/deploy/config/config.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: vocabs.loader io.files io kernel sequences assocs
 splitting parser prettyprint namespaces math vocabs
-hashtables ;
+hashtables tools.browser ;
 IN: tools.deploy.config
 
 SYMBOL: deploy-name

extra/trees/splay/splay.factor

@@ -7,7 +7,7 @@ IN: trees.splay
 TUPLE: splay ;
 
 : <splay> ( -- splay-tree )
-    splay construct-tree ;
+    \ splay construct-tree ;
 
 INSTANCE: splay tree-mixin
 

extra/unix/bsd/bsd.factor

@@ -5,6 +5,8 @@ USING: alien.syntax ;
 
 ! FreeBSD
 
+: MAXPATHLEN 1024 ; inline
+
 : O_RDONLY  HEX: 0000 ; inline
 : O_WRONLY  HEX: 0001 ; inline
 : O_RDWR    HEX: 0002 ; inline

extra/unix/linux/linux.factor

@@ -5,6 +5,8 @@ USING: alien.syntax ;
 
 ! Linux.
 
+: MAXPATHLEN 1024 ; inline
+
 : O_RDONLY  HEX: 0000 ; inline
 : O_WRONLY  HEX: 0001 ; inline
 : O_RDWR    HEX: 0002 ; inline

extra/unix/process/process.factor

@@ -1,6 +1,6 @@
 USING: kernel alien.c-types sequences math unix
 combinators.cleave vectors kernel namespaces continuations
-threads assocs vectors ;
+threads assocs vectors io.unix.backend ;
 
 IN: unix.process
 
@@ -8,7 +8,8 @@ IN: unix.process
 ! to implement io.launcher on Unix. User code should use
 ! io.launcher instead.
 
-: >argv ( seq -- alien ) [ malloc-char-string ] map f add >c-void*-array ;
+: >argv ( seq -- alien )
+    [ malloc-char-string ] map f add >c-void*-array ;
 
 : exec ( pathname argv -- int )
     [ malloc-char-string ] [ >argv ] bi* execv ;
@@ -29,7 +30,7 @@ IN: unix.process
     >r [ first ] [ ] bi r> exec-with-env ;
 
 : with-fork ( child parent -- )
-    fork dup zero? -roll swap curry if ; inline
+    fork dup io-error dup zero? -roll swap curry if ; inline
 
 : wait-for-pid ( pid -- status )
     0 <int> [ 0 waitpid drop ] keep *int WEXITSTATUS ;

extra/unix/unix.factor

@@ -124,6 +124,7 @@ FUNCTION: void freeaddrinfo ( addrinfo* ai ) ;
 FUNCTION: int futimes ( int id, timeval[2] times ) ;
 FUNCTION: char* gai_strerror ( int ecode ) ;
 FUNCTION: int getaddrinfo ( char* hostname, char* servname, addrinfo* hints, addrinfo** res ) ;
+FUNCTION: char* getcwd ( char* buf, size_t size ) ;
 FUNCTION: int getdtablesize ;
 FUNCTION: gid_t getegid ;
 FUNCTION: uid_t geteuid ;

extra/vocabs/monitor/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

extra/vocabs/monitor/monitor.factor

@@ -0,0 +1,14 @@
+USING: threads io.files io.monitors init kernel tools.browser ;
+IN: vocabs.monitor
+
+! Use file system change monitoring to flush the tags/authors
+! cache
+: update-thread ( monitor -- )
+    dup next-change 2drop reset-cache update-thread ;
+
+: start-update-thread
+    [
+        "" resource-path t <monitor> update-thread
+    ] in-thread ;
+
+[ start-update-thread ] "tools.browser" add-init-hook

extra/vocabs/monitor/summary.txt

@@ -0,0 +1 @@
+Use io.monitors to clear tools.browser authors/tags/summary cache

extra/webapps/planet/planet.factor

@@ -2,7 +2,7 @@ USING: sequences rss arrays concurrency kernel sorting
 html.elements io assocs namespaces math threads vocabs html
 furnace http.server.templating calendar math.parser splitting
 continuations debugger system http.server.responders
-xml.writer prettyprint ;
+xml.writer prettyprint io.server ;
 IN: webapps.planet
 
 : print-posting-summary ( posting -- )
@@ -75,13 +75,11 @@ SYMBOL: cached-postings
 
 SYMBOL: last-update
 
-: diagnostic write print flush ;
-
 : fetch-feed ( triple -- feed )
     second
-    dup "Fetching " diagnostic
+    "Fetching " over append log-message
     dup download-feed feed-entries
-    swap "Done fetching " diagnostic ;
+    "Done fetching " swap append log-message ;
 
 : <posting> ( author entry -- entry' )
     clone
@@ -89,7 +87,11 @@ SYMBOL: last-update
     [ set-entry-title ] keep ;
 
 : ?fetch-feed ( triple -- feed/f )
-    [ fetch-feed ] [ swap . error. f ] recover ;
+    [
+        fetch-feed
+    ] [
+        swap [ . error. ] with-log-stream f
+    ] recover ;
 
 : fetch-blogroll ( blogroll -- entries )
     dup 0 <column>
@@ -111,7 +113,11 @@ SYMBOL: last-update
     update-thread ;
 
 : start-update-thread ( -- )
-    [ update-thread ] in-thread ;
+    [
+        "webapps.planet" [
+            update-thread
+        ] with-logging
+    ] in-thread ;
 
 "planet" "planet-factor" "extra/webapps/planet" web-app
 

extra/windows/kernel32/kernel32.factor

@@ -892,7 +892,8 @@ FUNCTION: DWORD GetConsoleTitleW ( LPWSTR lpConsoleTitle, DWORD nSize ) ;
 ! FUNCTION: GetCurrentActCtx
 ! FUNCTION: GetCurrentConsoleFont
 ! FUNCTION: GetCurrentDirectoryA
-! FUNCTION: GetCurrentDirectoryW
+FUNCTION: BOOL GetCurrentDirectoryW ( DWORD len, LPTSTR buf ) ;
+: GetCurrentDirectory GetCurrentDirectoryW ; inline
 FUNCTION: HANDLE GetCurrentProcess ( ) ;
 ! FUNCTION: GetCurrentProcessId
 FUNCTION: HANDLE GetCurrentThread ( ) ;
@@ -1387,7 +1388,8 @@ FUNCTION: BOOL SetConsoleTitleW ( LPCWSTR lpConsoleTitle ) ;
 ! FUNCTION: SetCPGlobal
 ! FUNCTION: SetCriticalSectionSpinCount
 ! FUNCTION: SetCurrentDirectoryA
-! FUNCTION: SetCurrentDirectoryW
+FUNCTION: BOOL SetCurrentDirectoryW ( LPCWSTR lpDirectory ) ;
+: SetCurrentDirectory SetCurrentDirectoryW ; inline
 ! FUNCTION: SetDefaultCommConfigA
 ! FUNCTION: SetDefaultCommConfigW
 ! FUNCTION: SetDllDirectoryA

extra/xml/xml.factor

@@ -3,7 +3,7 @@
 USING: io io.streams.string io.files kernel math namespaces
 prettyprint sequences arrays generic strings vectors
 xml.char-classes xml.data xml.errors xml.tokenize xml.writer
-xml.utilities state-parser assocs unicode.categories ;
+xml.utilities state-parser assocs ascii ;
 IN: xml
 
 !   -- Overall parser with data tree

extra/xmode/catalog/catalog.factor

@@ -99,7 +99,7 @@ SYMBOL: rule-sets
     (load-mode) dup finalize-mode ;
 
 : reset-modes ( -- )
-    \ (load-mode) "memoize" word-prop clear-assoc ;
+    \ (load-mode) reset-memoized ;
 
 : ?glob-matches ( string glob/f -- ? )
     dup [ glob-matches? ] [ 2drop f ] if ;

vm/io.h

@@ -13,5 +13,3 @@ DECLARE_PRIMITIVE(fread);
 DECLARE_PRIMITIVE(open_file);
 DECLARE_PRIMITIVE(stat);
 DECLARE_PRIMITIVE(read_dir);
-DECLARE_PRIMITIVE(cwd);
-DECLARE_PRIMITIVE(cd);

vm/os-unix.c

@@ -115,19 +115,6 @@ DEFINE_PRIMITIVE(read_dir)
 	dpush(result);
 }
 
-DEFINE_PRIMITIVE(cwd)
-{
-	char wd[MAXPATHLEN];
-	if(getcwd(wd,MAXPATHLEN) == NULL)
-		io_error();
-	box_char_string(wd);
-}
-
-DEFINE_PRIMITIVE(cd)
-{
-	chdir(unbox_char_string());
-}
-
 DEFINE_PRIMITIVE(os_envs)
 {
 	GROWABLE_ARRAY(result);

vm/os-windows-ce.c

@@ -10,16 +10,6 @@ s64 current_millis(void)
 		| (s64)ft.dwHighDateTime<<32) - EPOCH_OFFSET) / 10000;
 }
 
-DEFINE_PRIMITIVE(cwd)
-{
-	not_implemented_error();
-}
-
-DEFINE_PRIMITIVE(cd)
-{
-	not_implemented_error();
-}
-
 char *strerror(int err)
 {
 	/* strerror() is not defined on WinCE */

vm/os-windows-nt.c

@@ -8,21 +8,6 @@ s64 current_millis(void)
 		- EPOCH_OFFSET) / 10000;
 }
 
-DEFINE_PRIMITIVE(cwd)
-{
-	F_CHAR buf[MAX_UNICODE_PATH];
-
-	if(!GetCurrentDirectory(MAX_UNICODE_PATH, buf))
-		io_error();
-
-	box_u16_string(buf);
-}
-
-DEFINE_PRIMITIVE(cd)
-{
-	SetCurrentDirectory(unbox_u16_string());
-}
-
 DEFINE_PRIMITIVE(os_envs)
 {
 	GROWABLE_ARRAY(result);

vm/os-windows-nt.h

@@ -12,7 +12,7 @@ typedef char F_SYMBOL;
 #define unbox_symbol_string unbox_char_string
 #define from_symbol_string from_char_string
 
-#define FACTOR_OS_STRING "windows"
+#define FACTOR_OS_STRING "winnt"
 #define FACTOR_DLL L"factor-nt.dll"
 #define FACTOR_DLL_NAME "factor-nt.dll"
 

vm/os-windows.h

@@ -30,6 +30,7 @@ typedef wchar_t F_CHAR;
 
 F_STRING *get_error_message(void);
 DLLEXPORT F_CHAR *error_message(DWORD id);
+void windows_error(void);
 
 void init_ffi(void);
 void ffi_dlopen(F_DLL *dll, bool error);

vm/primitives.c

@@ -109,8 +109,6 @@ void *primitives[] = {
 	primitive_millis,
 	primitive_type,
 	primitive_tag,
-	primitive_cwd,
-	primitive_cd,
 	primitive_modify_code_heap,
 	primitive_dlopen,
 	primitive_dlsym,