finally conceptually got it right

This commit is contained in:
whiteline 2023-06-26 16:19:12 +02:00
parent 903b198f71
commit 6d0c8c2b6a
3 changed files with 15 additions and 3 deletions

View File

@ -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))))))))

View File

@ -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)

View File

@ -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