artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Revert "mes: un-defmacro optargs. WIP"

Browse source 
This reverts commit 5da527c540dc0e1481a010899233b4e806fe37da.
This commit is contained in:
Jan Nieuwenhuizen 2018-01-07 14:52:09 +01:00
parent a8e8f0a1e3
commit 0fab33da36
2 changed files with 17 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
module/mes/optargs.mes
View file

@ -26,6 +26,9 @@
(mes-use-module (mes scm)) (mes-use-module (mes scm))
(define-macro (defmacro name args . body)
`(define-macro ,(cons name args) ,@body))
(define-macro (set-procedure-property! proc key value) (define-macro (set-procedure-property! proc key value)
proc) proc)

26
module/mes/optargs.scm
View file

@ -85,12 +85,14 @@
;; bound to whatever may have been left of rest-arg. ;; bound to whatever may have been left of rest-arg.
;; ;;
(define-macro (let-optional REST-ARG BINDINGS . BODY) (defmacro let-optional (REST-ARG BINDINGS . BODY)
(let-optional-template REST-ARG BINDINGS BODY 'let)) (let-optional-template REST-ARG BINDINGS BODY 'let))
(define-macro (let-optional* REST-ARG BINDINGS . BODY) (defmacro let-optional* (REST-ARG BINDINGS . BODY)
(let-optional-template REST-ARG BINDINGS BODY 'let*)) (let-optional-template REST-ARG BINDINGS BODY 'let*))
;; let-keywords rest-arg allow-other-keys? (binding ...) . body ;; let-keywords rest-arg allow-other-keys? (binding ...) . body
;; let-keywords* rest-arg allow-other-keys? (binding ...) . body ;; let-keywords* rest-arg allow-other-keys? (binding ...) . body
;; macros used to bind keyword arguments ;; macros used to bind keyword arguments
@ -106,10 +108,10 @@
;; ;;
(define-macro (let-keywords REST-ARG ALLOW-OTHER-KEYS? BINDINGS . BODY) (defmacro let-keywords (REST-ARG ALLOW-OTHER-KEYS? BINDINGS . BODY)
(let-keywords-template REST-ARG ALLOW-OTHER-KEYS? BINDINGS BODY 'let)) (let-keywords-template REST-ARG ALLOW-OTHER-KEYS? BINDINGS BODY 'let))
(define-macro (let-keywords* REST-ARG ALLOW-OTHER-KEYS? BINDINGS . BODY) (defmacro let-keywords* (REST-ARG ALLOW-OTHER-KEYS? BINDINGS . BODY)
(let-keywords-template REST-ARG ALLOW-OTHER-KEYS? BINDINGS BODY 'let*)) (let-keywords-template REST-ARG ALLOW-OTHER-KEYS? BINDINGS BODY 'let*))
@ -231,7 +233,7 @@
;; Lisp dialects. ;; Lisp dialects.
(define-macro (lambda* ARGLIST . BODY) (defmacro lambda* (ARGLIST . BODY)
(parse-arglist (parse-arglist
ARGLIST ARGLIST
(lambda (non-optional-args optionals keys aok? rest-arg) (lambda (non-optional-args optionals keys aok? rest-arg)
@ -376,10 +378,10 @@
;; Of course, define*[-public] also supports #:rest and #:allow-other-keys ;; Of course, define*[-public] also supports #:rest and #:allow-other-keys
;; in the same way as lambda*. ;; in the same way as lambda*.
(define-macro (define* ARGLIST . BODY) (defmacro define* (ARGLIST . BODY)
(define*-guts 'define ARGLIST BODY)) (define*-guts 'define ARGLIST BODY))
(define-macro (define*-public ARGLIST . BODY) (defmacro define*-public (ARGLIST . BODY)
(define*-guts 'define-public ARGLIST BODY)) (define*-guts 'define-public ARGLIST BODY))
;; The guts of define* and define*-public. ;; The guts of define* and define*-public.
@ -410,13 +412,13 @@
;; semantics. Here is an example of a macro with an optional argument: ;; semantics. Here is an example of a macro with an optional argument:
;; (defmacro* transmorgify (a #:optional b) ;; (defmacro* transmorgify (a #:optional b)
(define-macro (define-macro* NAME+ARGLIST . BODY) (defmacro defmacro* (NAME ARGLIST . BODY)
`(define-macro ,(car NAME+ARGLIST) #f (lambda* ,(cdr NAME+ARGLIST) ,@BODY))) `(define-macro ,NAME #f (lambda* ,ARGLIST ,@BODY)))
(define-macro (define-macro*-public NAME+ARGLIST . BODY) (defmacro defmacro*-public (NAME ARGLIST . BODY)
`(begin `(begin
(define-macro* ,NAME+ARGLIST ,@BODY) (defmacro* ,NAME ,ARGLIST ,@BODY)
(export-syntax ,(car NAME+ARGLIST)))) (export-syntax ,NAME)))
;;; Support for optional & keyword args with the interpreter. ;;; Support for optional & keyword args with the interpreter.
(define *uninitialized* (list 'uninitialized)) (define *uninitialized* (list 'uninitialized))