Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

strip trailing whitespace

  • Loading branch information...
commit 76a61293bc7bc49ef8b57641ad5b346f527ec0ee 1 parent 0efaa1b
Kartik Agaram akkartik authored
2  README.markdown
View
@@ -1,7 +1,7 @@
Anarki: a fork of PG's and RTM's Arc Lisp
Anarki is a publically modifiable fork of Paul Graham's and Robert Morris's
-project to create a modern lisp for hackers. Anarki is currently forked
+project to create a modern lisp for hackers. Anarki is currently forked
from Arc 3.1 and can run on top of the latest PLT (Racket) Scheme, instead
of the severely out-dated mzscheme 372.
14 ac.scm
View
@@ -24,7 +24,7 @@
(defarc arc-name scheme-name)))
((defarc arc-name scheme-name)
(define (scheme-name . args)
-
+
; The following 'parameterize has been added. See the note at
; 'arc-exec, below.
;
@@ -432,7 +432,7 @@
((eqv? a 't) (err "Can't rebind t"))
((lex? a env) `(set! ,a zz))
((ac-defined-var? a) `(,(ac-global-name a) zz))
-
+
; The following has been changed from
; 'namespace-set-variable-value! to 'set!. See
; the note at 'arc-exec, below.
@@ -487,7 +487,7 @@
((and (pair? fn) (eqv? (car fn) 'fn))
`(,(ac fn env) ,@(ac-args (cadr fn) args env)))
((and (ar-bflag 'direct-calls) (symbol? fn) (not (lex? fn env)) (bound? fn)
-
+
; The following has been changed from using
; 'namespace-variable-value to using 'arc-eval. See
; the note at 'arc-exec, below.
@@ -507,7 +507,7 @@
(define (ac-macro? fn)
(if (symbol? fn)
-
+
; The following has been changed from using
; 'namespace-variable-value to using 'bound? and 'arc-eval. See
; the note at 'arc-exec, below.
@@ -927,8 +927,8 @@
(xdef writebytes (lambda (bs . args)
(write-bytes (list->bytes (ac-denil bs))
- (if (pair? args)
- (car args)
+ (if (pair? args)
+ (car args)
(current-output-port)))
bs))
@@ -1218,7 +1218,7 @@
(when interactive?
(arc-write (ac-denil val))
(newline))
-
+
; The following 'parameterize has been added. See the
; note at 'arc-exec, above.
;
76 app.arc
View
@@ -1,6 +1,6 @@
; Application Server. Layer inserted 2 Sep 06.
-; ideas:
+; ideas:
; def a general notion of apps of which prompt is one, news another
; give each user a place to store data? A home dir?
@@ -27,7 +27,7 @@
(= cookie->user* (table) user->cookie* (table) logins* (table))
-(def get-user (req)
+(def get-user (req)
(let u (aand (alref req!cooks "user") (cookie->user* (sym it)))
(when u (= (logins* u) req!ip))
u))
@@ -37,7 +37,7 @@
(do ,@body)
(mismatch-message)))
-(def mismatch-message ()
+(def mismatch-message ()
(prn "Dead link: users don't match."))
(mac when-umatch/r (user req . body)
@@ -55,17 +55,17 @@
(mac urform (user req after . body)
`(arform (fn (,req)
- (when-umatch/r ,user ,req
+ (when-umatch/r ,user ,req
,after))
,@body))
; Like onlink, but checks that user submitting the request is the
-; same it was generated for. For extra protection could log the
+; same it was generated for. For extra protection could log the
; username and ip addr of every genlink, and check if they match.
-(mac ulink (user text . body)
+(mac ulink (user text . body)
(w/uniq req
- `(linkf ,text (,req)
+ `(linkf ,text (,req)
(when-umatch ,user ,req ,@body))))
@@ -82,7 +82,7 @@
(def user-exists (u) (and u (hpasswords* u) u))
(def admin-page (user . msg)
- (whitepage
+ (whitepage
(prbold "Admin: ")
(hspace 20)
(pr user " | ")
@@ -127,7 +127,7 @@
(def disable-acct (user)
(set-pw user (rand-string 20))
(logout-user user))
-
+
(def set-pw (user pw)
(= (hpasswords* user) (and pw (shash pw)))
(save-table hpasswords* hpwfile*))
@@ -140,8 +140,8 @@
; switch is one of: register, login, both
; afterward is either a function on the newly created username and
-; ip address, in which case it is called to generate the next page
-; after a successful login, or a pair of (function url), which means
+; ip address, in which case it is called to generate the next page
+; after a successful login, or a pair of (function url), which means
; call the function, then redirect to the url.
; classic example of something that should just "return" a val
@@ -214,7 +214,7 @@
(do (enq-limit record bad-logins*)
nil))))
-; Create a file in case people have quote chars in their pws. I can't
+; Create a file in case people have quote chars in their pws. I can't
; believe there's no way to just send the chars.
(def shash (str)
@@ -234,13 +234,13 @@
(def bad-newacct (user pw)
(if (no (goodname user 2 15))
- "Usernames can only contain letters, digits, dashes and
- underscores, and should be between 2 and 15 characters long.
+ "Usernames can only contain letters, digits, dashes and
+ underscores, and should be between 2 and 15 characters long.
Please choose another."
(username-taken user)
"That username is taken. Please choose another."
(or (no pw) (< (len pw) 4))
- "Passwords should be a least 4 characters long. Please
+ "Passwords should be a least 4 characters long. Please
choose another."
nil))
@@ -269,7 +269,7 @@
(= formwid* 60 bigformwid* 80 numwid* 16 formatdoc-url* nil)
-; Eventually figure out a way to separate type name from format of
+; Eventually figure out a way to separate type name from format of
; input field, instead of having e.g. toks and bigtoks
(def varfield (typ id val)
@@ -279,9 +279,9 @@
(gentag input type 'text name id value val size numwid*)
(in typ 'users 'toks)
(gentag input type 'text name id value (tostring (apply prs val))
- size formwid*)
+ size formwid*)
(is typ 'sexpr)
- (gentag input type 'text name id
+ (gentag input type 'text name id
value (tostring (map [do (write _) (sp)] val))
size formwid*)
(in typ 'syms 'text 'doc 'mdtext 'mdtext2 'lines 'bigtoks)
@@ -294,9 +294,9 @@
(no val)
""
val)
- (tag (textarea cols (if (is typ 'doc) bigformwid* formwid*)
+ (tag (textarea cols (if (is typ 'doc) bigformwid* formwid*)
rows (needrows text formwid* 4)
- wrap 'virtual
+ wrap 'virtual
style (if (is typ 'doc) "font-size:8.5pt")
name id)
(prn) ; needed or 1 initial newline gets chopped off
@@ -342,7 +342,7 @@
; even in the parsing of http requests, in the server.
; Need the calls to striptags so that news users can't get html
-; into a title or comment by editing it. If want a form that
+; into a title or comment by editing it. If want a form that
; can take html, just create another typ for it.
(def readvar (typ str (o fail nil))
@@ -388,9 +388,9 @@
; (= 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)
+
+; 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))
@@ -414,14 +414,14 @@
(unless (all [no (_ 4)] fields) ; no modifiable fields
(br)
(submit button))))
-
+
(def showvars (fields (o liveurls))
(each (typ id val view mod question) fields
(when view
(when question
(tr (td (prn question))))
(tr (unless question (tag (td valign 'top) (pr id ":")))
- (td (if mod
+ (td (if mod
(varfield typ id val)
(varline typ id val liveurls))))
(prn))))
@@ -445,14 +445,14 @@
(do (unless (is i 0) (pr "<p>"))
(= i (- newi 1)))
(and (is (s i) #\*)
- (or ital
- (atend i s)
+ (or ital
+ (atend i s)
(and (~whitec (s (+ i 1)))
(pos #\* s (+ i 1)))))
(do (pr (if ital "</i>" "<i>"))
(= ital (no ital)))
(and (no nolinks)
- (or (litmatch "http://" s i)
+ (or (litmatch "http://" s i)
(litmatch "https://" s i)))
(withs (n (urlend s i)
url (clean-url (cut s i n)))
@@ -485,7 +485,7 @@
(def next-parabreak (s i)
(unless (atend i s)
- (aif (parabreak s i)
+ (aif (parabreak s i)
(list i it)
(next-parabreak s (+ i 1)))))
@@ -507,14 +507,14 @@
; 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
+; not followed by whitespace or eos, or (b) a close delimiter
; balancing a previous open delimiter.
(def urlend (s i (o indelim))
(let c (s i)
(if (atend i s)
- (if ((orf punc whitec opendelim) c)
- i
+ (if ((orf punc whitec opendelim) c)
+ i
(closedelim c)
(if indelim (+ i 1) i)
(+ i 1))
@@ -528,7 +528,7 @@
(and indelim (no (closedelim c)))))))))
(def opendelim (c) (in c #\< #\( #\[ #\{))
-
+
(def closedelim (c) (in c #\> #\) #\] #\}))
@@ -545,7 +545,7 @@
(tostring
(forlen i s
(if (litmatch "<p>" s i)
- (do (++ i 2)
+ (do (++ i 2)
(unless (is i 2) (pr "\n\n")))
(litmatch "<i>" s i)
(do (++ i 2) (pr #\*))
@@ -640,14 +640,14 @@
(withs ((ds ms ys) toks
d (int ds))
(aif (monthnum ms)
- (list (or (errsafe (int ys)) ynow)
+ (list (or (errsafe (int ys)) ynow)
it
d)
nil))
(monthnum (car toks))
(let (ms ds ys) toks
(aif (errsafe (int ds))
- (list (or (errsafe (int ys)) ynow)
+ (list (or (errsafe (int ys)) ynow)
(monthnum (car toks))
it)
nil))
@@ -663,7 +663,7 @@
(mac defopl (name parm . body)
`(defop ,name ,parm
(if (get-user ,parm)
- (do ,@body)
+ (do ,@body)
(login-page 'both
"You need to be logged in to do that."
(list (fn (u ip))
158 arc.arc
View
@@ -13,12 +13,12 @@
; warn when shadow a global name
; some simple regexp/parsing plan
-; compromises in this implementation:
+; compromises in this implementation:
; no objs in code
; (mac testlit args (listtab args)) breaks when called
; separate string type
; (= (cdr (cdr str)) "foo") couldn't work because no way to get str tail
-; not sure this is a mistake; strings may be subtly different from
+; not sure this is a mistake; strings may be subtly different from
; lists of chars
(assign current-load-file* "arc.arc")
@@ -81,8 +81,8 @@
; (def list args args)
(def copylist (xs)
- (if (no xs)
- nil
+ (if (no xs)
+ nil
(cons (car xs) (copylist (cdr xs)))))
(def list args (copylist args))
@@ -92,7 +92,7 @@
; Maybe later make this internal. Useful to let xs be a fn?
(def map1 (f xs)
- (if (no xs)
+ (if (no xs)
nil
(cons (f (car xs)) (map1 f (cdr xs)))))
@@ -144,9 +144,9 @@
`(with (,var ,val) ,@body))
(mac withs (parms . body)
- (if (no parms)
+ (if (no parms)
`(do ,@body)
- `(let ,(car parms) ,(cadr parms)
+ `(let ,(car parms) ,(cadr parms)
(withs ,(cddr parms) ,@body))))
(mac ret (var val . body)
@@ -157,8 +157,8 @@
(def join args
(if (no args)
nil
- (let a (car args)
- (if (no a)
+ (let a (car args)
+ (if (no a)
(apply join (cdr args))
(cons (car a) (apply join (cdr a) (cdr args)))))))
@@ -195,7 +195,7 @@
(def complement (f)
(fn args (no (apply f args))))
-(def rev (xs)
+(def rev (xs)
((afn (xs acc)
(if (no xs)
acc
@@ -227,9 +227,9 @@
; bootstrapping version; overloaded later as a generic function
(def iso (x y)
(or (is x y)
- (and (acons x)
- (acons y)
- (iso (car x) (car y))
+ (and (acons x)
+ (acons y)
+ (iso (car x) (car y))
(iso (cdr x) (cdr y)))))
(mac when (test . body)
@@ -244,8 +244,8 @@
(when ,gp ,@body (,gf ,test)))
,test)))
-(def empty (seq)
- (or (no seq)
+(def empty (seq)
+ (or (no seq)
(and (or (is (type seq) 'string) (is (type seq) 'table))
(is (len seq) 0))))
@@ -271,9 +271,9 @@
(reclist f:car seq)
(recstring f:seq seq))))
-(def all (test seq)
+(def all (test seq)
(~some (complement (testify test)) seq))
-
+
(def mem (test seq)
(let f (testify test)
(reclist [if (f:car _) _] seq)))
@@ -300,7 +300,7 @@
(def map (f . seqs)
- (if (some [isa _ 'string] seqs)
+ (if (some [isa _ 'string] seqs)
(withs (n (apply min (map len seqs))
new (newstring n))
((afn (i)
@@ -309,10 +309,10 @@
(do (sref new (apply f (map [_ i] seqs)) i)
(self (+ i 1)))))
0))
- (no (cdr seqs))
+ (no (cdr seqs))
(map1 f (car seqs))
((afn (seqs)
- (if (some no seqs)
+ (if (some no seqs)
nil
(cons (apply f (map1 car seqs))
(self (map1 cdr seqs)))))
@@ -347,7 +347,7 @@
(mac defs args
`(do ,@(map [cons 'def _] (tuples args 3))))
-(def caris (x val)
+(def caris (x val)
(and (acons x) (is (car x) val)))
(def warn (msg . args)
@@ -360,7 +360,7 @@
(mac atlet args
`(atomic (let ,@args)))
-
+
(mac atwith args
`(atomic (with ,@args)))
@@ -384,7 +384,7 @@
(mac defset (name parms . body)
(w/uniq gexpr
- `(sref setter
+ `(sref setter
(fn (,gexpr)
(let ,parms (cdr ,gexpr)
,@body))
@@ -421,8 +421,8 @@
`(fn (val) (scdr (cdr ,g) val)))))
; Note: if expr0 macroexpands into any expression whose car doesn't
-; have a setter, setforms assumes it's a data structure in functional
-; position. Such bugs will be seen only when the code is executed, when
+; have a setter, setforms assumes it's a data structure in functional
+; position. Such bugs will be seen only when the code is executed, when
; sref complains it can't set a reference to a function.
(def setforms (expr0)
@@ -488,7 +488,7 @@
(mac loop (start test update . body)
(w/uniq (gfn gparm)
`(do ,start
- ((rfn ,gfn (,gparm)
+ ((rfn ,gfn (,gparm)
(if ,gparm
(do ,@body ,update (,gfn ,test))))
,test))))
@@ -548,7 +548,7 @@
(def cut (seq start (o end))
(let end (if (no end) (len seq)
- (< end 0) (+ (len seq) end)
+ (< end 0) (+ (len seq) end)
end)
(if (isa seq 'string)
(let s2 (newstring (- end start))
@@ -577,10 +577,10 @@
; often want to rem a table from a list. So maybe the right answer
; is to make keep the more primitive, not rem.
-(def keep (test seq)
+(def keep (test seq)
(rem (complement (testify test)) seq))
-;(def trues (f seq)
+;(def trues (f seq)
; (rem nil (map f seq)))
(def trues (f xs)
@@ -601,7 +601,7 @@
(mac caselet (var expr . args)
(let ex (afn (args)
- (if (no (cdr args))
+ (if (no (cdr args))
(car args)
`(if (is ,var ',(car args))
,(cadr args)
@@ -642,7 +642,7 @@
(w/uniq g
(let (binds val setter) (setforms place)
`(atwiths ,(+ binds (list g val))
- (do1 (car ,g)
+ (do1 (car ,g)
(,setter (cdr ,g)))))))
(def adjoin (x xs (o test iso))
@@ -691,7 +691,7 @@
(mac zap (op place . args)
(with (gop (uniq)
gargs (map [uniq] args)
- mix (afn seqs
+ mix (afn seqs
(if (some no seqs)
nil
(+ (map car seqs)
@@ -703,7 +703,7 @@
; Can't simply mod pr to print strings represented as lists of chars,
; because empty string will get printed as nil. Would need to rep strings
; as lists of chars annotated with 'string, and modify car and cdr to get
-; the rep of these. That would also require hacking the reader.
+; the rep of these. That would also require hacking the reader.
(def pr args
(map1 disp args)
@@ -755,7 +755,7 @@
(mac aand args
(if (no args)
- 't
+ 't
(no (cdr args))
(car args)
`(let it ,(car args) (and it (aand ,@(cdr args))))))
@@ -786,7 +786,7 @@
`(withs (,var nil ,gf (testify ,endval))
(while (no (,gf (= ,var ,expr)))
,@body))))
-
+
;(def macex (e)
; (if (atom e)
; e
@@ -816,12 +816,12 @@
(let f (testify test)
(if (alist seq)
((afn (seq n)
- (if (no seq)
+ (if (no seq)
nil
- (f (car seq))
+ (f (car seq))
n
(self (cdr seq) (+ n 1))))
- (nthcdr start seq)
+ (nthcdr start seq)
start)
(recstring [if (f (seq _)) _] seq start))))
@@ -832,7 +832,7 @@
(mac after (x . ys)
`(protect (fn () ,x) (fn () ,@ys)))
-(let expander
+(let expander
(fn (f var name body)
`(let ,var (,f ,name)
(after (do ,@body) (close ,var))))
@@ -971,13 +971,13 @@
(mac rand-choice exprs
`(case (rand ,(len exprs))
- ,@(let key -1
+ ,@(let key -1
(mappend [list (++ key) _]
exprs))))
(mac n-of (n expr)
(w/uniq ga
- `(let ,ga nil
+ `(let ,ga nil
(repeat ,n (push ,expr ,ga))
(rev ,ga))))
@@ -1010,7 +1010,7 @@
(each elt (cdr seq)
(if (f elt wins) (= wins elt)))
wins)))
-
+
(def max args (best > args))
(def min args (best < args))
@@ -1018,7 +1018,7 @@
; (w/uniq (a b)
; `(with (,a ,x ,b ,y) (if (> ,a ,b) ,a ,b))))
-(def most (f seq)
+(def most (f seq)
(unless (no seq)
(withs (wins (car seq) topscore (f wins))
(each elt (cdr seq)
@@ -1027,13 +1027,13 @@
wins)))
; Insert so that list remains sorted. Don't really want to expose
-; these but seem to have to because can't include a fn obj in a
+; these but seem to have to because can't include a fn obj in a
; macroexpansion.
-
+
(def insert-sorted (test elt seq)
(if (no seq)
- (list elt)
- (test elt (car seq))
+ (list elt)
+ (test elt (car seq))
(cons elt seq)
(cons (car seq) (insert-sorted test elt (cdr seq)))))
@@ -1041,18 +1041,18 @@
`(zap [insert-sorted ,test ,elt _] ,seq))
(def reinsert-sorted (test elt seq)
- (if (no seq)
- (list elt)
+ (if (no seq)
+ (list elt)
(is elt (car seq))
(reinsert-sorted test elt (cdr seq))
- (test elt (car seq))
+ (test elt (car seq))
(cons elt (rem elt seq))
(cons (car seq) (reinsert-sorted test elt (cdr seq)))))
(mac insortnew (test elt seq)
`(zap [reinsert-sorted ,test ,elt _] ,seq))
-; Could make this look at the sig of f and return a fn that took the
+; Could make this look at the sig of f and return a fn that took the
; right no of args and didn't have to call apply (or list if 1 arg).
(def memo (f)
@@ -1126,7 +1126,7 @@
(def treewise (f base tree)
(if (atom tree)
(base tree)
- (f (treewise f base (car tree))
+ (f (treewise f base (car tree))
(treewise f base (cdr tree)))))
(def carif (x) (if (atom x) x (car x)))
@@ -1138,8 +1138,8 @@
(pr init (car elts))
(map [pr sep _] (cdr elts))
elts))
-
-(def prs args
+
+(def prs args
(prall args "" #\space))
(def tree-subst (old new tree)
@@ -1166,10 +1166,10 @@
(each (k v) (pair data) (= (table k) v))
table)
-(def keys (h)
+(def keys (h)
(accum a (each (k v) h (a k))))
-(def vals (h)
+(def vals (h)
(accum a (each (k v) h (a v))))
(def tablist (h)
@@ -1213,7 +1213,7 @@
(= (new i) (x i)))
new)
table (let new (table)
- (each (k v) x
+ (each (k v) x
(= (new k) v))
new)
(err "Can't copy " x))
@@ -1240,7 +1240,7 @@
(def roundup (n)
(withs (base (trunc n) rem (abs (- n base)))
- (if (>= rem 1/2)
+ (if (>= rem 1/2)
((if (> n 0) + -) base 1)
base)))
@@ -1253,14 +1253,14 @@
((sort test ns) (round (/ (len ns) 2))))
; Use mergesort on assumption that mostly sorting mostly sorted lists
-; benchmark: (let td (n-of 10000 (rand 100)) (time (sort < td)) 1)
+; benchmark: (let td (n-of 10000 (rand 100)) (time (sort < td)) 1)
(def sort (test seq)
(if (alist seq)
(mergesort test (copy seq))
(coerce (mergesort test (coerce seq 'cons)) (type seq))))
-; Destructive stable merge-sort, adapted from slib and improved
+; Destructive stable merge-sort, adapted from slib and improved
; by Eli Barzilay for MzLib; re-written in Arc.
(def mergesort (less? lst)
@@ -1345,13 +1345,13 @@
(mac deftem (tem . fields)
(withs (name (carif tem) includes (if (acons tem) (cdr tem)))
- `(= (templates* ',name)
+ `(= (templates* ',name)
(+ (mappend templates* ',(rev includes))
(list ,@(map (fn ((k v)) `(list ',k (fn () ,v)))
(pair fields)))))))
(mac addtem (name . fields)
- `(= (templates* ',name)
+ `(= (templates* ',name)
(union (fn (x y) (is (car x) (car y)))
(list ,@(map (fn ((k v)) `(list ',k (fn () ,v)))
(pair fields)))
@@ -1384,7 +1384,7 @@
(w/infile i file (temread tem i)))
(def temloadall (tem file)
- (map (fn (pairs) (templatize tem pairs))
+ (map (fn (pairs) (templatize tem pairs))
(w/infile in file (readall in))))
@@ -1416,7 +1416,7 @@
(def saferead (arg) (errsafe:read arg))
-(def safe-load-table (filename)
+(def safe-load-table (filename)
(or (errsafe:load-table filename)
(table)))
@@ -1442,7 +1442,7 @@
str
(+ (cut str 0 limit) "...")))
-(def rand-elt (seq)
+(def rand-elt (seq)
(seq (rand (len seq))))
(mac until (test . body)
@@ -1472,10 +1472,10 @@
(def multiple (x y)
(is 0 (mod x y)))
-(mac nor args `(no (or ,@args)))
+(mac nor args `(no (or ,@args)))
(mac nand args `(no (and ,@args)))
-; Consider making the default sort fn take compare's two args (when do
+; Consider making the default sort fn take compare's two args (when do
; you ever have to sort mere lists of numbers?) and rename current sort
; as prim-sort or something.
@@ -1492,7 +1492,7 @@
; (def only (f g . args) (aif (apply g args) (f it)))
-(def only (f)
+(def only (f)
(fn args (if (car args) (apply f args))))
(mac conswhen (f x y)
@@ -1554,7 +1554,7 @@
(with (chars nil i -1)
(w/instring s str
(whilet c (readc s)
- (case c
+ (case c
#\# (do (a (coerce (rev chars) 'string))
(wipe chars)
(a (read s)))
@@ -1565,7 +1565,7 @@
(push c chars))))
(when chars
(a (coerce (rev chars) 'string))))))
-
+
(mac prf (str . args)
`(let ,argsym (list ,@args)
(pr ,@(parse-format str))))
@@ -1588,8 +1588,8 @@
`(let ,var (table) ,@body ,var))
(def ero args
- (w/stdout (stderr)
- (each a args
+ (w/stdout (stderr)
+ (each a args
(write a)
(writec #\space))
(writec #\newline))
@@ -1633,7 +1633,7 @@
`(with (,gn ,n ,gc 0)
(each ,var ,val
(when (multiple (++ ,gc) ,gn)
- (pr ".")
+ (pr ".")
(flushout)
)
,@body)
@@ -1712,7 +1712,7 @@
(def len> (x n) (> (len x) n))
-(mac thread body
+(mac thread body
`(new-thread (fn () ,@body)))
(def kill-thread(th)
(atomic ($:kill-thread th)))
@@ -1842,7 +1842,7 @@
(mac defhook (name . rest)
`(= (hooks* ',name) (fn ,@rest)))
-
+
(mac out (expr) `(pr ,(tostring (eval expr))))
; if renamed this would be more natural for (map [_ user] pagefns*)
@@ -1866,7 +1866,7 @@
`(fromdisk ,var ,file (table) load-table save-table))
(mac todisk (var (o expr var))
- `((savers* ',var)
+ `((savers* ',var)
,(if (is var expr) var `(= ,var ,expr))))
(mac evtil (expr test)
@@ -1897,7 +1897,7 @@
(w/uniq first
`(let ,first t
(each ,var ,expr
- (if ,first
+ (if ,first
(wipe ,first)
,within)
,@body))))
@@ -1928,12 +1928,12 @@
; idea: use constants in functional position for currying?
; (1 foo) would mean (fn args (apply foo 1 args))
-; another solution would be to declare certain symbols curryable, and
+; another solution would be to declare certain symbols curryable, and
; if > was, >_10 would mean [> _ 10]
; or just say what the hell and make _ ssyntax for currying
; idea: make >10 ssyntax for [> _ 10]
; solution to the "problem" of improper lists: allow any atom as a list
-; terminator, not just nil. means list recursion should terminate on
+; terminator, not just nil. means list recursion should terminate on
; atom rather than nil, (def empty (x) (or (atom x) (is x "")))
; table should be able to take an optional initial-value. handle in sref.
; warn about code of form (if (= )) -- probably mean is
2  as.scm
View
@@ -5,7 +5,7 @@
(require mzscheme) ; promise we won't redefine mzscheme bindings
-(require "ac.scm")
+(require "ac.scm")
(require "brackets.scm")
(use-bracket-readtable)
10 blog.arc
View
@@ -21,9 +21,9 @@
(def post (id) (posts* (errsafe:int id)))
(mac blogpage body
- `(whitepage
+ `(whitepage
(center
- (widtable 600
+ (widtable 600
(tag b (link blogtitle* "blog"))
(br 3)
,@body
@@ -34,8 +34,8 @@
(defop viewpost req (blogop post-page req))
(def blogop (f req)
- (aif (post (arg req "id"))
- (f (get-user req) it)
+ (aif (post (arg req "id"))
+ (f (get-user req) it)
(blogpage (pr "No such post."))))
(def permalink (p) (string "viewpost?id=" p!id))
@@ -83,7 +83,7 @@
(let user (get-user req)
(blogpage
(for i 0 4
- (awhen (posts* (- maxid* i))
+ (awhen (posts* (- maxid* i))
(display-post user it)
(br 3))))))
16 brackets.scm
View
@@ -1,12 +1,12 @@
; From Eli Barzilay, eli@barzilay.org
-;> (require "brackets.scm")
-;> (use-bracket-readtable)
-;> ([+ _ 1] 10)
+;> (require "brackets.scm")
+;> (use-bracket-readtable)
+;> ([+ _ 1] 10)
;11
(module brackets mzscheme
-
+
; main reader function for []s
; recursive read starts with default readtable's [ parser,
; but nested reads still use the curent readtable:
@@ -14,21 +14,21 @@
(define (read-square-brackets ch port src line col pos)
`(make-br-fn
,(read/recursive port #\[ #f)))
-
+
; a readtable that is just like the builtin except for []s
(define bracket-readtable
(make-readtable #f #\[ 'terminating-macro read-square-brackets))
-
+
; call this to set the global readtable
(provide use-bracket-readtable)
(define (use-bracket-readtable)
(current-readtable bracket-readtable))
-
+
; these two implement the required functionality for #reader
-
+
;(define (*read inp)
; (parameterize ((current-readtable bracket-readtable))
; (read inp)))
2  code.arc
View
@@ -16,7 +16,7 @@
(treewise + (fn (x) 1) (readall (infile file))))
(def code-density (file)
- (/ (codetree file) (codelines file)))
+ (/ (codetree file) (codelines file)))
(def tokcount (files)
(counts:mappend flat:readall:infile files))
66 html.arc
View
@@ -1,8 +1,8 @@
-; HTML Utils.
+; HTML Utils.
(def color (r g b)
- (with (c (table)
+ (with (c (table)
f (fn (x) (if (< x 0) 0 (> x 255) 255 x)))
(= (c 'r) (f r) (c 'g) (f g) (c 'b) (f b))
c))
@@ -19,7 +19,7 @@
(defmemo gray (n) (color n n n))
-(= white (gray 255)
+(= white (gray 255)
black (gray 0)
linkblue (color 0 0 190)
orange (color 255 102 0)
@@ -44,7 +44,7 @@
(defmemo hexrep (col)
(+ (hexreps (col 'r)) (hexreps (col 'g)) (hexreps (col 'b))))
-(def opcolor (key val)
+(def opcolor (key val)
(w/uniq gv
`(whenlet ,gv ,val
(pr ,(string " " key "=#") (hexrep ,gv)))))
@@ -73,10 +73,10 @@
; need to escape more? =?
(def pr-escaped (x)
- (each c x
- (pr (case c #\< "&#60;"
- #\> "&#62;"
- #\" "&#34;"
+ (each c x
+ (pr (case c #\< "&#60;"
+ #\> "&#62;"
+ #\" "&#34;"
#\& "&#38;"
c))))
@@ -164,12 +164,12 @@
(mac gentag args (start-tag args))
-
+
(mac tag (spec . body)
`(do ,(start-tag spec)
,@body
,(end-tag spec)))
-
+
(mac tag-if (test spec . body)
`(if ,test
(tag ,spec ,@body)
@@ -192,13 +192,13 @@
(def end-tag (spec)
`(pr ,(string "</" (carif spec) ">")))
-(def literal (x)
+(def literal (x)
(case (type x)
sym (in x nil t)
cons (caris x 'quote)
t))
-; Returns a list whose elements are either strings, which can
+; Returns a list whose elements are either strings, which can
; simply be printed out, or expressions, which when evaluated
; generate output.
@@ -206,10 +206,10 @@
(if (no options)
'()
(let ((opt val) . rest) options
- (let meth (if (in opt 'style 'class)
- opstring
+ (let meth (if (in opt 'style 'class)
+ opstring
(is opt 'id)
- opsym
+ opsym
(opmeth spec opt))
(if meth
(if val
@@ -221,11 +221,11 @@
(cons (opstring opt val) (tag-options spec rest)))))))
(def precomputable-tagopt (val)
- (and (literal val)
+ (and (literal val)
(no (and (is (type val) 'string) (find #\@ val)))))
-(def br ((o n 1))
- (repeat n (pr "<br>"))
+(def br ((o n 1))
+ (repeat n (pr "<br>"))
(prn))
(def br2 () (prn "<br><br>"))
@@ -236,7 +236,7 @@
(mac tr body `(tag tr ,@body))
(let pratoms (fn (body)
- (if (or (no body)
+ (if (or (no body)
(all [and (acons _) (isnt (car _) 'quote)]
body))
body
@@ -253,7 +253,7 @@
(mac prrow args
(w/uniq g
- `(tr ,@(map (fn (a)
+ `(tr ,@(map (fn (a)
`(let ,g ,a
(if (number ,g)
(tdr (pr ,g))
@@ -262,7 +262,7 @@
(mac prbold body `(tag b (pr ,@body)))
-(def para args
+(def para args
(gentag p)
(when args (apply pr args)))
@@ -273,7 +273,7 @@
(pr i)))))
(mac whitepage body
- `(tag html
+ `(tag html
(tag (body bgcolor white alink linkblue) ,@body)))
(def errpage args (whitepage (apply prn args)))
@@ -288,7 +288,7 @@
(def vspace (n) (gentag img src (blank-url) height n width 0))
(def vhspace (h w) (gentag img src (blank-url) height h width w))
-(mac new-hspace (n)
+(mac new-hspace (n)
(if (number n)
`(pr ,(string "<span style=\"padding-left:" n "px\" />"))
`(pr "<span style=\"padding-left:" ,n "px\" />")))
@@ -348,11 +348,11 @@
(if (isa ,gl 'cons)
(td (textarea ',name (car ,gl) (cadr ,gl)
(let ,gt ,text (if ,gt (pr ,gt)))))
- (td (gentag input type ',(if (is label 'password)
- 'password
+ (td (gentag input type ',(if (is label 'password)
+ 'password
'text)
- name ',name
- size ,len
+ name ',name
+ size ,len
value ,text)))))))
(tuples args 4))))
@@ -363,14 +363,14 @@
(submit btext))
(mac cdata body
- `(do (pr "<![CDATA[")
+ `(do (pr "<![CDATA[")
,@body
(pr "]]>")))
(def eschtml (str)
- (tostring
+ (tostring
(each c str
- (pr (case c #\< "&#60;"
+ (pr (case c #\< "&#60;"
#\> "&#62;"
#\" "&#34;"
#\' "&#39;"
@@ -378,9 +378,9 @@
c)))))
(def esc-tags (str)
- (tostring
+ (tostring
(each c str
- (pr (case c #\< "&#60;"
+ (pr (case c #\< "&#60;"
#\> "&#62;"
#\& "&#38;"
c)))))
@@ -388,7 +388,7 @@
(def nbsp () (pr "&nbsp;"))
(def link (text (o dest text) (o color))
- (tag (a href dest)
+ (tag (a href dest)
(tag-if color (font color color)
(pr text))))
8 lib/arcscript.arc
View
@@ -16,8 +16,8 @@
(= lowercase (no lowercase))
(posmatch (string c) "!?#@%+*/=:<>")
(pr ('("bang" "what" "hash" "at" "percent" "plus" "star" "slash" "equals" "colon" "lessthan" "greaterthan") it))
- (do
- (pr (if (and lowercase (no all-uppercase))
+ (do
+ (pr (if (and lowercase (no all-uppercase))
(downcase c)
(upcase c)))
(= lowercase t)))))))
@@ -106,7 +106,7 @@
(js:?)
(= *= /= %= += -= <<= >>= >>>= &= ^= \|=)
(comma))
- (map
+ (map
(fn (op)
(= (precedence-table op) i))
level)
@@ -284,7 +284,7 @@
; XXX was macrolet
(mac def-unary-ops ops
- `(do
+ `(do
,@(map
(fn (op)
(with (op (if (acons op) (car op) op)
2  lib/date.arc
View
@@ -1,7 +1,7 @@
(require "lib/lang.arc")
(def parse-date (str)
- (timedate
+ (timedate
(perl subprocess “
use Date::Language;
arcnum(Date::Language->new('English')->str2time(«str»));
2  lib/extend.arc
View
@@ -8,7 +8,7 @@
; and I don't have time to debug them.
; 2009-08-20: Michael Arntzenius <daekharel@gmail.com>
; + reloading the file will no longer wipe the extensions table.
-; + refactored 'extend macro into a function 'extend-add, a function
+; + refactored 'extend macro into a function 'extend-add, a function
; 'extend-fn, a macro 'extend-ensure, and a macro 'extend.
; + remove unnecessary let in 'extend-wrap's afn
; + add 'extend-pull fn, 'unextend macro
4 lib/json.ss
View
@@ -50,7 +50,7 @@
(scheme:write json port)]
[(symbol? json)
(scheme:write (symbol->string json) port)]
- [else (error 'json "bad json value: ~v" json)]))
+ [else (error 'json "bad json value: ~v" json)]))
; arc data handlers
@@ -73,7 +73,7 @@
(eq? x 'null)))
(define (arc-boolean? x)
- (or (eq? x 'true)
+ (or (eq? x 'true)
(eq? x 'false)
(eq? x #t)
(eq? x #f)))
18 lib/lang.arc
View
@@ -74,13 +74,13 @@
(def pyustr (s)
(lcode (prpyustr s)))
-
+
(def lstr (x)
((case lang*
perl plstr
python pyustr)
x))
-
+
(def prpllist (lst)
(pr #\[)
(between x lst (pr ",") (prpl x))
@@ -160,7 +160,7 @@
python 50002))
(def open-lang-control-socket ()
- (thread
+ (thread
(let s (open-socket lang-control-port*)
(xloop ()
(socket-accept s)
@@ -281,7 +281,7 @@ sub eval2arc {
}
”)))
-
+
(= python2arc* (tostring (w/lang 'python “
from sys import exc_info, stderr
import traceback
@@ -324,7 +324,7 @@ def arcstr(x):
if isinstance(x, str):
return arcval(strarcstr(x))
elif isinstance(x, unicode):
- return arcval(ustrarcstr(x))
+ return arcval(ustrarcstr(x))
else:
return arcval(strarcstr(repr(x)))
@@ -339,7 +339,7 @@ def arclist(x):
def toarclist(x):
return "(" + " ".join(map(toarc, x)) + ")"
-
+
def toarctab(x):
return ("{" +
" ".join(map(lambda (k, v): toarc(k) + " " + toarc(v),
@@ -537,7 +537,7 @@ reactor.run()
(postform (string "http://localhost:" lang-listen-port*.lang "/")
`((code ,program))
(fn (r i) (read i))))))
-
+
(def launch-lang (lang)
(atomic-lock launch-locks*.lang
(unless lang-launched*.lang
@@ -563,7 +563,7 @@ reactor.run()
(mac langex (lang . body)
`(do (w/lang ',lang ,@body)
(prn)))
-
+
(def lang-check-error (lang program result)
(when (and (isa result 'table) (result lang-error-key*))
(disp (string "\n" lang " error:\n") (stderr))
@@ -577,7 +577,7 @@ reactor.run()
(lang-check-error lang program
(let s (fromstring (tostring ((lang-subprocess-code* lang) program))
(pipe-from lang-command*.lang))
- (after (read s) (close s)))))
+ (after (read s) (close s)))))
(def singlethread (lang program)
(launch-lang lang)
42 lib/math.arc
View
@@ -5,7 +5,7 @@
;;should this be in util.arc?
(mac iterators (its . body)
- "its is a list of (var max) tuples which are iterated over eg (iterators ((x 1)(y 3)) (pr x)(prn y)) ->
+ "its is a list of (var max) tuples which are iterated over eg (iterators ((x 1)(y 3)) (pr x)(prn y)) ->
00
01
02
@@ -14,7 +14,7 @@
11
12
13"
- (if car.its
+ (if car.its
(if (> cadar.its 0)
`(for ,(caar its) 0 ,(cadar its)
(iterators ,(cdr its) ,@body))
@@ -36,7 +36,7 @@
(let rec (afn (M r)
(if (atom car.M) r
(self car.M (+ r 1))))
- (rec mat 1))))
+ (rec mat 1))))
(def zeros dims
(init-matrix dims 0))
@@ -46,7 +46,7 @@
(mac elt (mat pos)
"access the element of the matix given by co-ords listed in pos"
- (if (cdr pos)
+ (if (cdr pos)
`(elt (,mat ,(last pos)) ,(butlast pos))
`(,mat ,(car pos))))
@@ -73,7 +73,7 @@
(map (fn (tp) (self:map [cons (butlast car._) cdr._] tp)) ;
(tuples (sort (fn (x y) (< (last car.x) (last car.y))) lis) ; if there is more than one index: collect into tuples of the rightmost index and list the answers of rec on each tuple
(len:keep [is (last car._) 0] lis))))) ;
-
+
(rec key-val-lis))))
(def matrix-minor (mat indices (o table? t))
@@ -97,9 +97,9 @@
(if (and (is (car mat!dims) 1)
(is (cadr mat!dims) 1))
(mat '(0 0))
- (let ans 0
+ (let ans 0
(for i 0 (- (car mat!dims) 1)
- (++ ans (* (mat (list 0 i))
+ (++ ans (* (mat (list 0 i))
(expt -1 i) (det:matrix-minor mat (list 0 i)))))
ans)))
@@ -133,7 +133,7 @@ mat_10*x_0 + mat_11*x_1 ... mat_1n*x_n = rhs_1
...
mat_n0*x_0 + mat_n1*x_1 ... mat_nn*x_n = rhs_n
-using gaussian elimination and returns a list of x's (N.B. not efficient for large sparce matrices)"
+using gaussian elimination and returns a list of x's (N.B. not efficient for large sparce matrices)"
(zap flat rhs)
(if (acons mat) (zap mat-to-table mat)) ;assumes if using list-of-lists representation of matrices you arent worried about efficiency and so wont mind inline conversion
(withs (MAX 0
@@ -144,7 +144,7 @@ using gaussian elimination and returns a list of x's (N.B. not efficient for lar
(let M (copy mat)
(for i 0 (- N 1)
(= (M (list N i)) rhs.i))
- ;;elimination step - manipulates the matrix so all elements below the diagonal are zero while maintaining the relation between variables and co-efficients
+ ;;elimination step - manipulates the matrix so all elements below the diagonal are zero while maintaining the relation between variables and co-efficients
(loop (= i 0) (< i N) (++ i)
(= MAX i)
(loop (= j (+ i 1)) (< j N) (++ j)
@@ -256,7 +256,7 @@ using gaussian elimination and returns a list of x's (N.B. not efficient for lar
b
(let half (+ lower (/ (- upper lower) 2))
(+ (self lower half tol) (self half upper tol))))))))
-
+
; vector fns
@@ -274,11 +274,11 @@ using gaussian elimination and returns a list of x's (N.B. not efficient for lar
(map (fn (x y) (+ x y)) v1 v2))
v- (fn (v1 v2)
(map (fn (x y) (- x y)) v1 v2)))
-
+
(def vec+ (v1 . args)
(if no.args v1
(reduce v+ (cons v1 args))))
-
+
(def vec- (v1 . args)
(if no.args (map [- _] v1)
(v- v1 (apply vec+ args))))
@@ -294,7 +294,7 @@ using gaussian elimination and returns a list of x's (N.B. not efficient for lar
(if no.xs sqrt.tot
(self (+ tot (expt car.xs 2)) cdr.xs)))
0 args))
-
+
(def vec-norm (vec)
(vec-scale vec (/:apply quad-add vec)))
@@ -330,15 +330,15 @@ using gaussian elimination and returns a list of x's (N.B. not efficient for lar
(def gauss-random (sigma (o mu 0))
"gausian distributed random with width sigma around mu"
- (withs (u (rand)
- v (* 1.7156 (- (rand) 0.5))
+ (withs (u (rand)
+ v (* 1.7156 (- (rand) 0.5))
x (- u 0.449871)
y (+ abs.v 0.386595)
q (+ (* x x) (* y (- (* 0.196 y) (* 0.25472 x)))))
(while (and (> q 0.27597)
(or (> q 0.27846) (> (* v v) (* -4 log.u u u))))
- (= u (rand)
- v (* 1.7156 (- (rand) 0.5))
+ (= u (rand)
+ v (* 1.7156 (- (rand) 0.5))
x (- u 0.449871)
y (+ abs.v 0.386595)
q (+ (* x x) (* y (- (* 0.196 y) (* 0.25472 x))))))
@@ -395,7 +395,7 @@ using gaussian elimination and returns a list of x's (N.B. not efficient for lar
(def Jn-bessel (n (o terms 100))
"gives a fn for the nth bessel function of the first kind evaluated at x"
(fn (x)
- (with (i 0
+ (with (i 0
tot 0)
(while (< i terms)
(++ tot (/ (* (expt -1 i) (expt (/ x 2) (+ n i i)))
@@ -415,8 +415,8 @@ using gaussian elimination and returns a list of x's (N.B. not efficient for lar
(def In-bessel (n (o terms 100))
"gives a function for the nth modified bessel function of the first kind"
(let J(Jn-bessel n terms)
- (fn (x)
- (* (expt -i n)
+ (fn (x)
+ (* (expt -i n)
(J:* i x) terms))))
(def Kn-bessel (n (o terms 100))
@@ -490,7 +490,7 @@ using gaussian elimination and returns a list of x's (N.B. not efficient for lar
(def poisson-dist (lambda)
"returns a function for the probability of k discrete, uncorrelated events occuring in a time where the mean expected events is lambda"
- (fn (k)
+ (fn (k)
(if (or (< k 0) (no:isa k 'int)) (err "k in poisson dist must be a non-negative integer"))
(* (/ (expt lambda k) fact.k) (e^ (- lambda)))))
24 lib/ns.arc
View
@@ -363,7 +363,7 @@
(map racket-stx
'(#%top set! #%app #%datum quote define-syntax))
embed [$.list app (cons datum (fn () _))])
-
+
(def rns-get (var (o rns current-rns))
" Gets a variable from a Racket namespace by evaluating it in
Racket. Actually, it's sent through Racket's 'expand-to-top-form
@@ -379,24 +379,24 @@
(no $.identifier-binding.expanded))
($.cons top expanded)
expanded)))))
-
+
(def ns-get (var (o ns current-ns))
" Gets a variable from a namespace by evaluating it in Racket.
Actually, it's sent through Racket's 'expand-to-top-form so that
we can use the core #%top form if necessary rather than relying
on the namespace itself to have one. "
(rns-get global-arcracket.var ns-arcracket.ns))
-
+
(def rns-set (var val (o rns current-rns))
" Sets a variable in a Racket namespace using Racket's 'set!. "
(let (var rns) (rep:rns-var var rns)
(w/current-rns rns ($.arc-exec:$.list set var embed.val)))
val)
-
+
(def ns-set (var val (o ns current-ns))
" Sets a variable in a namespace using Racket's 'set!. "
(rns-set global-arcracket.var val ns-arcracket.ns))
-
+
(def rns-ownspace-set (var val (o rns current-rns))
" Sets a top-level variable in a Racket namespace without changing
the corresponding identifier mapping to point to that
@@ -404,24 +404,24 @@
(let (var rns) (rep:rns-var var rns)
(($ namespace-set-variable-value!) var val scheme-f rnsify.rns))
val)
-
+
(def ns-ownspace-set (var val (o ns current-ns))
" Sets a top-level variable in a namespace without changing the
corresponding identifier mapping to point to that variable. "
(rns-ownspace-set global-arcracket.var val ns-arcracket.ns))
-
+
(def rns-set-own (var val (o rns current-rns))
" Sets a top-level variable in a Racket namespace and changes the
corresponding identifier mapping to point to that variable. "
(let (var rns) (rep:rns-var var rns)
(($ namespace-set-variable-value!) var val scheme-t rnsify.rns))
val)
-
+
(def ns-set-own (var val (o ns current-ns))
" Sets a top-level variable in a namespace and changes the
corresponding identifier mapping to point to that variable. "
(rns-set-own global-arcracket.var val ns-arcracket.ns))
-
+
(def rns-set-renamer (observing-var
canonical-var (o canonical-rns current-rns))
" Changes an identifier mapping in a Racket namespace to point to
@@ -432,14 +432,14 @@
(w/current-rns observing-rns
($.arc-exec:$.list
define-syntax observing-var embed.transformer)))))
-
+
(def ns-set-renamer (observing-var
canonical-var (o canonical-ns current-ns))
" Changes an identifier mapping in a namespace to point to a
rename transformer. "
(rns-set-renamer global-arcracket.observing-var
global-arcracket.canonical-var ns-arcracket.canonical-ns))
-
+
(def rns-set-modecule (var modecule (o rns current-rns))
(withs ((var rns) (rep:rns-var var rns)
(mod modecule-var) rep.modecule
@@ -448,7 +448,7 @@
($.namespace-require:$.list 'rename
path var global-arcracket.modecule-var)))
modecule)
-
+
(def ns-set-modecule (var modecule (o ns current-ns))
(rns-set-modecule global-arcracket.var modecule ns-arcracket.ns))
)
50 lib/ns.arc.t
View
@@ -10,15 +10,15 @@
; Namespace tests
(let foo (nsobj a 1 b 2)
-
+
(test-iso "We can use 'nsobj to make namespaces."
(sort < (keep $.symbol-interned? ns-keys.foo))
'(a b))
-
+
(test-iso "Getting from a namespace works."
foo!a
1)
-
+
(test-iso "Assigning into a namespace works."
(do (= foo!a 2) foo!a)
2)
@@ -27,27 +27,27 @@
; Modecule tests
(with (foo (nsobj i 9 j 10) bar make-modecule.11)
-
+
(test-iso "We can still use 'nsobj to make namespaces."
(sort < (keep $.symbol-interned? ns-keys.foo))
'(i j))
-
+
(test-iso "We can use 'ns-set-modecule."
(ns-set-modecule 'k bar foo)
bar)
-
+
(test-iso "After setting a modecule, it's actually there."
(sort < (keep $.symbol-interned? ns-keys.foo))
'(i j k))
-
+
(test-iso "We can get the value of 'k by evaluating Racket code."
(w/current-ns foo ($.eval global-arcracket!k))
11)
-
+
(test-iso "We can get the value of 'k by calling the namespace."
foo!k
11)
-
+
(test-iso "We can set the value of 'k using '=."
(do (= foo!k 12) foo!k)
12)
@@ -56,15 +56,15 @@
; Module tests
(let foo (simple-mod a 1 b 2)
-
+
(test-iso "We can get the keys of a module using 'ns-keys."
(sort < (keep $.symbol-interned? ns-keys.foo))
'(a b))
-
+
(test-iso "We can call a module to get a value from it."
foo!a
1)
-
+
(test-iso "We can set to a module."
(do (= foo!a 9) foo!a)
9)
@@ -73,30 +73,30 @@
; Submodule tests
(let foo (simple-rmod t 1 nil 2)
-
+
(test-iso "We can get the keys to a Racket module using 'rns-keys."
(sort < (keep $.symbol-interned? rns-keys.foo))
'(nil t))
-
+
(test-iso (+ "We can get the keys to a Racket module using "
"'rmodule-keys.")
(sort < rmodule-keys.foo)
'(nil t))
-
+
(test-iso "We can get a variable named 't from a Racket module."
foo!t
1)
-
+
(test-iso "We can get a variable named 'nil from a Racket module."
foo!nil
2)
-
+
(test-iso "We can set a variable named 'nil in a Racket module."
(do (= foo!nil 9) foo!nil)
9)
-
+
(let bar (make-sub-rmodule foo idfn)
-
+
(test-iso "We can use 'make-sub-rmodule."
rmodule-keys.bar
'(t))))
@@ -137,7 +137,7 @@
;(= foo (make-ns 'a 1 'b 2))
;(write:coerce foo 'table)
-
+
(tryout "now namespaces")
(let foo (nsobj a 1 b 2)
(tryout:firstn 10 ns-keys.foo)
@@ -145,7 +145,7 @@
(tryout:= foo!a 2)
(tryout foo!a)
)
-
+
(tryout "now define-boxvar in Racket")
(tryout:eval
`($:define-syntax-rule (define-boxvar var base-var)
@@ -161,7 +161,7 @@
(tryout:$.eval:ac-denil '(set! foo 4))
(tryout:$.eval:ac-denil 'foo)
(tryout:$.eval:ac-denil 'bar)
-
+
(tryout "now modecules")
(with (foo (nsobj i 9 j 10)
bar (tryout make-modecule.11))
@@ -175,13 +175,13 @@
(tryout:= foo!k 12)
(tryout foo!k)
)
-
+
(tryout "now modules")
(let foo (simple-mod a 1 b 2)
(tryout:firstn 10 ns-keys.foo)
(tryout foo!a)
(tryout:do (= foo!a 9) foo!a))
-
+
(tryout "now submodules")
(let foo (simple-rmod t 1 nil 2)
(tryout:firstn 10 rns-keys.foo)
@@ -192,7 +192,7 @@
(let bar (tryout:make-sub-rmodule foo idfn)
(tryout:firstn 10 rns-keys.bar)
(tryout:firstn 10 rmodule-keys.bar)))
-
+
(tryout "now local requires")
(tryout:w/rmodule (simple-rmod foo "Racket module")
foo)
4 lib/statistics.arc
View
@@ -13,8 +13,8 @@
(def rand-mat dims
(= dims (flat dims))
- (if
- (no (cdr dims))
+ (if
+ (no (cdr dims))
(n-of (car dims) (rand))
(cdr dims)
(n-of (car dims) (rand-mat (cdr dims))))
20 lib/util.arc
View
@@ -173,7 +173,7 @@
" Partially applies (\"curries\") `f' to `xs'. "
(fn ys (apply f (join xs ys))))
-(def const (x)
+(def const (x)
" Creates a fn that takes any number of arguments and returns `x'. "
(fn _ x))
@@ -187,7 +187,7 @@
(complement (apply orf fns)))
(def iff funs
- " Put simply: iff is to if as andf is to and. Specifically:
+ " Put simply: iff is to if as andf is to and. Specifically:
(iff) => idfn
(iff fun) => fun
@@ -209,7 +209,7 @@
1 funs.0
(withs ((test fun . rest) funs
restfun (apply iff rest))
- (fn a (if (apply test a) (apply fun a)
+ (fn a (if (apply test a) (apply fun a)
(apply restfun a))))))
@@ -221,14 +221,14 @@
`(mappend (fn (,var) ,@body) ,lst))
(mac ado body
- " Anaphoric do.
+ " Anaphoric do.
See also [[aif]] [[awhen]] [[aand]] "
(aif cdr.body `(let it ,car.body (ado ,@it))
car.body))
; now that pg has renamed 'assert to 'set, we're free to use it in its more
; conventional sense
-(mac assert (exp (o msg (+ "Assertion failed: "
+(mac assert (exp (o msg (+ "Assertion failed: "
(tostring:ppr exp (len "Assertion failed: ") t))))
" Errors with `msg' if `exp' evaluates to nil. "
`(unless ,exp (err ,msg)))
@@ -252,7 +252,7 @@
`(switchlet ,(uniq) ,exp ,@cases))
(mac dol (parms (test result) . body)
- " Like the standard lisp/scheme do loop, but with redundant inner parens
+ " Like the standard lisp/scheme do loop, but with redundant inner parens
removed."
(w/uniq loop-name
(let parms (tuples parms 3)
@@ -278,14 +278,14 @@
; a 'with that works for defining recursive fns
(mac withr/p (bindings . body)
- " Scheme's 'letrec.
+ " Scheme's 'letrec.
See also [[withr]] [[where]] "
`(let ,(map1 car bindings) nil
,@(map [cons 'assign _] bindings)
,@body))
(mac withr (bindings . body)
- " Scheme's 'letrec, with the redundant inner parens removed.
+ " Scheme's 'letrec, with the redundant inner parens removed.
See also [[withf]] [[letf]] [[where]] [[withr/p]] "
`(withr/p ,pair.bindings ,@body))
@@ -297,7 +297,7 @@
,@body))
(mac withf (fns . body)
- " Defines a set `fns' of mutually recursive local fns within `body'. Each
+ " Defines a set `fns' of mutually recursive local fns within `body'. Each
three elements of `fn' correspond to a fn name, argument list, and body,
so you'll need to use 'do if you want a multi-expression fn body.
Example:
@@ -404,7 +404,7 @@
" Convenient wrapper for applying an rfn using preexisting variables
in `withses' as arguments. Best explained by example:
- arc> (let x (range 1 3)
+ arc> (let x (range 1 3)
(w/rfn sum (x)
(iflet (a . r) x (+ a (sum r)) 0)))
6
14 lib/webupload.arc
View
@@ -9,20 +9,20 @@
; the Content-Type and then look for it. Here's some
; sample output:
;
-; ... headers ...
+; ... headers ...
; Content-Type: multipart/form-data; boundary=----WebKitFormBoundarysVQ7sAKHmOlv
; Content-Length: 200
; ... more headers ...
;
-; ------WebKitFormBoundarysVQ7sAKHmOlv
-; Content-Disposition: form-data; name="name"; filename="test.txt"
-; Content-Type: text/plain
-;
+; ------WebKitFormBoundarysVQ7sAKHmOlv
+; Content-Disposition: form-data; name="name"; filename="test.txt"
+; Content-Type: text/plain
+;
; A small
; 3 line
; test file.
-;
-; ------WebKitFormBoundarysVQ7sAKHmOlv--
+;
+; ------WebKitFormBoundarysVQ7sAKHmOlv--
;
; Note that the final boundary an extra "--" at the beginning and
; at the end.
336 news.arc
View
@@ -19,8 +19,8 @@
; Structures
-; Could add (html) types like choice, yesno to profile fields. But not
-; as part of deftem, which is defstruct. Need another mac on top of
+; Could add (html) types like choice, yesno to profile fields. But not
+; as part of deftem, which is defstruct. Need another mac on top of
; deftem. Should not need the type specs in user-fields.
(deftem profile
@@ -41,7 +41,7 @@
noprocrast nil
firstview nil
lastview nil
- maxvisit 20
+ maxvisit 20
minaway 180
topcolor nil
keys nil
@@ -90,7 +90,7 @@
(noisy-each 100 id (dir profdir*)
(load-user id)))
-; For some reason vote files occasionally get written out in a
+; For some reason vote files occasionally get written out in a
; broken way. The nature of the errors (random missing or extra
; chars) suggests the bug is lower-level than anything in Arc.
; Which unfortunately means all lists written to disk are probably
@@ -114,9 +114,9 @@
(or (votes* u)
(aand (file-exists (+ votedir* u))
(= (votes* u) (load-table it)))))
-
+
(def init-user (u)
- (= (votes* u) (table)
+ (= (votes* u) (table)
(profs* u) (inst 'profile 'id u))
(save-votes u)
(save-prof u)
@@ -124,7 +124,7 @@
; Need this because can create users on the server (for other apps)
; without setting up places to store their state as news users.
-; See the admin op in app.arc. So all calls to login-page from the
+; See the admin op in app.arc. So all calls to login-page from the
; news app need to call this in the after-login fn.
(def ensure-news-user (u)
@@ -141,7 +141,7 @@
; Note that users will now only consider currently loaded users.
-(def users ((o f idfn))
+(def users ((o f idfn))
(keep f (keys profs*)))
(def check-key (u k)
@@ -150,11 +150,11 @@
(def author (u i) (is u i!by))
-(= stories* nil comments* nil
+(= stories* nil comments* nil
items* (table) url->story* (table)
maxid* 0 initload* 15000)
-; The dir expression yields stories in order of file creation time
+; The dir expression yields stories in order of file creation time
; (because arc infile truncates), so could just rev the list instead of
; sorting, but sort anyway.
@@ -165,7 +165,7 @@
(def load-items ()
(system (+ "rm " storydir* "*.tmp"))
- (pr "load items: ")
+ (pr "load items: ")
(with (items (table)
ids (sort > (map int (dir storydir*))))
(if ids (= maxid* (car ids)))
@@ -180,7 +180,7 @@
(def ensure-topstories ()
(aif (errsafe (readfile1 (+ newsdir* "topstories")))
(= ranked-stories* (map item it))
- (do (prn "ranking stories.")
+ (do (prn "ranking stories.")
(flushout)
(gen-topstories))))
@@ -195,8 +195,8 @@
(register-url i it))
i))
-; Note that duplicates are only prevented of items that have at some
-; point been loaded.
+; Note that duplicates are only prevented of items that have at some
+; point been loaded.
(def register-url (i url)
(= (url->story* (canonical-url url)) i!id))
@@ -218,13 +218,13 @@
(def kids (i) (map item i!kids))
-; For use on external item references (from urls). Checks id is int
+; For use on external item references (from urls). Checks id is int
; because people try e.g. item?id=363/blank.php
(def safe-item (id)
(ok-id&item (if (isa id 'string) (saferead id) id)))
-(def ok-id (id)
+(def ok-id (id)
(and (exact id) (<= 1 id maxid*)))
(def arg->item (req key)
@@ -264,7 +264,7 @@
; Votes divided by the age in hours to the gravityth power.
; Would be interesting to scale gravity in a slider.
-(= gravity* 1.8 timebase* 120 front-threshold* 1
+(= gravity* 1.8 timebase* 120 front-threshold* 1
nourl-factor* .4 lightweight-factor* .3 )
(def frontpage-rank (s (o scorefn realscore) (o gravity gravity*))
@@ -273,7 +273,7 @@
(expt (/ (+ (item-age s) timebase*) 60) gravity))
(if (no (in s!type 'story 'poll)) .5
(blank s!url) nourl-factor*
- (lightweight s) (min lightweight-factor*
+ (lightweight s) (min lightweight-factor*
(contro-factor s))
(contro-factor s))))
@@ -300,8 +300,8 @@
(def user-age (u) (minutes-since (uvar u created)))
-; Only looks at the 1000 most recent stories, which might one day be a
-; problem if there is massive spam.
+; Only looks at the 1000 most recent stories, which might one day be a
+; problem if there is massive spam.
(def gen-topstories ()
(= ranked-stories* (rank-stories 180 1000 (memo frontpage-rank))))
@@ -309,7 +309,7 @@
(def save-topstories ()
(writefile (map !id (firstn 180 ranked-stories*))
(+ newsdir* "topstories")))
-
+
(def rank-stories (n consider scorefn)
(bestn n (compare > scorefn) (latest-items metastory nil consider)))
@@ -318,15 +318,15 @@
(def latest-items (test (o stop) (o n))
(accum a
- (catch
+ (catch
(down id maxid* 1
(let i (item id)
- (if (or (and stop (stop i)) (and n (<= n 0)))
+ (if (or (and stop (stop i)) (and n (<= n 0)))
(throw))
- (when (test i)
- (a i)
+ (when (test i)
+ (a i)
(if n (-- n))))))))
-
+
; redefined later
(def metastory (i) (and i (in i!type 'story 'poll)))
@@ -337,7 +337,7 @@
; If something rose high then stopped getting votes, its score would
; decline but it would stay near the top. Newly inserted stories would
-; thus get stuck in front of it. I avoid this by regularly adjusting
+; thus get stuck in front of it. I avoid this by regularly adjusting
; the rank of a random top story.
(defbg rerank-random 30 (rerank-random))
@@ -347,7 +347,7 @@
(adjust-rank (ranked-stories* (rand (min 50 (len ranked-stories*)))))))
(def topstories (user n (o threshold front-threshold*))
- (retrieve n
+ (retrieve n
[and (>= (realscore _) threshold) (cansee user _)]
ranked-stories*))
@@ -376,13 +376,13 @@
(def cansee-descendant (user c)
(or (cansee user c)
- (some [cansee-descendant user (item _)]
+ (some [cansee-descendant user (item _)]
c!kids)))
-
-(def editor (u)
+
+(def editor (u)
(and u (or (admin u) (> (uvar u auth) 0))))
-(def member (u)
+(def member (u)
(and u (or (admin u) (uvar u member))))
@@ -398,14 +398,14 @@
(prn "<link rel=\"stylesheet\" type=\"text/css\" href=\"news.css\">"))
(mac npage (title . body)
- `(tag html
- (tag head
+ `(tag html
+ (tag head
(gen-css-url)
(prn "<link rel=\"shortcut icon\" href=\"" favicon-url* "\">")
(prn "<meta name=\"viewport\" content=\"width=device-width\">")
(tag script (pr votejs*))
(tag title (pr ,title)))
- (tag body
+ (tag body
(center
(tag (table border 0 cellpadding 0 cellspacing 0 width "85%"
bgcolor sand)
@@ -450,7 +450,7 @@
(tr (tdcolor c))))
(mac shortpage (user lid label title whence . body)
- `(fulltop ,user ,lid ,label ,title ,whence
+ `(fulltop ,user ,lid ,label ,title ,whence
(trtd ,@body)))
(mac minipage (label . body)
@@ -461,7 +461,7 @@
(def msgpage (user msg (o title))
(minipage (or title "Message")
(spanclass admin
- (center (if (len> msg 80)
+ (center (if (len> msg 80)
(widtable 500 msg)
(pr msg))))
(br2)))
@@ -482,7 +482,7 @@ input { font-family:Courier; font-size:10pt; color:#000000; }
input[type=\"submit\"] { font-family:Verdana; }
textarea { font-family:Courier; font-size:10pt; color:#000000; }
-a:link { color:#000000; text-decoration:none; }
+a:link { color:#000000; text-decoration:none; }
a:visited { color:#828282; text-decoration:none; }
.default { font-family:Verdana; font-size: 10pt; color:#828282; }
@@ -512,7 +512,7 @@ a:visited { color:#828282; text-decoration:none; }
.pagebreak {page-break-before:always}
pre { overflow: auto; padding: 2px; max-width:600px; }
-pre:hover {overflow:auto}
+pre:hover {overflow:auto}
@media (max-width: 517px) {
body { margin:0; }
@@ -544,7 +544,7 @@ function byId(id) {
function vote(node) {
var v = node.id.split(/_/); // {'up', '123'}
- var item = v[1];
+ var item = v[1];
// adjust score
var score = byId('score_' + item);
@@ -568,7 +568,7 @@ function vote(node) {
(= sand (color 246 246 239) textgray (gray 130))
-(def main-color (user)
+(def main-color (user)
(aif (and user (uvar user topcolor))
(hex>color it)
site-color*))
@@ -596,7 +596,7 @@ function vote(node) {
(def gen-logo ()
(tag (td style "width:18px;padding-right:4px")
(tag (a href parent-url*)
- (tag (img src logo-url* width 18 height 18
+ (tag (img src logo-url* width 18 height 18
style "border:1px #@(hexrep border-color*) solid;")))))
(= toplabels* '(nil "welcome" "new" "threads" "comments" "leaders" "*"))
@@ -606,9 +606,9 @@ function vote(node) {
(= welcome-url* "welcome")
(def toprow (user label)
- (w/bars
+ (w/bars
(when (noob user)
- (toplink "welcome" welcome-url* label))
+ (toplink "welcome" welcome-url* label))
(toplink "new" "newest" label)
(when user
(toplink "threads" (threads-url user) label))
@@ -624,7 +624,7 @@ function vote(node) {
(link name dest)))
(def topright (user whence (o showkarma t))
- (when user
+ (when user
(userlink user user nil)
(when showkarma (pr "&nbsp;(@(karma user))"))
(pr "&nbsp;|&nbsp;"))
@@ -634,8 +634,8 @@ function vote(node) {
(logout-user user)
whence))
(onlink "login"
- (login-page 'both nil
- (list (fn (u ip)
+ (login-page 'both nil
+ (list (fn (u ip)
(ensure-news-user u)
(newslog ip u 'top-login))
whence)))))
@@ -680,14 +680,14 @@ function vote(node) {
(mac adop (name parms . body)
(w/uniq g
- `(opexpand defopa ,name ,parms
+ `(opexpand defopa ,name ,parms
(let ,g (string ',name)
(shortpage user nil ,g ,g ,g
,@body)))))
(mac edop (name parms . body)
(w/uniq g
- `(opexpand defope ,name ,parms
+ `(opexpand defope ,name ,parms
(let ,g (string ',name)
(shortpage user nil ,g ,g ,g
,@body)))))
@@ -695,7 +695,7 @@ function vote(node) {
; News Admin
-(defopa newsadmin req
+(defopa newsadmin req
(let user (get-user req)
(newslog req!ip user 'newsadmin)
(newsadmin-page user)))
@@ -713,7 +713,7 @@ function vote(node) {
(def newsadmin-page (user)
(shortpage user nil nil "newsadmin" "newsadmin"
- (vars-form user
+ (vars-form user
(nad-fields)
(fn (name val)
(case name
@@ -722,7 +722,7 @@ function vote(node) {
comment-ignore (todisk comment-ignore* val)
lightweights (todisk lightweights* (memtable val))
))