joy-first

diff --git a/implementations/scheme-chicken/joy.scm b/implementations/scheme-chicken/joy.scm
index 919257f..0008d2b 100644 (file)
--- 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)