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

joy-first

This commit is contained in:
sforman 2023-10-21 11:10:36 -07:00
parent 8bb8953816
commit d76c23dce2
1 changed files with 8 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -80,8 +80,8 @@
((concat) (joy-func append stack expression dict)) ((concat) (joy-func append stack expression dict))
((cons) (joy-func cons stack expression dict)) ((cons) (joy-func cons stack expression dict))
((first) (values (cons (caar stack) (cdr stack)) expression dict)) ((first) (values (joy-first stack) expression dict))
((rest) (values (joy-rest stack) expression dict)) ((rest) (values (joy-rest stack) expression dict))
((i) (joy-i stack expression dict)) ((i) (joy-i stack expression dict))
((dip) (joy-dip stack expression dict)) ((dip) (joy-dip stack expression dict))
@ -114,6 +114,12 @@
(abort "Cannot take rest of empty list.") (abort "Cannot take rest of empty list.")
(cons (cdr el) stack)))) (cons (cdr el) stack))))
(define (joy-first stack0)
(receive (el stack) (pop-list stack0)
(if (null-list? el)
(abort "Cannot take first of empty list.")
(cons (car el) stack))))
(define (pop-any stack) (define (pop-any stack)
(if (null-list? stack) (if (null-list? stack)