ref: bb46003e44b4d2a7009f1888771c499a6e660054
parent: c8ff8d599f84e0209ed0c37e92b6e05f1d06995f
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Sat Mar 8 15:58:09 EST 2025
system, compiler: use "when" more, clean up "begin", fix indentation
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -44,8 +44,8 @@
#fn("n2120C5020:1J40q:1R3=021072151e3:1H3=023072151e3:1=J>0230721<51e3:74751523=0260271e2e3:280271e2e3:" #(elseeq? quote-value eqv? every symbol? memq quote memv) vals->cond)
#fn(gensym) let #fn(nconc) cond #fn(map) #fn("n1A<F0<520=P:" #()))) receive #fn("z22021q1e32221e10e123825153e3:" #(call-with-values- λ #fn(nconc) #fn(copy-list))) unwind-protect #fn("n2202122q1e3e2e1232402225e12621e12725e2e3e3e321e1e3e3:" #(let- #:g350 λ prog1 trycatch #:g351 begin raise)) dotimes #fn("z10<0T20E2187Ke32223e186e1e12415153e4:" #(for+ λ #fn(nconc) #fn(copy-list))) unwind-protect #fn("n2202122q1e3e2e1232402225e121e12625e2e4e321e1e3e3:" #(let+ #:g350 λ prog1 trycatch #:g351 raise)) dotimes #fn("z10<0T20E2187Ke32223e186e1e12415153e4:" #(for - #fn(nconc) λ #fn(copy-list))) throw #fn("n220212223e201e4e2:" #(raise list quote thrown-value))) 1+ #fn("n10KM:" #() 1+) 1- #fn("n10K~:" #() 1-) 1arg-lambda? #fn("n10B;3E04700<51;3:04710TK62:" #(is-lambda?@@ -149,7 +149,7 @@
compile-or #fn("n470018283q21q67:" #(compile-short-circuit brnn) compile-or) compile-prog1 #fn("n37001q82T544718251B3_00r40r4GKMp47201q718251544730245240r40r4Gr/Mp:q:" #(compile-incddr compile-begin emit pop) compile-prog1)
- compile-set! #fn("n470821E538821CF07201q83544730248263:88<El288=T893<07588=51@9076082528:3o07308937027@40288;5340r40r4GKMp47201q835440r40r4Gr/Mp47302962:7201q8354489JA07:2;2<825251@30q47302=8;63:" #(lookup-sym+ compile-set! #fn("n470821E538821CF07201q83544730248263:88<El288=T893<07588=51@9076082528:3o07308937027@40288;5340r40r4GKMp47201q835440r40r4Gr/Mp47302962:7201q8354489360q@>07:2;2<82525147302=8;63:" #(lookup-symglobal compile-in emit setg vinfo:index capture-var! loada loadc set-car! error #fn(string)
"internal error: misallocated var " seta) compile-set!)
compile-short-circuit #fn("n783H3?0700182848665:83=H3@070018283<8665:86;J70421507001q83<865540r40r4GKMp486360q@9072023524720858;5340r40r4Gr/Mp486360q@907202452475018283=84858657486340q:720268;63:" #(compile-in@@ -306,9 +306,9 @@
#fn(io-write) *linefeed* #fn(io-close))) #fn("n1A50420061:" #(#fn(raise)))) make-system-image) map! #fn("n21I1B3B04101<51_41=?1@\x1d/4:" #() map!) map-int #fn("n2701E52340q:0E51qPqb78786_4K7115122870>2|486:" #(<= 1- #fn("n1A<F051qPN4AA<=_:" #())) map-int)- max #fn("z11J400:70210163:" #(foldl #fn("n201L23401:0:" #())) max) member+ max #fn("z113;070210163:0:" #(foldl #fn("n201L23401:0:" #())) max) member #fn("n21<0d3401:13:07001=62:q:" #(member) member) memv #fn("n21<0c3401:13:07001=62:q:" #(memv) memv)- min #fn("z11J400:70210163:" #(foldl #fn("n201L23400:1:" #())) min) mod+ min #fn("z113;070210163:0:" #(foldl #fn("n201L23400:1:" #())) min) mod #fn("n207001521i2~:" #(div) mod) mod0 #fn("n2001k1i2~:" #() mod0) negative? #fn("n10EL2:" #() negative?) nestlist #fn("n37082E52340q:1710015182K~53P:" #(<=nestlist) nestlist)
@@ -416,10 +416,10 @@
*stderr* #fn("n0Aw0:" #(*output-stream*)) #fn("n070A51471225061:" #(print-exception print-stack-trace #fn(stacktrace))) #fn("n1A50420061:" #(#fn(raise)))) top-level-exception-handler)- trace #fn("n120051718551Jg0220732425262728290e225e3e22:e12;2985e225e3e4e35152@30q^147<60:" #(#fn(top-level-value)- traced? #fn(set-top-level-value!) eval λ #:g352 begin write cons quote newline apply void) trace)
- traced? #fn("n170051;3?042105121A<51d:" #(closure? #fn(function:code)) #((#fn("z020210P51472504230}2:" #(#fn(write)- x newline #.apply)))))
+ trace #fn("n120051718551Jc02207324252627280e225e3e229e12:2885e225e3e55152@30q^147;60:" #(#fn(top-level-value)+ traced? #fn(set-top-level-value!) eval λ #:g352 write cons quote newline apply void) trace)
+ traced? #fn("n170051;3>042105121A51d:" #(closure? #fn(function:code)) #(#fn("z020210P51472504230}2:" #(#fn(write)+ x newline #.apply))))
untrace #fn("n1200517185513C0220238551r3G52@30q^147460:" #(#fn(top-level-value) traced?#fn(set-top-level-value!)
#fn(function:vals) void) untrace)
--- a/src/compiler.lsp
+++ b/src/compiler.lsp
@@ -31,18 +31,17 @@
(else
(aset! e 0 (cons inst bc)))))
(begin
- (if (memq inst '(loadv loadg setg))
- (set! args (list (bcode:indexfor e (car args)))))
+ (when (memq inst '(loadv loadg setg))
+ (set! args (list (bcode:indexfor e (car args)))))
(let ((longform
(assq inst '((loadv loadv.l) (loadg loadg.l) (setg setg.l)
(loada loada.l) (seta seta.l) (box box.l)))))
- (if (and longform
- (> (car args) 255))
- (set! inst (cadr longform))))
+ (when (and longform (> (car args) 255))
+ (set! inst (cadr longform))))
(let ((longform
(assq inst '((loadc loadc.l)))))
- (if (and longform (> (car args) 255))
- (set! inst (cadr longform))))
+ (when (and longform (> (car args) 255))
+ (set! inst (cadr longform))))
(if (eq? inst 'loada)
(cond ((equal? args '(0))
(set! inst 'loada0)
@@ -90,59 +89,57 @@
(vi nil)
(nxt nil))
(while (< i n)
- (begin
- (set! vi (aref v i))
- (if (eq? vi 'label)
- (begin (put! label-to-loc (aref v (+ i 1)) (sizeof bcode))
- (set! i (+ i 2)))
- (begin
- (io-write bcode
- (get Instructions
- (if long?
- (case vi
- (jmp 'jmp.l)
- (brne 'brne.l)
- (brnn 'brnn.l)
- (brn 'brn.l)
- (else vi))
- vi)))
- (set! i (+ i 1))
- (set! nxt (and (< i n) (aref v i)))
- (cond ((memq vi '(jmp brne brnn brn))
- (put! fixup-to-label (sizeof bcode) nxt)
- (io-write bcode ((if long? s32 s16) 0))
- (set! i (+ i 1)))
- ((eq? vi 'brbound)
- (io-write bcode (s32 nxt))
- (set! i (+ i 1)))
- ((number? nxt)
- (case vi
- ((loadv.l loadg.l setg.l loada.l seta.l
- argc.l vargc.l call.l tcall.l loadc.l box.l)
- (io-write bcode (s32 nxt))
- (set! i (+ i 1)))
+ (set! vi (aref v i))
+ (if (eq? vi 'label)
+ (begin (put! label-to-loc (aref v (+ i 1)) (sizeof bcode))
+ (set! i (+ i 2)))
+ (begin
+ (io-write bcode
+ (get Instructions
+ (if long?
+ (case vi
+ (jmp 'jmp.l)
+ (brne 'brne.l)
+ (brnn 'brnn.l)
+ (brn 'brn.l)
+ (else vi))
+ vi)))
+ (set! i (+ i 1))
+ (set! nxt (and (< i n) (aref v i)))
+ (cond ((memq vi '(jmp brne brnn brn))
+ (put! fixup-to-label (sizeof bcode) nxt)
+ (io-write bcode ((if long? s32 s16) 0))
+ (set! i (+ i 1)))
+ ((eq? vi 'brbound)
+ (io-write bcode (s32 nxt))
+ (set! i (+ i 1)))
+ ((number? nxt)
+ (case vi
+ ((loadv.l loadg.l setg.l loada.l seta.l
+ argc.l vargc.l call.l tcall.l loadc.l box.l)
+ (io-write bcode (s32 nxt))
+ (set! i (+ i 1)))
- ((optargs keyargs) ; 2 s32 args
- (io-write bcode (s32 nxt))
- (set! i (+ i 1))
+ ((optargs keyargs) ; 2 s32 args
+ (io-write bcode (s32 nxt))
+ (set! i (+ i 1))
+ (io-write bcode (s32 (aref v i)))
+ (set! i (+ i 1))
+ (when (eq? vi 'keyargs)
(io-write bcode (s32 (aref v i)))
- (set! i (+ i 1))
- (if (eq? vi 'keyargs)
- (begin (io-write bcode (s32 (aref v i)))
- (set! i (+ i 1)))))
+ (set! i (+ i 1))))
- (else
- ; other number arguments are always u8
- (io-write bcode (u8 nxt))
- (set! i (+ i 1)))))
- (else nil))))))
+ (else
+ ; other number arguments are always u8
+ (io-write bcode (u8 nxt))
+ (set! i (+ i 1)))))
+ (else nil)))))
(for-each
(λ (addr labl)
- (begin (io-seek bcode addr)
- (io-write bcode ((if long? s32 s16)
- (- (get label-to-loc labl)
- addr)))))
+ (io-seek bcode addr)
+ (io-write bcode ((if long? s32 s16)
+ (- (get label-to-loc labl) addr))))
fixup-to-label)
(iostream->string bcode))))
@@ -203,13 +200,13 @@
((= (car loc) 0)
(emit g 'loada (vinfo:index (cdr loc)))
- (if (and deref (vinfo:heap? (cdr loc)))
- (emit g 'car)))
+ (when (and deref (vinfo:heap? (cdr loc)))
+ (emit g 'car)))
(else
(emit g 'loadc (capture-var! g s))
- (if (and deref (vinfo:heap? (cdr loc)))
- (emit g 'car))))))
+ (when (and deref (vinfo:heap? (cdr loc)))
+ (emit g 'car))))))
(def (compile-aset! g env args)
(let ((nref (- (length args) 2)))
@@ -240,15 +237,15 @@
(emit g 'set-car!))
(begin (compile-in g env nil rhs)
- (if (not arg?) (error (string "internal error: misallocated var " s)))
+ (unless arg? (error (string "internal error: misallocated var " s)))
(emit g 'seta idx))))))))
(def (box-vars g env)
(let loop ((e env))
- (if (cons? e)
- (begin (if (cadr (car e))
- (emit g 'box (caddr (car e))))
- (loop (cdr e))))))
+ (when (cons? e)
+ (if (cadr (car e))
+ (emit g 'box (caddr (car e))))
+ (loop (cdr e)))))
;; control flow
@@ -288,11 +285,11 @@
(def (compile-prog1 g env x)
(compile-in g env nil (cadr x))
- (if (cons? (cddr x))
- (begin (bcode:stack g 1)
- (compile-begin g env nil (cddr x))
- (emit g 'pop)
- (bcode:stack g -1))))
+ (when (cons? (cddr x))
+ (bcode:stack g 1)
+ (compile-begin g env nil (cddr x))
+ (emit g 'pop)
+ (bcode:stack g -1)))
(def (compile-while g env cond body)
(let ((top (make-label g))
@@ -374,9 +371,8 @@
(argc-error b 1)
(emit g b nargs)))
(let ((count (get arg-counts b nil)))
- (if (and count
- (not (length= (cdr x) count)))
- (argc-error b count))
+ (when (and count (not (length= (cdr x) count)))
+ (argc-error b count))
(case b ; handle special cases of vararg builtins
(list (if (= nargs 0)
(emit g 'loadnil)
@@ -431,8 +427,8 @@
(cdr env))))
(compile-in g newenv tail? (caddr lam))
(bcode:stack g (- n))
- (if (and (> n 0) (not tail?))
- (emit g 'shift n)))))))
+ (when (and (> n 0) (not tail?))
+ (emit g 'shift n)))))))
(def (compile-app g env tail? x)
(let ((head (car x)))
@@ -501,12 +497,11 @@
(prog1 (compile-prog1 g env x))
(λ (receive (the-f cenv) (compile-f- env x)
(begin (emit g 'loadv the-f)
- (if cenv
- (begin
- (for-each (λ (var)
- (compile-sym g env var nil))
- cenv)
- (emit g 'closure (length cenv)))))))
+ (when cenv
+ (for-each (λ (var)
+ (compile-sym g env var nil))
+ cenv)
+ (emit g 'closure (length cenv))))))
(and (compile-and g env tail? (cdr x) outl))
(or (compile-or g env tail? (cdr x)))
(while (compile-while g env (cadr x) (cons 'begin (cddr x))))
@@ -572,15 +567,15 @@
(def (emit-optional-arg-inits g env opta vars i)
; i is the lexical var index of the opt arg to process next
- (if (cons? opta)
- (let ((nxt (make-label g)))
- (emit g 'brbound i)
- (emit g 'brnn nxt)
- (compile-in g (extend-env env (list-head vars i) '()) nil (cadar opta))
- (emit g 'seta i)
- (emit g 'pop)
- (mark-label g nxt)
- (emit-optional-arg-inits g env (cdr opta) vars (+ i 1)))))
+ (when (cons? opta)
+ (let ((nxt (make-label g)))
+ (emit g 'brbound i)
+ (emit g 'brnn nxt)
+ (compile-in g (extend-env env (list-head vars i) '()) nil (cadar opta))
+ (emit g 'seta i)
+ (emit g 'pop)
+ (mark-label g nxt)
+ (emit-optional-arg-inits g env (cdr opta) vars (+ i 1)))))
;; define
@@ -651,13 +646,13 @@
(def (complex-bindings- e vars head nested capt setd)
(cond ((not vars) nil)
((symbol? e)
- (if (and nested (memq e vars))
- (put! capt e t)))
+ (when (and nested (memq e vars))
+ (put! capt e t)))
((or (atom? e) (quoted? e)) nil)
((eq? (car e) 'set!)
- (if (memq (cadr e) vars)
- (begin (put! setd (cadr e) t)
- (if nested (put! capt (cadr e) t))))
+ (when (memq (cadr e) vars)
+ (put! setd (cadr e) t)
+ (if nested (put! capt (cadr e) t)))
(complex-bindings- (caddr e) vars nil nested capt setd))
((is-lambda? (car e))
(complex-bindings- (lambda:body e)
@@ -782,7 +777,7 @@
(or z (and (= v (aref code i))
k)))
nil Instructions)))
- (if (> i 0) (newline))
+ (when (> i 0) (newline))
(dotimes (xx lev) (princ "\t"))
(set! i (+ i 1))
(case inst
@@ -813,11 +808,10 @@
(set! i (+ i 4))
(princ (number->string (ref-s32-LE code i)))
(set! i (+ i 4))
- (if (eq? inst 'keyargs)
- (begin
- (princ " ")
- (princ (number->string (ref-s32-LE code i)) " ")
- (set! i (+ i 4)))))
+ (when (eq? inst 'keyargs)
+ (princ " ")
+ (princ (number->string (ref-s32-LE code i)) " ")
+ (set! i (+ i 4))))
((brbound)
(print-inst inst i 4)
--- a/src/system.lsp
+++ b/src/system.lsp
@@ -46,10 +46,11 @@
(set! body (cdr body)))
(let ((thelambda
`(λ ,(map (λ (c) (if (cons? c) (car c) c))
- binds)
+ binds)
,@body))
(theargs
- (map (λ (c) (if (cons? c) (cadr c) (void))) binds)))
+ (map (λ (c) (if (cons? c) (cadr c) (void)))
+ binds)))
(cons (if lname
`(letrec ((,lname ,thelambda)) ,lname)
thelambda)
@@ -76,7 +77,8 @@
; test => (λ (x) ...)
(let ((var (caadr (caddr clause))))
`(let ((,var ,(car clause)))
- (if ,var ,(cons 'begin (cddr (caddr clause)))
+ (if ,var
+ ,(cons 'begin (cddr (caddr clause)))
,(cond-clauses->if (cdr lst)))))
; test => proc
`(let ((b# ,(car clause)))
@@ -200,38 +202,79 @@
"Return T if not all arguments are equal. Shorthand for (not (= …))."
`(not (= ,a ,@rest)))
-(def (negative? x) (< x 0))
-(def (zero? x) (= x 0))
-(def (positive? x) (> x 0))
-(def (even? x) (= (logand x 1) 0))
-(def (odd? x) (not (even? x)))
-(def (identity x) x)
-(def (1+ n) (+ n 1))
-(def (1- n) (- n 1))
-(def (mod0 x y) (- x (* (div0 x y) y)))
-(def (div x y) (+ (div0 x y)
- (or (and (< x 0)
- (or (and (< y 0) 1)
- -1))
- 0)))
-(def (mod x y) (- x (* (div x y) y)))
+(def (negative? x)
+ (< x 0))
+
+(def (zero? x)
+ (= x 0))
+
+(def (positive? x)
+ (> x 0))
+
+(def (even? x)
+ (= (logand x 1) 0))
+
+(def (odd? x)
+ (not (even? x)))
+
+(def (identity x)
+ x)
+
+(def (1+ n)
+ (+ n 1))
+
+(def (1- n)
+ (- n 1))
+
+(def (div x y)
+ (+ (div0 x y)
+ (or (and (< x 0)
+ (or (and (< y 0) 1)
+ -1))
+ 0)))
+
+(def (mod0 x y)
+ (- x (* (div0 x y) y)))
+
+(def (mod x y)
+ (- x (* (div x y) y)))
+
(def (random n)
(if (integer? n)
(mod (rand) n)
(* (rand-double) n)))
-(def (abs x) (if (< x 0) (- x) x))
+
+(def (abs x)
+ (if (< x 0)
+ (- x)
+ x))
+
(def (max x0 . xs)
- (if (not xs) x0
- (foldl (λ (a b) (if (< a b) b a)) x0 xs)))
+ (if xs
+ (foldl (λ (a b) (if (< a b) b a))
+ x0
+ xs)
+ x0))
+
(def (min x0 . xs)
- (if (not xs) x0
- (foldl (λ (a b) (if (< a b) a b)) x0 xs)))
-(def (char? x) (eq? (typeof x) 'rune))
-(def (array? x) (or (vector? x)
- (let ((tx (typeof x)))
- (and (cons? tx) (eq? (car tx) 'array)))))
-(def (closure? x) (and (function? x) (not (builtin? x))))
+ (if xs
+ (foldl (λ (a b) (if (< a b) a b))
+ x0
+ xs)
+ x0))
+(def (char? x)
+ (eq? (typeof x) 'rune))
+
+(def (array? x)
+ (or (vector? x)
+ (let ((tx (typeof x)))
+ (and (cons? tx) (eq? (car tx) 'array)))))
+
+(def (closure? x)
+ (and (function? x)
+ (not (builtin? x))))
+
(def (caar x) (car (car x)))
(def (cdar x) (cdr (car x)))
(def (cddr x) (cdr (cdr x)))
@@ -288,11 +331,13 @@
(def (list? a) (or (not a) (and (cons? a) (list? (cdr a)))))
(def (list-tail lst n)
- (if (<= n 0) lst
+ (if (<= n 0)
+ lst
(list-tail (cdr lst) (- n 1))))
(def (list-head lst n)
- (if (<= n 0) ()
+ (if (<= n 0)
+ ()
(cons (car lst)
(list-head (cdr lst) (- n 1)))))
@@ -369,22 +414,27 @@
(count- f l 0))
(def (nestlist f zero n)
- (if (<= n 0) ()
+ (if (<= n 0)
+ ()
(cons zero (nestlist f (f zero) (- n 1)))))
(def (foldr f zero lst)
- (if (not lst) zero
+ (if (not lst)
+ zero
(f (car lst) (foldr f zero (cdr lst)))))
(def (foldl f zero lst)
- (if (not lst) zero
+ (if (not lst)
+ zero
(foldl f (f (car lst) zero) (cdr lst))))
(def (reverse- zero lst)
- (if (not lst) zero
+ (if (not lst)
+ zero
(reverse- (cons (car lst) zero) (cdr lst))))
-(def (reverse lst) (reverse- () lst))
+(def (reverse lst)
+ (reverse- () lst))
(def (reverse!- prev l)
(while (cons? l)
@@ -393,12 +443,14 @@
(set! prev l))))))
prev)
-(def (reverse! l) (reverse!- () l))
+(def (reverse! l)
+ (reverse!- () l))
(def (copy-tree l)
- (if (atom? l) l
- (cons (copy-tree (car l))
- (copy-tree (cdr l)))))
+ (if (atom? l)
+ l
+ (cons (copy-tree (car l))
+ (copy-tree (cdr l)))))
(def (delete-duplicates lst)
(if (length> lst 20)
@@ -520,7 +572,8 @@
(list 'quote v)))
(defmacro (let* binds . body)
- (if (atom? binds) `((λ () ,@body))
+ (if (atom? binds)
+ `((λ () ,@body))
`((λ (,(caar binds))
,@(if (cons? (cdr binds))
`((let* ,(cdr binds) ,@body))
@@ -615,7 +668,7 @@
(defmacro (unwind-protect expr finally)
`(let ((thk# (λ () ,finally)))
(prog1 (trycatch ,expr
- (λ (e#) (begin (thk#) (raise e#))))
+ (λ (e#) (thk#) (raise e#)))
(thk#))))
;;; debugging utilities
@@ -623,9 +676,9 @@
(defmacro (assert expr) `(if ,expr t (raise '(assert-failed ,expr))))
(def traced?
- (letrec ((sample-traced-lambda (λ args (begin (write (cons 'x args))
- (newline)
- (apply #.apply args)))))
+ (let ((sample-traced-lambda (λ args (write (cons 'x args))
+ (newline)
+ (apply #.apply args))))
(λ (f)
(and (closure? f)
(equal? (function:code f)
@@ -632,14 +685,14 @@
(function:code sample-traced-lambda))))))
(def (trace sym)
- (let* ((func (top-level-value sym)))
+ (let ((func (top-level-value sym)))
(when (not (traced? func))
(set-top-level-value! sym
(eval
`(λ args#
- (begin (write (cons ',sym args#))
- (newline)
- (apply ',func args#)))))))
+ (write (cons ',sym args#))
+ (newline)
+ (apply ',func args#))))))
(void))
(def (untrace sym)
@@ -739,12 +792,12 @@
(def (string-trim s at-start at-end)
(def (trim-start s chars i L)
(if (and (< i L) (string-find chars (string-char s i)))
- (trim-start s chars (1+ i) L)
- i))
+ (trim-start s chars (1+ i) L)
+ i))
(def (trim-end s chars i)
(if (and (> i 0) (string-find chars (string-char s (1- i))))
- (trim-end s chars (1- i))
- i))
+ (trim-end s chars (1- i))
+ i))
(let ((L (string-length s)))
(string-sub s
(trim-start s at-start 0 L)
@@ -755,8 +808,8 @@
(n (string-length s)))
(let ((i 0))
(while (< i n)
- (begin (io-putc b (f (string-char s i)))
- (set! i (1+ i)))))
+ (io-putc b (f (string-char s i)))
+ (set! i (1+ i))))
(iostream->string b)))
(def (string-rep s k)
@@ -777,7 +830,8 @@
(iostream->string b)))
(def (string-join strlist sep)
- (if (not strlist) ""
+ (if (not strlist)
+ ""
(let ((b (buffer)))
(io-write b (car strlist))
(for-each (λ (s) (io-write b sep)
@@ -791,9 +845,11 @@
(symbol-syntax (car e))))
(def (macroexpand-1 e)
- (if (atom? e) e
+ (if (atom? e)
+ e
(let ((f (macrocall? e)))
- (if f (apply f (cdr e))
+ (if f
+ (apply f (cdr e))
e))))
(def (macroexpand e)
@@ -813,7 +869,8 @@
(def *expanded* (list '*expanded*))
(def (expand-body body env)
- (if (atom? body) body
+ (if (atom? body)
+ body
(let* ((body (if (top? 'begin env)
(splice-begin body)
body))
@@ -845,7 +902,8 @@
ex-nondefs)))))
(def (expand-lambda-list l env)
- (if (atom? l) l
+ (if (atom? l)
+ l
(cons (if (and (cons? (car l)) (cons? (cdr (car l))))
(list (caar l) (expand-in (cadar l) env))
(car l))
@@ -907,12 +965,14 @@
(def (local-expansion-env menv lenv) menv)
(def (expand-in e env)
- (if (atom? e) e
+ (if (atom? e)
+ e
(let* ((head (car e))
(bnd (assq head env))
(default (λ ()
(let loop ((e e))
- (if (atom? e) e
+ (if (atom? e)
+ e
(cons (if (atom? (car e))
(car e)
(expand-in (car e) env))
@@ -1049,7 +1109,8 @@
(princ ": ")
(let ((msg (cadr e)))
((if (or (string? msg) (symbol? msg))
- princ print)
+ princ
+ print)
msg)))
(else (princ "*** Unhandled exception: ")
@@ -1058,7 +1119,8 @@
(princ *linefeed*))
(def (simple-sort l)
- (if (or (not l) (not (cdr l))) l
+ (if (or (not l) (not (cdr l)))
+ l
(let ((piv (car l)))
(receive (less grtr)
(partition (λ (x) (< x piv)) (cdr l))
@@ -1105,8 +1167,8 @@
(def (__script fname)
(trycatch (load fname)
- (λ (e) (begin (top-level-exception-handler e)
- (exit 1)))))
+ (λ (e) (top-level-exception-handler e)
+ (exit 1))))
(def (__rcscript)
(let* ((homevar (case *os-name*
@@ -1119,7 +1181,8 @@
(("plan9") "lib/slrc")(else ".slrc")))
(fname (and home (string home *directory-separator* rcpath))))
- (when (and fname (path-exists? fname)) (load fname))))
+ (when (and fname (path-exists? fname))
+ (load fname))))
(def (__start argv)
(__init_globals)