summaryrefslogtreecommitdiff
path: root/lang/elisp/primitives
diff options
context:
space:
mode:
Diffstat (limited to 'lang/elisp/primitives')
-rw-r--r--lang/elisp/primitives/features.scm3
-rw-r--r--lang/elisp/primitives/fns.scm6
-rw-r--r--lang/elisp/primitives/lists.scm29
-rw-r--r--lang/elisp/primitives/load.scm2
-rw-r--r--lang/elisp/primitives/match.scm2
-rw-r--r--lang/elisp/primitives/numbers.scm7
-rw-r--r--lang/elisp/primitives/pure.scm2
-rw-r--r--lang/elisp/primitives/strings.scm5
-rw-r--r--lang/elisp/primitives/symprop.scm12
-rw-r--r--lang/elisp/primitives/syntax.scm118
10 files changed, 95 insertions, 91 deletions
diff --git a/lang/elisp/primitives/features.scm b/lang/elisp/primitives/features.scm
index 3d1e468ed..8cd1a9958 100644
--- a/lang/elisp/primitives/features.scm
+++ b/lang/elisp/primitives/features.scm
@@ -1,6 +1,7 @@
(define-module (lang elisp primitives features)
#:use-module (lang elisp internals fset)
#:use-module (lang elisp internals load)
+ #:use-module (lang elisp internals null)
#:use-module (ice-9 optargs))
(define-public features '())
@@ -12,7 +13,7 @@
(fset 'featurep
(lambda (feature)
- (memq feature features)))
+ (->nil (memq feature features))))
(fset 'require
(lambda* (feature #:optional file-name noerror)
diff --git a/lang/elisp/primitives/fns.scm b/lang/elisp/primitives/fns.scm
index ba2b53a79..f7a4aa003 100644
--- a/lang/elisp/primitives/fns.scm
+++ b/lang/elisp/primitives/fns.scm
@@ -18,11 +18,11 @@
(fset 'commandp
(lambda (sym)
- (if (interactive-spec (fref sym)) #t %nil)))
+ (if (interactive-specification (fref sym)) #t %nil)))
(fset 'fboundp
(lambda (sym)
- (variable? (symbol-fref sym))))
+ (->nil (variable? (symbol-fref sym)))))
(fset 'symbol-function fref/error-if-void)
@@ -30,7 +30,7 @@
(fset 'subrp
(lambda (obj)
- (not (not-subr? obj))))
+ (->nil (not (not-subr? obj)))))
(fset 'byte-code-function-p
(lambda (object)
diff --git a/lang/elisp/primitives/lists.scm b/lang/elisp/primitives/lists.scm
index 43843f811..4907ed59d 100644
--- a/lang/elisp/primitives/lists.scm
+++ b/lang/elisp/primitives/lists.scm
@@ -3,9 +3,7 @@
#:use-module (lang elisp internals null)
#:use-module (lang elisp internals signal))
-(fset 'cons
- (lambda (x y)
- (cons x (or y '()))))
+(fset 'cons cons)
(fset 'null null)
@@ -14,13 +12,13 @@
(fset 'car
(lambda (l)
(if (null l)
- #f
+ %nil
(car l))))
(fset 'cdr
(lambda (l)
(if (null l)
- #f
+ %nil
(cdr l))))
(fset 'eq
@@ -35,12 +33,7 @@
(fset 'setcar set-car!)
-(fset 'setcdr
- (lambda (cell newcdr)
- (set-cdr! cell
- (if (null newcdr)
- '()
- newcdr))))
+(fset 'setcdr set-cdr!)
(for-each (lambda (sym proc)
(fset sym
@@ -48,14 +41,10 @@
(if (null list)
%nil
(if (null elt)
- (or (proc #f list)
- (proc '() list)
- (proc %nil list)
- (proc 'nil list)) ; 'nil shouldn't be
- ; here, as it should
- ; have been
- ; translated by the
- ; transformer.
+ (let loop ((l list))
+ (cond ((null l) %nil)
+ ((null (car l)) l)
+ (else (loop (cdr l)))))
(proc elt list))))))
'( memq member assq assoc)
`(,memq ,member ,assq ,assoc))
@@ -97,7 +86,7 @@
(lambda (n list)
(if (or (null list)
(>= n (length list)))
- #f
+ %nil
(list-ref list n))))
(fset 'listp
diff --git a/lang/elisp/primitives/load.scm b/lang/elisp/primitives/load.scm
index 85915f1f7..a627b5d10 100644
--- a/lang/elisp/primitives/load.scm
+++ b/lang/elisp/primitives/load.scm
@@ -14,4 +14,4 @@
(lambda args
#t))
-(define-public current-load-list #f)
+(define-public current-load-list %nil)
diff --git a/lang/elisp/primitives/match.scm b/lang/elisp/primitives/match.scm
index 9b232c1ae..0a04ef5c5 100644
--- a/lang/elisp/primitives/match.scm
+++ b/lang/elisp/primitives/match.scm
@@ -45,7 +45,7 @@
(iota (match:count match))))
#f)))
- (if last-match (car last-match) #f)))
+ (if last-match (car last-match) %nil)))
(fset 'match-beginning
(lambda (subexp)
diff --git a/lang/elisp/primitives/numbers.scm b/lang/elisp/primitives/numbers.scm
index dd72551dd..43246d32f 100644
--- a/lang/elisp/primitives/numbers.scm
+++ b/lang/elisp/primitives/numbers.scm
@@ -1,9 +1,10 @@
(define-module (lang elisp primitives numbers)
- #:use-module (lang elisp internals fset))
+ #:use-module (lang elisp internals fset)
+ #:use-module (lang elisp internals null))
(fset 'logior logior)
(fset 'logand logand)
-(fset 'integerp integer?)
+(fset 'integerp (lambda->nil integer?))
(fset '= =)
(fset '< <)
(fset '> >)
@@ -39,4 +40,4 @@
(- shift 1))))))
lsh))
-(fset 'numberp number?)
+(fset 'numberp (lambda->nil number?))
diff --git a/lang/elisp/primitives/pure.scm b/lang/elisp/primitives/pure.scm
index 217550c53..7cb6b5317 100644
--- a/lang/elisp/primitives/pure.scm
+++ b/lang/elisp/primitives/pure.scm
@@ -5,4 +5,4 @@
(fset 'purecopy identity)
-(define-public purify-flag #f)
+(define-public purify-flag %nil)
diff --git a/lang/elisp/primitives/strings.scm b/lang/elisp/primitives/strings.scm
index 08bd8f8de..85a1c10a9 100644
--- a/lang/elisp/primitives/strings.scm
+++ b/lang/elisp/primitives/strings.scm
@@ -1,5 +1,6 @@
(define-module (lang elisp primitives strings)
#:use-module (lang elisp internals fset)
+ #:use-module (lang elisp internals null)
#:use-module (lang elisp internals signal))
(fset 'substring substring)
@@ -19,7 +20,7 @@
(fset 'number-to-string number->string)
-(fset 'string-lessp string<?)
+(fset 'string-lessp (lambda->nil string<?))
(fset 'string< 'string-lessp)
(fset 'aref
@@ -28,6 +29,6 @@
((string? array) (char->integer (string-ref array idx)))
(else (wta 'arrayp array 1)))))
-(fset 'stringp string?)
+(fset 'stringp (lambda->nil string?))
(fset 'vector vector)
diff --git a/lang/elisp/primitives/symprop.scm b/lang/elisp/primitives/symprop.scm
index 4ca169226..a520a4b81 100644
--- a/lang/elisp/primitives/symprop.scm
+++ b/lang/elisp/primitives/symprop.scm
@@ -1,7 +1,8 @@
(define-module (lang elisp primitives symprop)
- #:use-module (lang elisp internals set)
- #:use-module (lang elisp internals fset)
#:use-module (lang elisp internals evaluation)
+ #:use-module (lang elisp internals fset)
+ #:use-module (lang elisp internals null)
+ #:use-module (lang elisp internals set)
#:use-module (ice-9 optargs))
;;; {Elisp Exports}
@@ -16,7 +17,7 @@
(fset 'boundp
(lambda (sym)
- (module-defined? the-elisp-module sym)))
+ (->nil (module-defined? the-elisp-module sym))))
(fset 'default-boundp 'boundp)
@@ -29,10 +30,11 @@
(fset 'symbolp
(lambda (object)
(or (symbol? object)
- (keyword? object))))
+ (keyword? object)
+ %nil)))
(fset 'local-variable-if-set-p
(lambda* (variable #:optional buffer)
- #f))
+ %nil))
(fset 'symbol-name symbol->string)
diff --git a/lang/elisp/primitives/syntax.scm b/lang/elisp/primitives/syntax.scm
index 7f7e4af21..a597cd06a 100644
--- a/lang/elisp/primitives/syntax.scm
+++ b/lang/elisp/primitives/syntax.scm
@@ -32,7 +32,6 @@
`(,quote ,(cadr exp))
`(,begin (,if (,not (,defined? (,quote ,(cadr exp))))
,(setq (list (car exp) (cadr exp) (caddr exp)) env))
- ;; (,macro-setq ,(cadr exp) ,(caddr exp)))
(,quote ,(cadr exp)))))))
(fset 'defconst
@@ -87,28 +86,28 @@
`(((,> %--num-args ,(+ num-required num-optional))
(,error "Wrong number of args (too many args)"))))
(else (,transformer
- (@bind ,(append (map (lambda (i)
- (list (list-ref required i)
- `(,list-ref %--args ,i)))
- (iota num-required))
- (map (lambda (i)
- (let ((i+nr (+ i num-required)))
- (list (list-ref optional i)
- `(,if (,> %--num-args ,i+nr)
- (,list-ref %--args ,i+nr)
- #f))))
- (iota num-optional))
- (if rest
- (list (list rest
- `(,if (,> %--num-args
- ,(+ num-required
- num-optional))
- (,list-tail %--args
- ,(+ num-required
- num-optional))
- '())))
- '()))
- ,@(map transformer (cdddr exp)))))))))))))))))
+ (, @bind ,(append (map (lambda (i)
+ (list (list-ref required i)
+ `(,list-ref %--args ,i)))
+ (iota num-required))
+ (map (lambda (i)
+ (let ((i+nr (+ i num-required)))
+ (list (list-ref optional i)
+ `(,if (,> %--num-args ,i+nr)
+ (,list-ref %--args ,i+nr)
+ ,%nil))))
+ (iota num-optional))
+ (if rest
+ (list (list rest
+ `(,if (,> %--num-args
+ ,(+ num-required
+ num-optional))
+ (,list-tail %--args
+ ,(+ num-required
+ num-optional))
+ ,%nil)))
+ '()))
+ ,@(map transformer (cdddr exp)))))))))))))))))
;;; {Sequencing}
@@ -120,36 +119,34 @@
(fset 'prog1
(procedure->memoizing-macro
(lambda (exp env)
- `(,let ((%res1 ,(transformer (cadr exp))))
+ `(,let ((%--res1 ,(transformer (cadr exp))))
,@(map transformer (cddr exp))
- %res1))))
+ %--res1))))
(fset 'prog2
(procedure->memoizing-macro
(lambda (exp env)
`(,begin ,(transformer (cadr exp))
- (,let ((%res2 ,(transformer (caddr exp))))
+ (,let ((%--res2 ,(transformer (caddr exp))))
,@(map transformer (cdddr exp))
- %res2)))))
+ %--res2)))))
;;; {Conditionals}
-(define <-- *unspecified*)
-
(fset 'if
(procedure->memoizing-macro
(lambda (exp env)
(let ((else-case (cdddr exp)))
(cond ((null? else-case)
- `(nil-cond ,(transformer (cadr exp)) ,(transformer (caddr exp)) #f))
+ `(,nil-cond ,(transformer (cadr exp)) ,(transformer (caddr exp)) ,%nil))
((null? (cdr else-case))
- `(nil-cond ,(transformer (cadr exp))
- ,(transformer (caddr exp))
- ,(transformer (car else-case))))
+ `(,nil-cond ,(transformer (cadr exp))
+ ,(transformer (caddr exp))
+ ,(transformer (car else-case))))
(else
- `(nil-cond ,(transformer (cadr exp))
- ,(transformer (caddr exp))
- (,begin ,@(map transformer else-case)))))))))
+ `(,nil-cond ,(transformer (cadr exp))
+ ,(transformer (caddr exp))
+ (,begin ,@(map transformer else-case)))))))))
(fset 'and
(procedure->memoizing-macro
@@ -162,13 +159,26 @@
(if (null? (cdr args))
(list (transformer (car args)))
(cons (list not (transformer (car args)))
- (cons #f
+ (cons %nil
(loop (cdr args))))))))))))
+;;; NIL-COND expressions have the form:
+;;;
+;;; (nil-cond COND VAL COND VAL ... ELSEVAL)
+;;;
+;;; The CONDs are evaluated in order until one of them returns true
+;;; (in the Elisp sense, so not including empty lists). If a COND
+;;; returns true, its corresponding VAL is evaluated and returned,
+;;; except if that VAL is the unspecified value, in which case the
+;;; result of evaluating the COND is returned. If none of the COND's
+;;; returns true, ELSEVAL is evaluated and its value returned.
+
+(define <-- *unspecified*)
+
(fset 'or
(procedure->memoizing-macro
(lambda (exp env)
- (cond ((null? (cdr exp)) #f)
+ (cond ((null? (cdr exp)) %nil)
((null? (cddr exp)) (transformer (cadr exp)))
(else
(cons nil-cond
@@ -183,15 +193,15 @@
(procedure->memoizing-macro
(lambda (exp env)
(if (null? (cdr exp))
- #f
+ %nil
(cons
nil-cond
(let loop ((clauses (cdr exp)))
(if (null? clauses)
- '(#f)
+ (list %nil)
(let ((clause (car clauses)))
(if (eq? (car clause) #t)
- (cond ((null? (cdr clause)) '(t))
+ (cond ((null? (cdr clause)) (list #t))
((null? (cddr clause))
(list (transformer (cadr clause))))
(else `((,begin ,@(map transformer (cdr clause))))))
@@ -210,7 +220,7 @@
(,nil-cond ,(transformer (cadr exp))
(,begin ,@(map transformer (cddr exp))
(%--while))
- #f))))
+ ,%nil))))
%--while)))))
;;; {Local binding}
@@ -218,13 +228,13 @@
(fset 'let
(procedure->memoizing-macro
(lambda (exp env)
- `(@bind ,(map (lambda (binding)
- (trc 'let binding)
- (if (pair? binding)
- `(,(car binding) ,(transformer (cadr binding)))
- `(,binding #f)))
- (cadr exp))
- ,@(map transformer (cddr exp))))))
+ `(, @bind ,(map (lambda (binding)
+ (trc 'let binding)
+ (if (pair? binding)
+ `(,(car binding) ,(transformer (cadr binding)))
+ `(,binding ,%nil)))
+ (cadr exp))
+ ,@(map transformer (cddr exp))))))
(fset 'let*
(procedure->memoizing-macro
@@ -234,11 +244,11 @@
(car (let loop ((bindings (cadr exp)))
(if (null? bindings)
(map transformer (cddr exp))
- `((@bind (,(let ((binding (car bindings)))
- (if (pair? binding)
- `(,(car binding) ,(transformer (cadr binding)))
- `(,binding #f))))
- ,@(loop (cdr bindings)))))))))))
+ `((, @bind (,(let ((binding (car bindings)))
+ (if (pair? binding)
+ `(,(car binding) ,(transformer (cadr binding)))
+ `(,binding ,%nil))))
+ ,@(loop (cdr bindings)))))))))))
;;; {Exception handling}