diff options
Diffstat (limited to 'lang/elisp/primitives')
-rw-r--r-- | lang/elisp/primitives/features.scm | 3 | ||||
-rw-r--r-- | lang/elisp/primitives/fns.scm | 6 | ||||
-rw-r--r-- | lang/elisp/primitives/lists.scm | 29 | ||||
-rw-r--r-- | lang/elisp/primitives/load.scm | 2 | ||||
-rw-r--r-- | lang/elisp/primitives/match.scm | 2 | ||||
-rw-r--r-- | lang/elisp/primitives/numbers.scm | 7 | ||||
-rw-r--r-- | lang/elisp/primitives/pure.scm | 2 | ||||
-rw-r--r-- | lang/elisp/primitives/strings.scm | 5 | ||||
-rw-r--r-- | lang/elisp/primitives/symprop.scm | 12 | ||||
-rw-r--r-- | lang/elisp/primitives/syntax.scm | 118 |
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} |