working on http server, word of the day

TODO.FACTOR.txt

@@ -22,9 +22,11 @@
 - vector-each/map examples
 - string construction examples
 - string construction ackward
+- read#
 
 + tests:
 
+- finish split
 - java factor: equal numbers have non-equal hashcodes!
 - sbuf=
 - vector-hashcode
@@ -52,7 +54,6 @@ ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable
 - errors: don't show .factor-rc
 - handle division by zero
 - decide if overflow is a fatal error
-- f >n: crashes
 - parsing should be parsing
 - describe-word
 - contains ==> contains?

library/errors.factor

@@ -42,21 +42,23 @@ USE: vectors
 : save-error ( error -- )
     #! Save the stacks and parser state for post-mortem
     #! inspection after an error.
-    "pos" get
-    "line" get
-    "line-number" get
-    "parse-name" get
-    global [
-        "error-parse-name" set
-        "error-line-number" set
-        "error-line" set
-        "error-pos" set
-        "error" set
-        datastack >pop> "error-datastack" set
-        callstack >pop> >pop> "error-callstack" set
-        namestack "error-namestack" set
-        catchstack "error-catchstack" set
-    ] bind ;
+    namespace [
+        "pos" get
+        "line" get
+        "line-number" get
+        "parse-name" get
+        global [
+            "error-parse-name" set
+            "error-line-number" set
+            "error-line" set
+            "error-pos" set
+            "error" set
+            datastack >pop> "error-datastack" set
+            callstack >pop> >pop> "error-callstack" set
+            namestack "error-namestack" set
+            catchstack "error-catchstack" set
+        ] bind
+    ] when* ;
 
 : catch ( try catch -- )
     #! Call the try quotation. If an error occurs restore the

library/hashtables.factor

@@ -45,7 +45,7 @@ USE: vectors
     #! array index is determined using a hash function, and the
     #! buckets are associative lists which are searched
     #! linearly. The number of buckets must be a power of two.
-    dup <vector> dup >r set-vector-length r> ;
+    empty-vector ;
 
 : (hashcode) ( key table -- index )
     #! Compute the index of the bucket for a key.

library/httpd/http-common.factor

@@ -33,7 +33,6 @@ USE: lists
 USE: logging
 USE: namespaces
 USE: parser
-USE: regexp
 USE: stack
 USE: stdio
 USE: streams
@@ -55,16 +54,15 @@ USE: url-encoding
     dup log-error
     <% dup "text/html" response % error-body % %> print ;
 
-: read-header-iter ( alist -- alist )
-    read dup "" = [
-        drop
-    ] [
-        "(.+?): (.+)" groups [ uncons car cons swons ]  when*
-        read-header-iter
-    ] ifte ;
+: header-line ( alist line -- alist )
+    ": " split1 dup [ transp acons ] [ 2drop ] ifte ;
+
+: (read-header) ( alist -- alist )
+    read dup
+    f-or-"" [ drop ] [ header-line (read-header) ] ifte ;
 
 : read-header ( -- alist )
-    [ ] read-header-iter ;
+    [ ] (read-header) ;
 
 : content-length ( alist -- length )
     "Content-Length" swap assoc dec> ;

library/httpd/responder.factor

@@ -67,9 +67,6 @@ USE: httpd
 : no-such-responder ( name -- )
     "404 no such responder: " swap cat2 httpd-error ;
 
-: bad-responder-query ( argument -- )
-    "404 missing parameter" httpd-error ;
-
 : trim-/ ( url -- url )
     #! Trim a leading /, if there is one.
     dup "/" str-head? dup [ nip ] [ drop ] ifte ;
@@ -78,14 +75,9 @@ USE: httpd
     "Calling responder " swap cat2 log ;
 
 : serve-responder ( argument method -- )
