mes: optargs: Adjust for new module system.
* module/mes/optargs.scm: Move this... * mes/module/ice-9/optargs.scm: ...here with minor adjustments. * mes/module/mes/optargs.mes: Adjust accordingly. * tests/optargs.test: Adjust accordingly. * mes/module/mes/boot-5.scm: Add '(mes syntax)' to the root module. * mes/modules/system/base/pmatch.scm: Export 'pmatch' using '#:replace'.
This commit is contained in:
parent
86432b8005
commit
953197594a
|
@ -57,17 +57,26 @@
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(define-module (mes optargs)
|
(define-module (ice-9 optargs)
|
||||||
#:use-module (system base pmatch)
|
#:use-module (system base pmatch)
|
||||||
#:replace (lambda*)
|
#:replace (lambda*)
|
||||||
#:export-syntax (let-optional
|
#:export-syntax (let-optional
|
||||||
let-optional*
|
let-optional*
|
||||||
let-keywords
|
let-keywords
|
||||||
let-keywords*
|
let-keywords*
|
||||||
define*
|
define*
|
||||||
define*-public
|
define*-public
|
||||||
defmacro*
|
defmacro*
|
||||||
defmacro*-public))
|
defmacro*-public
|
||||||
|
|
||||||
|
;; define*-guts
|
||||||
|
;; parse-arglist
|
||||||
|
;; every?
|
||||||
|
;; ext-decl?
|
||||||
|
;; let-optional-template
|
||||||
|
;; let-keywords-template
|
||||||
|
;; rest-arg->keyword-binding-list
|
||||||
|
))
|
||||||
|
|
||||||
;; let-optional rest-arg (binding ...) . body
|
;; let-optional rest-arg (binding ...) . body
|
||||||
;; let-optional* rest-arg (binding ...) . body
|
;; let-optional* rest-arg (binding ...) . body
|
||||||
|
@ -151,11 +160,11 @@
|
||||||
=> cdr)
|
=> cdr)
|
||||||
(else
|
(else
|
||||||
,(cadr key)))))))
|
,(cadr key)))))))
|
||||||
`(let ((,kb-list-gensym ((if (not mes?) (@@ (mes optargs) rest-arg->keyword-binding-list)
|
`(let* ((ra->kbl ,rest-arg->keyword-binding-list)
|
||||||
rest-arg->keyword-binding-list)
|
(,kb-list-gensym (ra->kbl ,REST-ARG ',(map
|
||||||
,REST-ARG ',(map (lambda (x) (symbol->keyword (if (pair? x) (car x) x)))
|
(lambda (x) (symbol->keyword (if (pair? x) (car x) x)))
|
||||||
BINDINGS)
|
BINDINGS)
|
||||||
,ALLOW-OTHER-KEYS?)))
|
,ALLOW-OTHER-KEYS?)))
|
||||||
,(let-o-k-template REST-ARG BINDINGS BODY let-type bindfilter)))))
|
,(let-o-k-template REST-ARG BINDINGS BODY let-type bindfilter)))))
|
||||||
|
|
||||||
(define (rest-arg->keyword-binding-list rest-arg keywords allow-other-keys?)
|
(define (rest-arg->keyword-binding-list rest-arg keywords allow-other-keys?)
|
|
@ -194,6 +194,7 @@
|
||||||
(define (defined? x)
|
(define (defined? x)
|
||||||
(module-defined? (current-module) x))
|
(module-defined? (current-module) x))
|
||||||
|
|
||||||
|
(mes-use-module (mes syntax))
|
||||||
(mes-use-module (mes guile-module))
|
(mes-use-module (mes guile-module))
|
||||||
|
|
||||||
;; Until more of Mes is modularized, the REPL can only work from the
|
;; Until more of Mes is modularized, the REPL can only work from the
|
||||||
|
|
|
@ -32,7 +32,7 @@
|
||||||
(define-macro (set-procedure-property! proc key value)
|
(define-macro (set-procedure-property! proc key value)
|
||||||
proc)
|
proc)
|
||||||
|
|
||||||
(include-from-path "mes/optargs.scm")
|
(include-from-path "ice-9/optargs.scm")
|
||||||
|
|
||||||
(define-macro (define-macro* NAME+ARGLIST . BODY)
|
(define-macro (define-macro* NAME+ARGLIST . BODY)
|
||||||
`(define-macro ,(car NAME+ARGLIST) #f (lambda* ,(cdr NAME+ARGLIST) ,@BODY)))
|
`(define-macro ,(car NAME+ARGLIST) #f (lambda* ,(cdr NAME+ARGLIST) ,@BODY)))
|
||||||
|
|
|
@ -55,7 +55,8 @@
|
||||||
;; () -- matches the empty list
|
;; () -- matches the empty list
|
||||||
|
|
||||||
(define-module (system base pmatch)
|
(define-module (system base pmatch)
|
||||||
#:export-syntax (pmatch))
|
;; XXX: Somehow this symbol gets bound in the root module.
|
||||||
|
#:replace (pmatch))
|
||||||
|
|
||||||
(define-syntax pmatch
|
(define-syntax pmatch
|
||||||
(syntax-rules (else guard)
|
(syntax-rules (else guard)
|
||||||
|
|
|
@ -24,7 +24,7 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
|
||||||
;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (tests optargs)
|
(define-module (tests optargs)
|
||||||
#:use-module (mes optargs)
|
#:use-module (ice-9 optargs)
|
||||||
#:use-module (mes mes-0)
|
#:use-module (mes mes-0)
|
||||||
#:use-module (mes test))
|
#:use-module (mes test))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue