diff --git a/module/mes/optargs.scm b/module/mes/optargs.scm index 8f495cd2..3e3396ce 100644 --- a/module/mes/optargs.scm +++ b/module/mes/optargs.scm @@ -173,11 +173,11 @@ (cond ((memq first keywords) (if (null? rest) - (error "Keyword argument has no value.") + (error "Keyword argument has no value:" first) (next (cons (cons (keyword->symbol first) (car rest)) accum)))) ((not allow-other-keys?) - (error "Unknown keyword in arguments.")) + (error "Unknown keyword in arguments:" first)) (else (if (null? rest) accum (next accum)))) diff --git a/module/mes/pmatch.mes b/module/mes/pmatch.mes index 18bd5beb..aefff447 100644 --- a/module/mes/pmatch.mes +++ b/module/mes/pmatch.mes @@ -1,7 +1,7 @@ ;;; -*-scheme-*- ;;; Mes --- Maxwell Equations of Software -;;; Copyright © 2016 Jan Nieuwenhuizen +;;; Copyright © 2016,2017 Jan Nieuwenhuizen ;;; ;;; This file is part of Mes. ;;; @@ -24,4 +24,5 @@ (mes-use-module (mes guile)) (mes-use-module (mes quasiquote)) +(mes-use-module (mes psyntax)) (include-from-path "mes/pmatch.scm") diff --git a/module/mes/psyntax-0.mes b/module/mes/psyntax-0.mes index 0d958a53..54d83162 100644 --- a/module/mes/psyntax-0.mes +++ b/module/mes/psyntax-0.mes @@ -26,7 +26,7 @@ (define annotation? (lambda (x) #f)) (define (self-evaluating? x) - (or (boolean? x) (number? x) (string? x) (char? x) (null? x) (closure? x))) + (or (null? x) (boolean? x) (char? x) (closure? x) (keyword? x) (number? x) (string? x))) (define (void) (if #f #f)) diff --git a/tests/optargs.test b/tests/optargs.test index 15c680c9..cffed763 100755 --- a/tests/optargs.test +++ b/tests/optargs.test @@ -56,4 +56,84 @@ exit $? (pass-if "optargs key" ((lambda* (#:key (foo #f)) foo) #:foo #t)) (pass-if-equal "optargs key default" #f ((lambda* (#:key (foo #f)) foo))) +(mes-use-module (mes pmatch)) + +(define ') +(define ') +(define ') +(define ') +(define ') + +(define* (make o #:key (functions '()) (globals '()) (locals '()) (text '())) + (pmatch o + ( (list + (cons functions) + (cons globals) + (cons locals) + (cons text))))) + +;; (define* (make o #:key (functions '()) (globals '()) (locals '()) (text '())) +;; (format (current-error-port) "make\n") +;; ((cond ((info? o) +;; (list +;; (cons functions) +;; (cons globals) +;; (cons locals) +;; (cons text)))))) + +(define (.functions o) + (pmatch o + (( . ,alist) (assq-ref alist )))) + +(define (.globals o) + (pmatch o + (( . ,alist) (assq-ref alist )))) + +(define (.locals o) + (pmatch o + (( . ,alist) (assq-ref alist )))) + +(define (.text o) + (pmatch o + (( . ,alist) (assq-ref alist )))) + +(define (info? o) + (and (pair? o) (eq? (car o) ))) + +;; FIXME: psyntax+pmatch+optarg is broken; BINDINGS-> (g1234 g1234) +;; iso (function function) +;; (define (clone o . rest) +;; (pmatch o +;; (( +;; ( . ,functions) +;; ( . ,globals) +;; ( . ,locals) +;; ( . ,text)) +;; (let-keywords rest +;; #f +;; ((functions functions) +;; (globals globals) +;; (locals locals) +;; (text text)) +;; (make #:functions functions #:globals globals #:locals locals #:text text))))) + +(define (clone o . rest) + (format (current-error-port) "clone rest=~a\n" rest) + (cond ((info? o) + (let ((functions (.functions o)) + (globals (.globals o)) + (locals (.locals o)) + (text (.text o))) + (let-keywords rest + #f + ((functions functions) + (globals globals) + (locals locals) + (text text)) + (make #:functions functions #:globals globals #:locals locals #:text text)))))) + +(pass-if-equal "clone " + (make #:functions '(0)) + (clone (make ) #:functions '(0))) + (result 'report)