-    swap
-    trim-/
-    dup "/" split1 dup [
-        nip unswons dup get-responder dup [
-            swap log-responder call-responder
-        ] [
-            drop nip nip no-such-responder
-        ] ifte
+    over log-responder
+    swap trim-/ "/" split1 over get-responder dup [
+        rot drop call-responder
     ] [
-        3drop bad-responder-query
+        2drop no-such-responder drop
     ] ifte ;

library/platform/native/boot.factor

@@ -80,6 +80,8 @@ primitives,
     "/library/words.factor"
     "/library/httpd/html.factor"
     "/library/httpd/url-encoding.factor"
+    "/library/httpd/http-common.factor"
+    "/library/httpd/responder.factor"
     "/library/math/arc-trig-hyp.factor"
     "/library/math/arithmetic.factor"
     "/library/math/list-math.factor"
@@ -93,7 +95,6 @@ primitives,
     "/library/platform/native/errors.factor"
     "/library/platform/native/io-internals.factor"
     "/library/platform/native/stream.factor"
-    "/library/platform/native/kernel.factor"
     "/library/platform/native/namespaces.factor"
     "/library/platform/native/strings.factor"
     "/library/platform/native/parse-numbers.factor"
@@ -105,6 +106,7 @@ primitives,
     "/library/platform/native/stack.factor"
     "/library/platform/native/words.factor"
     "/library/platform/native/vectors.factor"
+    "/library/platform/native/kernel.factor"
     "/library/platform/native/vocabularies.factor"
     "/library/platform/native/unparser.factor"
     "/library/platform/native/cross-compiler.factor"

library/strings.factor

@@ -127,18 +127,14 @@ USE: stack
         swap [ str// ] dip split cons
     ] ifte ;
 
-: split1 ( string split -- pair )
+: split1 ( string split -- before after )
     #! The car of the pair is the string up to the first
     #! occurrence of split; the cdr is the remainder of
     #! the string.
-    dupd index-of dup -1 = [
-        drop dup str-length 0 = [
-            drop f
-        ] [
-            unit
-        ] ifte
+    2dup index-of dup -1 = [
+        2drop f
     ] [
-        str// cons
+        swapd str/ rot str-length str/ nip
     ] ifte ;
 
 : max-str-length ( list -- len )

library/test/crashes.factor

@@ -9,7 +9,5 @@ USE: test
 ! This should run without issue (and tests nothing useful)
 ! in Java Factor
 
-! This was bloody stupid of me
 "20 <sbuf> \"foo\" set" eval
 "garbage-collection" eval
-

library/test/httpd/httpd.factor

@@ -1,24 +1,46 @@
 IN: scratchpad
 USE: httpd
 USE: httpd-responder
+USE: logging
+USE: namespaces
 USE: stdio
 USE: test
 USE: url-encoding
 
-"HTTPD tests" print
+[ "HTTP/1.0 404\nContent-Type: text/html\n" ]
+[ "404" "text/html" response ] unit-test
 
-[ "hello world"   ] [ "hello+world"    ] [ url-decode ] test-word
-[ "hello world"   ] [ "hello%20world"  ] [ url-decode ] test-word
-[ " ! "           ] [ "%20%21%20"      ] [ url-decode ] test-word
-[ "hello world"   ] [ "hello world%"   ] [ url-decode ] test-word
-[ "hello world"   ] [ "hello world%x"  ] [ url-decode ] test-word
-[ "hello%20world" ] [ "hello world"    ] [ url-encode ] test-word
-[ "%20%21%20"     ] [ " ! "            ] [ url-encode ] test-word
+[ 5430 ]
+[ f "Content-Length: 5430" header-line content-length ] unit-test
+
+
+[ "hello world"   ] [ "hello+world"    url-decode ] unit-test
+[ "hello world"   ] [ "hello%20world"  url-decode ] unit-test
+[ " ! "           ] [ "%20%21%20"      url-decode ] unit-test
+[ "hello world"   ] [ "hello world%"   url-decode ] unit-test
+[ "hello world"   ] [ "hello world%x"  url-decode ] unit-test
+[ "hello%20world" ] [ "hello world"    url-encode ] unit-test
+[ "%20%21%20"     ] [ " ! "            url-encode ] unit-test
 
 ! These make sure the words work, and don't leave
 ! extra crap on the stakc
 [ ] [ "404 not found" ] [ httpd-error ] test-word
 
+[ "arg" ] [
+    [
+        "arg" "default-argument" set
+        "" responder-argument
+    ] with-scope
+] unit-test
+
+[ "inspect/global" ] [ "/inspect/global" trim-/ ] unit-test
+
+[ ] [
+    [
+        "unit/test" log-responder
+    ] with-logging
+] unit-test
+
 [ ] [ "/" "get" ] [ serve-responder ] test-word
 [ ] [ "" "get" ] [ serve-responder ] test-word
 [ ] [ "test" "get" ] [ serve-responder ] test-word

library/test/test.factor

@@ -51,7 +51,7 @@ USE: vocabularies
     "Running Factor test suite..." print
     "vocabularies" get [ f "scratchpad" set ] bind
     [
-        "garbage-collection"
+        "crashes"
         "lists/cons"
         "lists/lists"
         "lists/assoc"