mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-02 15:40:38 +02:00
Code Activity

Better errors for odd-length keyword args

Browse source 
* libguile/vm-i-system.c (bind-kwargs):
* libguile/vm.c (vm_error_kwargs_missing_value):
* libguile/eval.c (error_missing_value)
  (prepare_boot_closure_env_for_apply): Adapt to mirror VM behavior.
* libguile/keywords.c (scm_c_bind_keyword_arguments): Likewise.
* module/ice-9/eval.scm (primitive-eval): Update to error on (foo #:kw)
  with a "Keyword argument has no value" instead of the horrible "odd
  argument list length".  Also adapts to the expected args format for
  the keyword-argument-error exception printer in all cases.  Matches
  1.8 optargs behavior also.
* test-suite/standalone/test-scm-c-bind-keyword-arguments.c (test_missing_value):
  (missing_value_error_handler): Update test.
* test-suite/tests/optargs.test: Add tests.
This commit is contained in:
Andy Wingo 2017-02-28 20:42:45 +01:00
parent f428e93ee7
commit 89ececea95
8 changed files with 142 additions and 91 deletions
Download patch file Download diff file Expand all files Collapse all files

89
module/ice-9/eval.scm
View file

@ -338,43 +338,58 @@
env))))
;; Now scan args for keywords.
(let lp ((args args))
(if (and (pair? args) (pair? (cdr args))
(keyword? (car args)))
(let ((kw-pair (assq (car args) kw))
(v (cadr args)))
(if kw-pair
;; Found a known keyword; set its value.
(list-set! env
(- imax (cdr kw-pair)) v)
;; Unknown keyword.
(if (not aok)
(scm-error
'keyword-argument-error
"eval" "Unrecognized keyword"
'() (list (car args)))))
(lp (cddr args)))
(if (pair? args)
(if rest?
;; Be lenient parsing rest args.
(lp (cdr args))
(scm-error 'keyword-argument-error
"eval" "Invalid keyword"
'() (list (car args))))
;; Finished parsing keywords. Fill in
;; uninitialized kwargs by evalling init
;; expressions in their appropriate
;; environment.
(let lp ((i (- imax kw-base))
(inits inits))
(if (pair? inits)
(let ((tail (list-tail env i)))
(if (eq? (car tail) unbound-arg)
(set-car! tail
(eval (car inits)
(cdr tail))))
(lp (1- i) (cdr inits)))
;; Finally, eval the body.
(eval body env))))))))))))))))
(cond
((pair? args)
(cond
((keyword? (car args))
(let ((k (car args))
(args (cdr args)))
(cond
((assq k kw)
=> (lambda (kw-pair)
;; Found a known keyword; set its value.
(if (pair? args)
(let ((v (car args))
(args (cdr args)))
(list-set! env
(- imax (cdr kw-pair))
v)
(lp args))
(scm-error 'keyword-argument-error
"eval"
"Keyword argument has no value"
'() (list k)))))
;; Otherwise unknown keyword.
(aok
(lp (if (pair? args) (cdr args) args)))
(else
(scm-error 'keyword-argument-error
"eval" "Unrecognized keyword"
'() (list k))))))
(rest?
;; Be lenient parsing rest args.
(lp (cdr args)))
(else
(scm-error 'keyword-argument-error
"eval" "Invalid keyword"
'() (list (car args))))))
(else
;; Finished parsing keywords. Fill in
;; uninitialized kwargs by evalling init
;; expressions in their appropriate
;; environment.
(let lp ((i (- imax kw-base))
(inits inits))
(if (pair? inits)
(let ((tail (list-tail env i)))
(if (eq? (car tail) unbound-arg)
(set-car! tail
(eval (car inits)
(cdr tail))))
(lp (1- i) (cdr inits)))
;; Finally, eval the body.
(eval body env)))))
)))))))))))
;; The "engine". EXP is a memoized expression.
(define (eval exp env)