slightly more modular loading of subsystems

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 63ae9902b78e8adb3ec7b3af7f4943facaae7df3..332b23817dedfe42a1395ff985e2f18d0f063e1e 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -7,7 +7,6 @@
 <magnus--> http://clozure.com/cgi-bin/viewcvs.cgi/ccl/lisp-kernel/lisp-exceptions.c?rev=1.9&content-type=text/vnd.viewcvs-markup\r
 \r
 - single-stepper and variable access: wrong namespace?\r
-- [ over ] generics no-method\r
 - investigate if COPYING_GEN needs a fix\r
 - faster layout\r
 - add a socket timeout\r

diff --git a/library/bootstrap/boot-stage3.factor b/library/bootstrap/boot-stage3.factor
index 70a3ff82a5838d71013b59920de61a011bba1742..648cc41814d2170b779fbcad7eedf93a0e0d3200 100644 (file)
--- a/library/bootstrap/boot-stage3.factor
+++ b/library/bootstrap/boot-stage3.factor
@@ -73,63 +73,9 @@ t [
     "/library/tools/jedit-wire.factor"
     "/library/tools/jedit.factor"
 
-    "/library/httpd/http-common.factor"
-    "/library/httpd/mime.factor"
-    "/library/httpd/html-tags.factor"
-    "/library/httpd/html.factor"
-    "/library/httpd/responder.factor"
-    "/library/httpd/httpd.factor"
-    "/library/httpd/file-responder.factor"
-    "/library/httpd/test-responder.factor"
-    "/library/httpd/resource-responder.factor"
-    "/library/httpd/cont-responder.factor"
-    "/library/httpd/browser-responder.factor"
-    "/library/httpd/default-responders.factor"
-    "/library/httpd/http-client.factor"
-
-    "/library/sdl/sdl.factor"
-    "/library/sdl/sdl-video.factor"
-    "/library/sdl/sdl-event.factor"
-    "/library/sdl/sdl-gfx.factor"
-    "/library/sdl/sdl-keysym.factor"
-    "/library/sdl/sdl-keyboard.factor"
-    "/library/sdl/sdl-ttf.factor"
-    "/library/sdl/sdl-utils.factor"
-
-    "/library/ui/shapes.factor"
-    "/library/ui/points.factor"
-    "/library/ui/rectangles.factor"
-    "/library/ui/lines.factor"
-    "/library/ui/ellipses.factor"
-    "/library/ui/gadgets.factor"
-    "/library/ui/hierarchy.factor"
-    "/library/ui/paint.factor"
-    "/library/ui/text.factor"
-    "/library/ui/gestures.factor"
-    "/library/ui/hand.factor"
-    "/library/ui/layouts.factor"
-    "/library/ui/piles.factor"
-    "/library/ui/shelves.factor"
-    "/library/ui/borders.factor"
-    "/library/ui/stacks.factor"
-    "/library/ui/frames.factor"
-    "/library/ui/world.factor"
-    "/library/ui/labels.factor"
-    "/library/ui/buttons.factor"
-    "/library/ui/checkboxes.factor"
-    "/library/ui/line-editor.factor"
-    "/library/ui/events.factor"
-    "/library/ui/scrolling.factor"
-    "/library/ui/editors.factor"
-    "/library/ui/menus.factor"
-    "/library/ui/presentations.factor"
-    "/library/ui/tiles.factor"
-    "/library/ui/panes.factor"
-    "/library/ui/dialogs.factor"
-    "/library/ui/inspector.factor"
-    "/library/ui/init-world.factor"
-    "/library/ui/tool-menus.factor"
-    "/library/ui/ui.factor"
+    "/library/httpd/load.factor"
+    "/library/sdl/load.factor"
+    "/library/ui/load.factor"
 ] pull-in
 
 compile? [

diff --git a/library/errors.factor b/library/errors.factor
index 49d40d9d133335e912b43b7c586994ea457ff1e7..f29bcbb3e5bb09996ad9dd132f873850143fa2bb 100644 (file)
--- a/library/errors.factor
+++ b/library/errors.factor
@@ -10,7 +10,7 @@ TUPLE: no-method object generic ;
 : no-method ( object generic -- )
     #! We 2dup here to leave both values on the stack, for
     #! post-mortem inspection.
-    2dup <no-method> throw ;
+    <no-method> throw ;
 
 ! This is a very lightweight exception handling system.
 

diff --git a/library/generic/generic.factor b/library/generic/generic.factor
index bee78566854191071ba701ee7464cc48ec04e03f..98cf90f41eb6d76c63c3862b5e6dde9f3795bb3a 100644 (file)
--- a/library/generic/generic.factor
+++ b/library/generic/generic.factor
@@ -64,7 +64,7 @@ math-internals ;
 : dispatcher% "dispatcher" word-prop % ;
 
 : error-method ( generic -- method )
-    [ literal, \ no-method , ] make-list ;
+    [ dup picker% literal, \ no-method , ] make-list ;
 
 : empty-method ( generic -- method )
     dup "picker" word-prop [ dup ] = [

diff --git a/library/httpd/default-responders.factor b/library/httpd/default-responders.factor
index bb67c9f7ad2b2576b68cfc3db59f2afa5fe24e06..53fe5226ab75e725bff3992779d0758218d4b513 100644 (file)
--- a/library/httpd/default-responders.factor
+++ b/library/httpd/default-responders.factor
@@ -7,40 +7,46 @@ test-responder ;
 
 #! Remove all existing responders, and create a blank
 #! responder table.
-global [ <namespace> "httpd-responders" set ] bind
+global [
+    <namespace> "httpd-responders" set
 
-! Runs all unit tests and dumps result to the client. This uses
-! a lot of server resources, so disable it on a busy server.
-<responder> [
-    "test" "responder" set
-    [ test-responder ] "get" set
-] extend add-responder
+    ! Runs all unit tests and dumps result to the client. This uses
+    ! a lot of server resources, so disable it on a busy server.
+    <responder> [
+        "test" "responder" set
+        [ test-responder ] "get" set
+    ] extend add-responder
+    
+    ! 404 error message pages are served by this guy
+    <responder> [
+        "404" "responder" set
+        [ drop no-such-responder ] "get" set
+    ] extend add-responder
+    
+    ! Serves files from a directory stored in the "doc-root"
+    ! variable. You can set the variable in the global namespace,
+    ! or inside the responder.
+    <responder> [
+        ! "/var/www/" "doc-root" set
+        "file" "responder" set
+        [ file-responder ] "get" set
+        [ file-responder ] "post" set
+        [ file-responder ] "head" set
+    ] extend add-responder
+    
+    ! Serves Factor source code 
+    <responder> [
+        "resource" "responder" set
+        [ resource-responder ] "get" set
+    ] extend add-responder
+    
+    ! Servers Factor word definitions from the image.
+    "browser" [ f browser-responder ] install-cont-responder
+    
+    ! The root directory is served by...
+    "file" set-default-responder
 
-! 404 error message pages are served by this guy
-<responder> [
-    "404" "responder" set
-    [ drop no-such-responder ] "get" set
-] extend add-responder
-
-! Serves files from a directory stored in the "doc-root"
-! variable. You can set the variable in the global namespace,
-! or inside the responder.
-<responder> [
-    ! "/var/www/" "doc-root" set
-    "file" "responder" set
-    [ file-responder ] "get" set
-    [ file-responder ] "post" set
-    [ file-responder ] "head" set
-] extend add-responder
-
-! Serves Factor source code 
-<responder> [
-    "resource" "responder" set
-    [ resource-responder ] "get" set
-] extend add-responder
-
-! Servers Factor word definitions from the image.
-"browser" [ f browser-responder ] install-cont-responder
-
-! The root directory is served by...
-"file" set-default-responder
+    "httpd-vhosts" nest [
+        <namespace> "default" set
+    ] bind
+] bind

diff --git a/library/httpd/httpd.factor b/library/httpd/httpd.factor
index 7b159d8bb5b9a0969fa488dc4eb08965948553e1..5b814a814f67f01de335a613d1e59eac244c85a3 100644 (file)
--- a/library/httpd/httpd.factor
+++ b/library/httpd/httpd.factor
@@ -26,12 +26,16 @@ stdio streams strings threads http sequences ;
         [[ "HEAD" "head" ]]
     ] assoc [ "bad" ] unless* ;
 
-: (handle-request) ( arg cmd -- url method )
+: (handle-request) ( arg cmd -- method path )
     request-method dup "method" set swap
     prepare-url prepare-header ;
 
 : handle-request ( arg cmd -- )
-    [ (handle-request) serve-responder ] with-scope ;
+    [
+        (handle-request)
+        "Host" "header" get assoc
+        serve-responder
+    ] with-scope ;
 
 : parse-request ( request -- )
     dup log
@@ -59,11 +63,8 @@ stdio streams strings threads http sequences ;
 
 : httpd ( port -- )
     <server> "http-server" set [
-        [
-            httpd-loop
-        ] [
-            "http-server" get stream-close rethrow
-        ] catch
+        [ httpd-loop ]
+        [ "http-server" get stream-close rethrow ] catch
     ] with-logging ;
 
 : stop-httpd ( -- )

diff --git a/library/httpd/load.factor b/library/httpd/load.factor
new file mode 100644 (file)
index 0000000..33aefd0
--- /dev/null
+++ b/library/httpd/load.factor
@@ -0,0 +1,18 @@
+USING: kernel parser sequences stdio ;
+[
+    "/library/httpd/http-common.factor"
+    "/library/httpd/mime.factor"
+    "/library/httpd/html-tags.factor"
+    "/library/httpd/html.factor"
+    "/library/httpd/responder.factor"
+    "/library/httpd/httpd.factor"
+    "/library/httpd/file-responder.factor"
+    "/library/httpd/test-responder.factor"
+    "/library/httpd/resource-responder.factor"
+    "/library/httpd/cont-responder.factor"
+    "/library/httpd/browser-responder.factor"
+    "/library/httpd/default-responders.factor"
+    "/library/httpd/http-client.factor"
+] [
+    dup print run-resource
+] each

diff --git a/library/httpd/responder.factor b/library/httpd/responder.factor
index e1a676b8997aa99c58a5ead36e3302c7aa048a32..aeb2faa61953aa2d2304f055c913f7f8ad97b818 100644 (file)
--- a/library/httpd/responder.factor
+++ b/library/httpd/responder.factor
@@ -111,16 +111,16 @@ stdio streams strings ;
         ] "bad" set
     ] extend ;
 
