sforman
/
Thun
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

joy-dup

This commit is contained in:
sforman 2023-10-21 12:40:30 -07:00
parent 35a122b2ba
commit 3c1d5ac361
1 changed files with 6 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
implementations/scheme-chicken/joy.scm
View File

@ -72,7 +72,7 @@
((bool) (joy-bool stack expression dict)) ((bool) (joy-bool stack expression dict))
((dup) (values (cons (car stack) stack) expression dict)) ((dup) (values (joy-dup stack) expression dict))
((pop) (values (cdr stack) expression dict)) ((pop) (values (cdr stack) expression dict))
((stack) (values (cons stack stack) expression dict)) ((stack) (values (cons stack stack) expression dict))
((swaack) (values (cons (cdr stack) (car stack)) expression dict)) ((swaack) (values (cons (cdr stack) (car stack)) expression dict))
@ -121,7 +121,7 @@
(if (predicate term) (values term rest) (abort message)))) (if (predicate term) (values term rest) (abort message))))
(define (pop-list stack) (pop-kind stack list? "Not a list.")) (define (pop-list stack) (pop-kind stack list? "Not a list."))
(define (pop-int stack) (pop-kind stack number? "Not an integer.")) (define (pop-int stack) (pop-kind stack number? "Not an integer."))
(define (pop-bool stack) (pop-kind stack boolean? "Not a Boolean value.")) (define (pop-bool stack) (pop-kind stack boolean? "Not a Boolean value."))
@ -142,6 +142,10 @@
((list? term) (not (null? term))) ((list? term) (not (null? term)))
(else #t))) (else #t)))
(define (joy-dup stack)
(receive (term _) (pop-any stack) (cons term stack)))
(define (joy-rest stack0) (define (joy-rest stack0)
(receive (el stack) (pop-list stack0) (receive (el stack) (pop-list stack0)
(if (null-list? el) (if (null-list? el)