From 781957cbe99cc46f694abc01e9a3af23ca1aa0c4 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sat, 29 Oct 2016 16:35:44 +0200 Subject: [PATCH] Implement apply with multiple arguments. * module/mes/base-0.mes (apply): Handle multiple arguments. * tests/base.test: (apply, apply 1, apply 2): New test. --- module/mes/base-0.mes | 7 ++++++- tests/base.test | 4 ++++ 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/module/mes/base-0.mes b/module/mes/base-0.mes index 45485100..6eac6843 100644 --- a/module/mes/base-0.mes +++ b/module/mes/base-0.mes @@ -26,7 +26,7 @@ ;;; Code: -(define (apply f x) (apply-env f x (current-module))) +;;(define (apply f x) (apply-env f x (current-module))) (define (primitive-eval e) (eval e (current-module))) (define (expand-macro e) (expand-macro-env e (current-module))) @@ -50,6 +50,11 @@ (cons (car rest) (loop (cdr rest))))) (loop (cons x rest))) +(define (apply f h . t) (apply-env f (cons h t) (current-module))) +(define (apply f h . t) + (if (null? t) (apply-env f h (current-module)) + (apply f (apply cons* (cons h t))))) + (define-macro (cond . clauses) (list 'if (null? clauses) *unspecified* (if (null? (cdr clauses)) diff --git a/tests/base.test b/tests/base.test index b6abe22c..6c32f211 100755 --- a/tests/base.test +++ b/tests/base.test @@ -65,4 +65,8 @@ exit $? (pass-if "let 2" (seq? (let ((x 0)) x) 0)) (pass-if "let 3" (seq? (let ((p 5) (q 6)) (+ p q)) 11)) +(pass-if "apply" (sequal? (apply list '(1)) '(1))) +(pass-if "apply 2" (sequal? (apply list 1 '(2)) '(1 2))) +(pass-if "apply 3" (sequal? (apply list 1 2 '(3)) '(1 2 3))) + (result 'report)