-: get-responder ( name -- responder )
+: vhost ( name -- responder )
+    "httpd-vhosts" get hash [ "default" vhost ] unless* ;
+
+: responder ( name -- responder )
     "httpd-responders" get hash [
         "404" "httpd-responders" get hash
     ] unless* ;
 
-: default-responder ( -- responder )
-    "default" get-responder ;
-
 : set-default-responder ( name -- )
-    get-responder "default" "httpd-responders" get set-hash ;
+    responder "default" "httpd-responders" get set-hash ;
 
 : responder-argument ( argument -- argument )
     dup empty? [ drop "default-argument" get ] when ;
@@ -129,9 +129,9 @@ stdio streams strings ;
     [ responder-argument swap get call ] bind ;
 
 : serve-default-responder ( method url -- )
-    default-responder call-responder ;
+    "default" responder call-responder ;
 
-: log-responder ( url -- )
+: log-responder ( path -- )
     "Calling responder " swap append log ;
 
 : trim-/ ( url -- url )
@@ -140,21 +140,23 @@ stdio streams strings ;
 
 : serve-explicit-responder ( method url -- )
     "/" split1 dup [
-        swap get-responder call-responder
+        swap responder call-responder
     ] [
         ! Just a responder name by itself
         drop "request" get "/" append redirect drop
     ] ifte ;
 
