From 5e79d95159a6cd680d045314fe427b263e7ab344 Mon Sep 17 00:00:00 2001 From: Leah Neukirchen Date: Mon, 2 Jan 2023 19:10:02 +0100 Subject: add push!, pop! --- mew.scm | 22 +++++++++++++++++++++- mew.svnwiki | 13 +++++++++++-- tests/test.mew | 8 ++++++++ 3 files changed, 40 insertions(+), 3 deletions(-) diff --git a/mew.scm b/mew.scm index 845a16e..f170273 100644 --- a/mew.scm +++ b/mew.scm @@ -16,7 +16,7 @@ mod negate nth-accumulator odometer one-of op op* - per prn proj puts + per pop! prn proj push! puts rand range rep sample scan scan-right sing? search seq set set-at sgn shuffle shuffle! str slurp @@ -1077,6 +1077,26 @@ ((_ location n) (set location (- location n))))) + (define-syntax push! + (syntax-rules () + ((_ location x) + (set location (cons x location))))) + + (define-syntax pop! + (syntax-rules () + ((_ location) + (if (null? location) + (error "pop from empty list") + (let ((r (car location))) + (set! location (cdr location)) + r))) + ((_ location default) + (if (null? location) + default + (let ((r (car location))) + (set! location (cdr location)) + r))))) + (define (and=> x . fs) (and x (if (null? fs) diff --git a/mew.svnwiki b/mew.svnwiki index 16dd90d..92ed78d 100644 --- a/mew.svnwiki +++ b/mew.svnwiki @@ -144,8 +144,8 @@ with a {{'message}} of {{}} passed through {{format}} with Increment or decrement the argument by 1. -(inc! []) -(dec! []) +(inc! []) +(dec! []) Increment or decrement the location {{}} by {{}} (default: 1). @@ -302,6 +302,15 @@ Material implication: evaluate {{...}} until one is false, then shortcut and return true. If all {{...}} are true, evaluate {{}}. +(push! ) + +Prepend {{}} to the list stored at {{}}. + +(pop! []) + +Return the head of {{}} and replace {{}} with its tail. +If {{}} is empty, return {{}} if given; else throw an exception. + == I/O helpers diff --git a/tests/test.mew b/tests/test.mew index 44fdb95..d2eacbd 100644 --- a/tests/test.mew +++ b/tests/test.mew @@ -114,6 +114,14 @@ (test 5 (loc (x 6) (dec! x))) (test 5 (loc (x 7) (dec! x 2)))) +(test-group "push!" + (test '(3 2 1) (loc (l '()) (push! l 1) (push! l 2) (push! l 3) l))) + +(test-group "pop!" + (test 1 (loc (l '(3 2 1)) (pop! l) (pop! l) (pop! l))) + (test-error (loc (l '(2 1)) (pop! l) (pop! l) (pop! l))) + (test 'foo (loc (l '(2 1)) (pop! l) (pop! l) (pop! l 'foo)))) + (test-group "boolean" (test #f (boolean #f)) (test #t (boolean #t)) -- cgit 1.4.1