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

pop-any and pop-list. 

Runtime type-checking.
This commit is contained in:
sforman 2023-10-21 11:08:01 -07:00
parent 3e72ce494a
commit 8bb8953816
1 changed files with 23 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -108,14 +108,26 @@
(else #t))) (else #t)))
(define (joy-rest stack) (define (joy-rest stack0)
(match stack (receive (el stack) (pop-list stack0)
(() (abort "Not enough values on Stack")) (if (null-list? el)
((head . tail) (abort "Cannot take rest of empty list.")
(match head (cons (cdr el) stack))))
(() (abort "Cannot take rest of empty list."))
((_ . the_rest) (cons the_rest tail))
(_ (abort "Not a list.")))))) (define (pop-any stack)
(if (null-list? stack)
(abort "Not enough values on Stack")
(car+cdr stack)))
(define (pop-list stack)
(receive (term rest) (pop-any stack)
(if (list? term)
(values term rest)
(abort "Not a list."))))
; ██████╗ ██████╗ ███╗ ███╗██████╗ ██╗███╗ ██╗ █████╗ ████████╗ ██████╗ ██████╗ ███████╗ ; ██████╗ ██████╗ ███╗ ███╗██████╗ ██╗███╗ ██╗ █████╗ ████████╗ ██████╗ ██████╗ ███████╗
@ -254,14 +266,14 @@
(define (main-loop stack0 dict0) (define (main-loop stack0 dict0)
(let ((text (prompt))) (let ((text (prompt)))
(if (not (eof-object? text)) (if (eof-object? text)
(print)
(receive (stack dict) (receive (stack dict)
(handle-exceptions exn (handle-exceptions exn
(begin (display exn) (newline) (values stack0 dict0)) (begin (display exn) (newline) (values stack0 dict0))
(joy stack0 (text->expression text) dict0)) (joy stack0 (text->expression text) dict0))
(print (joy-expression->string (reverse stack))) (print (joy-expression->string (reverse stack)))
(main-loop stack dict)) (main-loop stack dict)))))
(print))))
(define (joy-trace stack expression) (define (joy-trace stack expression)
(print (conc (joy-expression->string (reverse stack)) " . " (joy-expression->string expression)))) (print (conc (joy-expression->string (reverse stack)) " . " (joy-expression->string expression))))