-: serve-responder ( method url -- )
-    #! Responder URLs come in two forms:
-    #! /foo/bar... - default-responder used
+: serve-responder ( method path host -- )
+    #! Responder paths come in two forms:
+    #! /foo/bar... - default responder used
     #! /responder/foo/bar - responder foo, argument bar
-    dup log-responder trim-/ "responder/" ?head [
-        serve-explicit-responder
-    ] [
-        serve-default-responder
-    ] ifte ;
+    vhost [
+        dup log-responder trim-/ "responder/" ?head [
+            serve-explicit-responder
+        ] [
+            serve-default-responder
+        ] ifte
+    ] bind ;
 
 : no-such-responder ( -- )
     "404 No such responder" httpd-error ;

diff --git a/library/sdl/load.factor b/library/sdl/load.factor
new file mode 100644 (file)
index 0000000..af12c57
--- /dev/null
+++ b/library/sdl/load.factor
@@ -0,0 +1,13 @@
+USING: kernel parser sequences stdio ;
+[
+    "/library/sdl/sdl.factor"
+    "/library/sdl/sdl-video.factor"
+    "/library/sdl/sdl-event.factor"
+    "/library/sdl/sdl-gfx.factor"
+    "/library/sdl/sdl-keysym.factor"
+    "/library/sdl/sdl-keyboard.factor"
+    "/library/sdl/sdl-ttf.factor"
+    "/library/sdl/sdl-utils.factor"
+] [
+    dup print run-resource
+] each

diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor
index 9174b933a956a832ce9b4e23827ff7017ea4a172..02b59e73bc68acc7e9362b28de956ac7040fb253 100644 (file)
--- a/library/tools/debugger.factor
+++ b/library/tools/debugger.factor
@@ -65,12 +65,9 @@ M: kernel-error error. ( error -- )
     } nth execute ;
 
 M: no-method error. ( error -- )
-    [
-        "The generic word " ,
-        dup no-method-generic unparse ,
-        " does not have a suitable method for " ,
-        no-method-object unparse ,
-    ] make-string print ;
+    "No suitable method." print
+    "Generic word: " write dup no-method-generic .
+    "Object: " write no-method-object . ;
 
 : parse-dump ( error -- )
     "Parsing " write

diff --git a/library/ui/load.factor b/library/ui/load.factor
new file mode 100644 (file)
index 0000000..d3e3c24
--- /dev/null
+++ b/library/ui/load.factor
@@ -0,0 +1,39 @@
+USING: kernel parser sequences stdio ;
+[
+    "/library/ui/shapes.factor"
+    "/library/ui/points.factor"
+    "/library/ui/rectangles.factor"
+    "/library/ui/lines.factor"
+    "/library/ui/ellipses.factor"
+    "/library/ui/gadgets.factor"
+    "/library/ui/hierarchy.factor"
+    "/library/ui/paint.factor"
+    "/library/ui/text.factor"
+    "/library/ui/gestures.factor"
+    "/library/ui/hand.factor"
+    "/library/ui/layouts.factor"
+    "/library/ui/piles.factor"
+    "/library/ui/shelves.factor"
+    "/library/ui/borders.factor"
+    "/library/ui/stacks.factor"
+    "/library/ui/frames.factor"
+    "/library/ui/world.factor"
+    "/library/ui/labels.factor"
+    "/library/ui/buttons.factor"
+    "/library/ui/checkboxes.factor"
+    "/library/ui/line-editor.factor"
+    "/library/ui/events.factor"
+    "/library/ui/scrolling.factor"
+    "/library/ui/editors.factor"
+    "/library/ui/menus.factor"
+    "/library/ui/presentations.factor"
+    "/library/ui/tiles.factor"
+    "/library/ui/panes.factor"
+    "/library/ui/dialogs.factor"
+    "/library/ui/inspector.factor"
+    "/library/ui/init-world.factor"
+    "/library/ui/tool-menus.factor"
+    "/library/ui/ui.factor"
+] [
+    dup print run-resource
+] each