From d76c23dce220cdb2756d35bf02a062d60ec78ad1 Mon Sep 17 00:00:00 2001 From: sforman Date: Sat, 21 Oct 2023 11:10:36 -0700 Subject: [PATCH] joy-first --- implementations/scheme-chicken/joy.scm | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/implementations/scheme-chicken/joy.scm b/implementations/scheme-chicken/joy.scm index 919257f..0008d2b 100644 --- a/implementations/scheme-chicken/joy.scm +++ b/implementations/scheme-chicken/joy.scm @@ -80,8 +80,8 @@ ((concat) (joy-func append stack expression dict)) ((cons) (joy-func cons stack expression dict)) - ((first) (values (cons (caar stack) (cdr stack)) expression dict)) - ((rest) (values (joy-rest stack) expression dict)) + ((first) (values (joy-first stack) expression dict)) + ((rest) (values (joy-rest stack) expression dict)) ((i) (joy-i stack expression dict)) ((dip) (joy-dip stack expression dict)) @@ -114,6 +114,12 @@ (abort "Cannot take rest of empty list.") (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) (if (null-list? stack)