@@ -51,6 +51,8 @@ | |||||
`((test . ,(lambda function-args | `((test . ,(lambda function-args | ||||
(display "test function called") | (display "test function called") | ||||
(newline))) | (newline))) | ||||
(begin . ,(lambda function-args | |||||
(mapn lisp-eval function-args))) | |||||
(if . ,(lambda function-args | (if . ,(lambda function-args | ||||
(match function-args | (match function-args | ||||
((e x y) (if (lisp-eval e) | ((e x y) (if (lisp-eval e) | ||||
@@ -105,7 +107,7 @@ | |||||
(lisp-exit "malformed lambda expression"))) | (lisp-exit "malformed lambda expression"))) | ||||
(_ (lisp-exit "malformed lambda expression"))))))) | (_ (lisp-exit "malformed lambda expression"))))))) | ||||
(lisp-eval body)) | |||||
(lisp-eval (cons 'begin body))) | |||||
(call/cc (lambda (lisp-exit) | (call/cc (lambda (lisp-exit) | ||||
(cons #t (lisp body (list (list)) (compose lisp-exit (curry cons #f)))))))) | (cons #t (lisp body (list (list)) (compose lisp-exit (curry cons #f)))))))) |
@@ -1,9 +1,10 @@ | |||||
;;; Module storing utility functions for common use. | ;;; Module storing utility functions for common use. | ||||
(module util (curry applied thunk just perhaps compose-symbols) | |||||
(module util (curry applied thunk just perhaps compose-symbols mapn) | |||||
(import scheme) | (import scheme) | ||||
(import chicken.base) | (import chicken.base) | ||||
(import srfi-13) | (import srfi-13) | ||||
(import matchable) | |||||
;; Partial application function for binary functions. | ;; Partial application function for binary functions. | ||||
(define (curry fn a) | (define (curry fn a) | ||||
@@ -33,6 +34,15 @@ | |||||
(fn arg) | (fn arg) | ||||
arg)) | arg)) | ||||
(define (mapn fn ln) | |||||
(match ln | |||||
(() '()) | |||||
((x) (fn x)) | |||||
(_ (begin | |||||
(fn (car ln)) | |||||
(mapn fn (cdr ln)))))) | |||||
;; Compose the argument symbols into a new symbol, joined by '-'. | ;; Compose the argument symbols into a new symbol, joined by '-'. | ||||
;; (compose-symbols 'apple 'pear 'orange) = 'apple-pear-orange | ;; (compose-symbols 'apple 'pear 'orange) = 'apple-pear-orange | ||||
(define (compose-symbols . ln) | (define (compose-symbols . ln) | ||||
@@ -142,7 +142,7 @@ | |||||
;; Match a tag against a list of objects, checking for its tag and its aliases. | ;; Match a tag against a list of objects, checking for its tag and its aliases. | ||||
(define (match-object tag objects) | |||||
(match-object tag objects) | |||||
(let loop ((objects objects)) | (let loop ((objects objects)) | ||||
(if (null? objects) | (if (null? objects) | ||||
#f | #f | ||||