diff -ru arc3/ac.scm arc3.1/ac.scm
--- arc3/ac.scm	2009-06-29 12:54:11.000000000 -0400
+++ arc3.1/ac.scm	2009-08-04 14:51:09.000000000 -0400
@@ -3,12 +3,11 @@
 (module ac mzscheme
 
 (provide (all-defined))
-; uncomment the following require for mzscheme-4.x
-; much of Arc will work, but not mutable pairs.
-; (require rnrs/mutable-pairs-6)
 (require (lib "port.ss"))
 (require (lib "process.ss"))
 (require (lib "pretty.ss"))
+(require (lib "foreign.ss"))
+(unsafe!)
 
 ; compile an Arc expression into a Scheme expression,
 ; both represented as s-expressions.
@@ -68,7 +67,7 @@
   (and (>= i 0)
        (or (let ((c (string-ref string i)))
              (or (eqv? c #\:) (eqv? c #\~) 
-                 (eqv? c #\+)
+                 (eqv? c #\&)
                  ;(eqv? c #\_) 
                  (eqv? c #\.)  (eqv? c #\!)))
            (has-ssyntax-char? string (- i 1)))))
@@ -83,15 +82,15 @@
 ; because then _!foo becomes a function.  Maybe use <>.  For now
 ; leave this off and see how often it would have been useful.
 
-; Might want to make ~ have less precedence than +, because
-; ~foo+bar prob should mean (andf (complement foo) bar), not 
+; Might want to make ~ have less precedence than &, because
+; ~foo&bar prob should mean (andf (complement foo) bar), not 
 ; (complement (andf foo bar)).
 
 (define (expand-ssyntax sym)
   ((cond ((or (insym? #\: sym) (insym? #\~ sym)) expand-compose)
-         ((insym? #\+ sym) expand-and)
-     ;   ((insym? #\_ sym) expand-curry)
          ((or (insym? #\. sym) (insym? #\! sym)) expand-sexpr)
+         ((insym? #\& sym) expand-and)
+     ;   ((insym? #\_ sym) expand-curry)
          (#t (error "Unknown ssyntax" sym)))
    sym))
 
@@ -113,7 +112,7 @@
 
 (define (expand-and sym)
   (let ((elts (map chars->value
-                   (tokens (lambda (c) (eqv? c #\+))
+                   (tokens (lambda (c) (eqv? c #\&))
                            (symbol->chars sym)
                            '()
                            '()
@@ -238,9 +237,18 @@
         ((and (pair? x) (eqv? (car x) 'quasiquote))
          (list 'quasiquote (ac-qq1 (+ level 1) (cadr x) env)))
         ((pair? x)
-         (map (lambda (x) (ac-qq1 level x env)) x))
+         (imap (lambda (x) (ac-qq1 level x env)) x))
         (#t x)))
 
+; like map, but don't demand '()-terminated list
+
+(define (imap f l)
+  (cond ((pair? l)
+         (cons (f (car l)) (imap f (cdr l))))
+        ((null? l)
+         '())
+        (#t (f l))))
+
 ; (if) -> nil
 ; (if x) -> x
 ; (if t a ...) -> a
@@ -815,6 +823,8 @@
 
 ; (type nil) -> sym
 
+(define (exint? x) (and (integer? x) (exact? x)))
+
 (define (ar-type x)
   (cond ((ar-tagged? x)     (vector-ref x 1))
         ((pair? x)          'cons)
@@ -823,7 +833,7 @@
         ((procedure? x)     'fn)
         ((char? x)          'char)
         ((string? x)        'string)
-        ((integer? x)       'int)
+        ((exint? x)         'int)
         ((number? x)        'num)     ; unsure about this
         ((hash-table? x)    'table)
         ((output-port? x)   'output)
@@ -950,7 +960,7 @@
                       ((string)  (string x))
                       ((sym)     (string->symbol (string x)))
                       (else      (err "Can't coerce" x type))))
-    ((integer? x)   (case type
+    ((exint? x)     (case type
                       ((num)     x)
                       ((char)    (ascii->char x))
                       ((string)  (apply number->string x args))
@@ -1008,6 +1018,11 @@
                                    (let-values (((us them) (tcp-addresses out)))
                                                them))))))))
 
+; allow Arc to give up root privileges after it
+; calls open-socket. thanks, Eli!
+(define setuid (get-ffi-obj 'setuid #f (_fun _int -> _int)))
+(xdef setuid setuid)
+
 (xdef new-thread thread)
 (xdef kill-thread kill-thread)
 (xdef break-thread break-thread)
@@ -1216,15 +1231,52 @@
 (xdef scar (lambda (x val) 
               (if (string? x) 
                   (string-set! x 0 val)
-                  (set-car! x val))
+                  (x-set-car! x val))
               val))
 
 (xdef scdr (lambda (x val) 
               (if (string? x)
                   (err "Can't set cdr of a string" x)
-                  (set-cdr! x val))
+                  (x-set-cdr! x val))
               val))
 
+; decide at run-time whether the underlying mzscheme supports
+; set-car! and set-cdr!, since I can't figure out how to do it
+; at compile time.
+
+(define (x-set-car! p v)
+  (let ((fn (namespace-variable-value 'set-car! #t (lambda () #f))))
+    (if (procedure? fn)
+        (fn p v)
+        (n-set-car! p v))))
+
+(define (x-set-cdr! p v)
+  (let ((fn (namespace-variable-value 'set-cdr! #t (lambda () #f))))
+    (if (procedure? fn)
+        (fn p v)
+        (n-set-cdr! p v))))
+
+; Eli's code to modify mzscheme-4's immutable pairs.
+
+;; to avoid a malloc on every call, reuse a single pointer, but make
+;; it thread-local to avoid races
+(define ptr (make-thread-cell #f))
+(define (get-ptr)
+  (or (thread-cell-ref ptr)
+      (let ([p (malloc _scheme 1)]) (thread-cell-set! ptr p) p)))
+
+;; set a pointer to the cons cell, then dereference it as a pointer,
+;; and bang the new value in the given offset
+(define (set-ca/dr! offset who p x)
+  (if (pair? p)
+    (let ([p* (get-ptr)])
+      (ptr-set! p* _scheme p)
+      (ptr-set! (ptr-ref p* _pointer 0) _scheme offset x))
+    (raise-type-error who "pair" p)))
+
+(define (n-set-car! p x) (set-ca/dr! 1 'set-car! p x))
+(define (n-set-cdr! p x) (set-ca/dr! 2 'set-cdr! p x))
+
 ; When and if cdr of a string returned an actual (eq) tail, could
 ; say (if (string? x) (string-replace! x val 1) ...) in scdr, but
 ; for now would be misleading to allow this, because fails for cddr.
@@ -1249,7 +1301,7 @@
     val))
 
 (define (nth-set! lst n val)
-  (set-car! (list-tail lst n) val))
+  (x-set-car! (list-tail lst n) val))
 
 ; rewrite to pass a (true) gensym instead of #f in case var bound to #f
 
@@ -1264,8 +1316,9 @@
 
 (xdef trunc (lambda (x) (inexact->exact (truncate x))))
 
-(xdef exact (lambda (x) 
-               (tnil (and (integer? x) (exact? x)))))
+; bad name
+
+(xdef exact (lambda (x) (tnil (exint? x))))
 
 (xdef msec                         current-milliseconds)
 (xdef current-process-milliseconds current-process-milliseconds)
diff -ru arc3/app.arc arc3.1/app.arc
--- arc3/app.arc	2009-06-29 12:54:11.000000000 -0400
+++ arc3.1/app.arc	2009-08-04 14:51:09.000000000 -0400
@@ -373,28 +373,42 @@
     date    (or (errsafe (parse-date str)) fail)
             (err "unknown readvar type" typ)))
 
-(= fail* (uniq))
+; dates should be tagged date, and just redefine <
+
+(def varcompare (typ)
+  (if (in typ 'syms 'sexpr 'users 'toks 'bigtoks 'lines 'hexcol)
+       (fn (x y) (> (len x) (len y)))
+      (is typ 'date)
+       (fn (x y)
+         (or (no y) (and x (date< x y))))
+       (fn (x y)
+         (or (empty y) (and (~empty x) (< x y))))))
+
+
+; (= fail* (uniq))
+
+(def fail* ()) ; coudn't possibly come back from a form
   
 ; Takes a list of fields of the form (type label value view modify) and 
 ; a fn f and generates a form such that when submitted (f label newval) 
 ; will be called for each valid value.  Finally done is called.
 
 (def vars-form (user fields f done (o button "update") (o lasts))
-  (timed-aform lasts
-               (if (all [no (_ 4)] fields)
-                   (fn (req))
-                   (fn (req)
-                     (when-umatch user req
-                       (each (k v) req!args
-                         (let name (sym k)
-                           (awhen (find [is (cadr _) name] fields)
-                             ; added sho to fix bug
-                             (let (typ id val sho mod) it
-                               (when (and mod v)
-                                 (let newval (readvar typ v fail*)
-                                   (unless (is newval fail*)
-                                     (f name newval))))))))
-                       (done))))
+  (taform lasts
+          (if (all [no (_ 4)] fields)
+              (fn (req))
+              (fn (req)
+                (when-umatch user req
+                  (each (k v) req!args
+                    (let name (sym k)
+                      (awhen (find [is (cadr _) name] fields)
+                        ; added sho to fix bug
+                        (let (typ id val sho mod) it
+                          (when (and mod v)
+                            (let newval (readvar typ v fail*)
+                              (unless (is newval fail*)
+                                (f name newval))))))))
+                  (done))))
      (tab
        (showvars fields))
      (unless (all [no (_ 4)] fields)  ; no modifiable fields
@@ -415,7 +429,7 @@
 ; http://daringfireball.net/projects/markdown/syntax
 
 (def md-from-form (str (o nolinks))
-  (markdown (trim (rem #\return (esc<>& str)) 'end) 60 nolinks))
+  (markdown (trim (rem #\return (esc-tags str)) 'end) 60 nolinks))
 
 (def markdown (s (o maxurl) (o nolinks))
   (let ital nil
@@ -490,7 +504,7 @@
 ; Note that > immediately after a url (http://foo.com>) will cause
 ; an odd result, because the > gets escaped to something beginning
 ; with &, which is treated as part of the url.  Perhaps the answer
-; is just to esc<>& after markdown instead of before.
+; is just to esc-tags after markdown instead of before.
 
 ; Treats a delimiter as part of a url if it is (a) an open delimiter
 ; not followed by whitespace or eos, or (b) a close delimiter 
@@ -573,9 +587,9 @@
                  (if (in cleanlabel "am" "midnight")
                      0
                      12)
-                (is cleanlabel "pm")
-                 (+ h 12)
-                 h)
+                (is cleanlabel "am")
+                 h
+                 (+ h 12))
             60)
           m))))
 
diff -ru arc3/arc.arc arc3.1/arc.arc
--- arc3/arc.arc	2009-06-29 12:54:11.000000000 -0400
+++ arc3.1/arc.arc	2009-08-04 14:51:09.000000000 -0400
@@ -204,7 +204,8 @@
 
 (def empty (seq) 
   (or (no seq) 
-      (and (no (acons seq)) (is (len seq) 0))))
+      (and (or (is (type seq) 'string) (is (type seq) 'table))
+           (is (len seq) 0))))
 
 (def reclist (f xs)
   (and xs (or (f xs) (reclist f (cdr xs)))))
@@ -1233,7 +1234,7 @@
 
 (def inst (tem . args)
   (let x (table)
-    (each (k v) (templates* tem)
+    (each (k v) (if (acons tem) tem (templates* tem))
       (unless (no v) (= (x k) (v))))
     (each (k v) (pair args)
       (= (x k) v))
@@ -1248,7 +1249,7 @@
 ; Note: discards fields not defined by the template.
 
 (def templatize (tem raw)
-  (with (x (inst tem) fields (templates* tem))
+  (with (x (inst tem) fields (if (acons tem) tem (templates* tem)))
     (each (k v) raw
       (when (assoc k fields)
         (= (x k) v)))
diff -ru arc3/how-to-run-news arc3.1/how-to-run-news
--- arc3/how-to-run-news	2009-06-29 12:54:11.000000000 -0400
+++ arc3.1/how-to-run-news	2009-08-04 14:51:09.000000000 -0400
@@ -1,8 +1,8 @@
 To run News:
 
-tar xvf arc3.tar
+tar xvf arc3.1.tar
 
-cd arc3
+cd arc3.1
 
 mkdir arc
 
diff -ru arc3/html.arc arc3.1/html.arc
--- arc3/html.arc	2009-06-29 12:54:11.000000000 -0400
+++ arc3.1/html.arc	2009-08-04 14:51:09.000000000 -0400
@@ -61,6 +61,9 @@
 (def opsel (key val)
   `(if ,val (pr " selected")))
 
+(def opcheck (key val)
+  `(if ,val (pr " checked")))
+
 (def opesc (key val)
   `(awhen ,val
      (pr ,(string " " key "=\""))
@@ -106,8 +109,9 @@
 (attribute input      size           opnum)
 (attribute input      type           opsym)
 (attribute input      value          opesc)
-(attribute option     selected       opsel)
+(attribute input      checked        opcheck)
 (attribute select     name           opstring)
+(attribute option     selected       opsel)
 (attribute table      bgcolor        opcolor)
 (attribute table      border         opnum)
 (attribute table      cellpadding    opnum)
@@ -343,7 +347,7 @@
                   #\&  "&#38;"
                         c)))))
 
-(def esc<>& (str)
+(def esc-tags (str)
   (tostring 
     (each c str
       (pr (case c #\<  "&#60;" 
diff -ru arc3/news.arc arc3.1/news.arc
--- arc3/news.arc	2009-06-29 12:54:11.000000000 -0400
+++ arc3.1/news.arc	2009-08-04 14:51:09.000000000 -0400
@@ -191,7 +191,7 @@
 (def load-item (id)
   (let i (temload 'item (+ storydir* id))
     (= (items* id) i)
-    (awhen (and (astory+live i) (check i!url ~blank))
+    (awhen (and (astory&live i) (check i!url ~blank))
       (register-url i it))
     i))
 
@@ -222,7 +222,7 @@
 ; because people try e.g. item?id=363/blank.php
 
 (def safe-item (id)
-  (ok-id+item (if (isa id 'string) (saferead id) id)))
+  (ok-id&item (if (isa id 'string) (saferead id) id)))
 
 (def ok-id (id) 
   (and (exact id) (<= 1 id maxid*)))
@@ -254,7 +254,7 @@
            ,@body)))))
 
 (def loaded-items (test)
-  (accum a (each-loaded-item i (test+a i))))
+  (accum a (each-loaded-item i (test&a i))))
 
 (def newslog args (apply srvlog 'news args))
 
@@ -271,7 +271,7 @@
   (* (/ (let base (- (scorefn s) 1)
           (if (> base 0) (expt base .8) base))
         (expt (/ (+ (item-age s) timebase*) 60) gravity))
-     (if (no (in s!type 'story 'poll))  1
+     (if (no (in s!type 'story 'poll))  .5
          (blank s!url)                  nourl-factor*
          (lightweight s)                (min lightweight-factor* 
                                              (contro-factor s))
@@ -287,7 +287,8 @@
 (disktable lightweights* (+ newsdir* "lightweights"))
 
 (def lightweight (s)
-  (or (mem 'rally s!keys)  ; title is a rallying cry
+  (or s!dead
+      (mem 'rally s!keys)  ; title is a rallying cry
       (mem 'image s!keys)  ; post is mainly image(s)
       (lightweights* (sitename s!url))
       (lightweight-url s!url)))
@@ -719,13 +720,13 @@
                (if (profile subject)
                    (do (killallby subject)
                        (submitted-page user subject))
-                   (admin+newsadmin-page user))))
+                   (admin&newsadmin-page user))))
       (single-input "" 'id 20 "kill all by"))
     (br2)
     (aform (fn (req)
              (let user (get-user req)
                (set-ip-ban user (arg req "ip") t)
-               (admin+newsadmin-page user)))
+               (admin&newsadmin-page user)))
       (single-input "" 'ip 20 "ban ip"))))
 
 
@@ -866,13 +867,14 @@
   (bestn n (compare > realscore) (visible user stories*)))
 
 
-(newsop noobs () (noobpage user))
+(newsop noobstories () (noobspage user stories*))
+(newsop noobcomments () (noobspage user comments*))
 
-(def noobpage (user)
-  (listpage user (msec) (noobstories user maxend*) "noobs" "New Accounts"))
+(def noobspage (user source)
+  (listpage user (msec) (noobs user maxend* source) "noobs" "New Accounts"))
 
-(def noobstories (user n)
-  (retrieve n [and (cansee user _) (bynoob _)] stories*))
+(def noobs (user n source)
+  (retrieve n [and (cansee user _) (bynoob _)] source))
 
 (def bynoob (i)
   (< (- (user-age i!by) (item-age i)) 2880))
@@ -894,7 +896,8 @@
       (row (link "best")         "Highest voted recent links.")
       (row (link "active")       "Most active current discussions.")
       (row (link "bestcomments") "Highest voted recent comments.")
-      (row (link "noobs")        "Submissions from new accounts.")
+      (row (link "noobstories")  "Submissions from new accounts.")
+      (row (link "noobcomments") "Comments from new accounts.")
       (when (admin user)
         (map row:link
              '(optimes topips flagged killed badguys badlogins goodlogins)))
@@ -1035,7 +1038,7 @@
   (when (and i!deleted (admin user))
     (pr " [deleted] ")))
 
-(= downvote-threshold* 100 downvote-time* 1440)
+(= downvote-threshold* 200 downvote-time* 1440)
 
 (= votewid* 14)
       
@@ -1079,14 +1082,14 @@
              (if user (+ "&by=" user "&auth=" (user->cookie* user)))
              "&whence=" (urlencode whence)))
 
-(= lowest-score* -8)
+(= lowest-score* -4)
 
 ; Not much stricter than whether to generate the arrow.  Further tests 
 ; applied in vote-for.
 
 (def canvote (user i dir)
   (and user
-       (news-type+live i)
+       (news-type&live i)
        (or (is dir 'up) (> i!score lowest-score*))
        (no ((votes user) i!id))
        (or (is dir 'up)
@@ -1205,6 +1208,8 @@
     (pr bar*)
     (onlink "add choice" (add-pollopt-page p user))))
 
+; reset later
+
 (= flag-threshold* 30 flag-kill-threshold* 7 many-flags* 1)
 
 ; Un-flagging something doesn't unkill it, if it's now no longer
@@ -1218,6 +1223,7 @@
     (w/rlink (do (togglemem user i!flags)
                  (when (and (~mem 'nokill i!keys)
                             (len> i!flags flag-kill-threshold*)
+                            (< (realscore i) 10)
                             (~find admin:!2 i!vote))
                    (kill i 'flags))
                  whence)
@@ -1364,7 +1370,7 @@
         ; canvote protects against sockpuppet downvote of comments 
         (when (and (is dir 'up) (possible-sockpuppet user))
           (++ i!sockvotes))
-        (metastory+adjust-rank i)
+        (metastory&adjust-rank i)
         (unless (or (author user i)
                     (and (is ip i!ip) (~editor user))
                     (is i!type 'pollopt))
@@ -1528,8 +1534,8 @@
            (< (karma user) new-karma-threshold*))
        (len> (recent-items [or (author user _) (is _!ip ip)] 180)
              (if (is kind 'story)
-                 (if (ignored user) 0 1)
-                 (if (ignored user) 1 10)))))
+                 (if (bad-user user) 0 1)
+                 (if (bad-user user) 1 10)))))
 
 ; Note that by deliberate tricks, someone could submit a story with a 
 ; blank title.
@@ -1553,18 +1559,17 @@
          (if (isa (saferead (car toks)) 'int)
              (tostring (prall toks "" "."))
              (let (t1 t2 t3 . rest) toks  
-               (if (and t3 (or (mem t1 multi-tld-countries*) 
-                               (mem t2 long-domains*)))
+               (if (and (~in t3 nil "www")
+                        (or (mem t1 multi-tld-countries*) 
+                            (mem t2 long-domains*)))
                    (+ t3 "." t2 "." t1)
                    (and t2 (+ t2 "." t1))))))))
 
-; Minor bug: can have both google.at and google.co.at.  Same for jp.
-
 (= multi-tld-countries* '("uk" "jp" "au" "in" "ph" "tr" "za" "my" "nz" "br" 
                           "mx" "th" "sg" "id" "pk" "eg" "il" "at" "pl"))
 
 (= long-domains* '("blogspot" "wordpress" "livejournal" "blogs" "typepad" 
-                   "weebly" "blog-city" "supersized"
+                   "weebly" "posterous" "blog-city" "supersized" "dreamhosters"
                    ; "sampasite"  "multiply" "wetpaint" ; all spam, just ban
                    "eurekster" "blogsome" "edogo" "blog" "com"))
 
@@ -1823,7 +1828,7 @@
 (= commentable-threshold* (* 60 24 45))
 
 (def comments-active (i)
-  (and (live+commentable i)
+  (and (live&commentable i)
        (live (superparent i))
        (or (< (item-age i) commentable-threshold*)
            (mem 'commentable i!keys))))
@@ -1932,7 +1937,7 @@
                      (= (i name) val)))
                  (fn () (if (admin user) (pushnew 'locked i!keys))
                         (save-item i)
-                        (metastory+adjust-rank i)
+                        (metastory&adjust-rank i)
                         (wipe (comment-cache* i!id))
                         (edit-page user i)))
       (hook 'edit user i))))
@@ -1992,11 +1997,13 @@
        (flink [msgpage user toofast*])
        (atlet c (create-comment parent (md-from-form text) user ip)
          (comment-ban-test user c ip text comment-kill* comment-ignore*)
-         (when (or (ignored user) (< (karma user) comment-threshold*))
-           (kill c 'ignored/karma))
+         (if (bad-user user) (kill c 'ignored/karma))
          (submit-item user c)
          whence)))
 
+(def bad-user (u)
+  (or (ignored u) (< (karma u) comment-threshold*)))
+
 (def create-comment (parent text user ip)
   (newslog ip user 'comment (parent 'id))
   (let c (inst 'item 'type 'comment 'id (new-item-id)
diff -ru arc3/srv.arc arc3.1/srv.arc
--- arc3/srv.arc	2009-06-29 12:54:11.000000000 -0400
+++ arc3.1/srv.arc	2009-08-04 14:51:09.000000000 -0400
@@ -11,6 +11,7 @@
   (ensure-srvdirs)
   (map [apply new-bgthread _] pending-bgthreads*)
   (w/socket s port
+    (setuid 2) ; XXX switch from root to pg
     (prn "ready to serve port " port)
     (flushout)
     (= currsock* s)
@@ -453,7 +454,7 @@
 ; Like aform except creates a fnid that will last for lasts seconds
 ; (unless the server is restarted).
 
-(mac timed-aform (lasts f . body)
+(mac taform (lasts f . body)
   (w/uniq (gl gf gi ga)
     `(withs (,gl ,lasts
              ,gf (fn (,ga) (prn) (,f ,ga)))
Files arc3/static/arc.png and arc3.1/static/arc.png differ
diff -ru arc3/strings.arc arc3.1/strings.arc
--- arc3/strings.arc	2009-06-29 12:54:11.000000000 -0400
+++ arc3.1/strings.arc	2009-08-04 14:51:09.000000000 -0400
@@ -44,6 +44,15 @@
            (a (cut s (+ p 1)))))
      (cons -1 (positions #\newline s)))))
 
+(def slices (s test)
+  (accum a
+    ((afn ((p . ps))
+       (if ps
+           (do (a (cut s (+ p 1) (car ps)))
+               (self ps))
+           (a (cut s (+ p 1)))))
+     (cons -1 (positions test s)))))
+
 ; > (require (lib "uri-codec.ss" "net"))
 ;> (form-urlencoded-decode "x%ce%bbx")
 ;"xλx"
@@ -149,7 +158,7 @@
 
 (def nonblank (s) (unless (blank s) s))
 
-(def trim (s where (o test whitec))
+(def trim (s (o where 'both) (o test whitec))
   (withs (f   (testify test)
            p1 (pos ~f s))
     (if p1
