finally conceptually got it right
This commit is contained in:
parent
903b198f71
commit
6d0c8c2b6a
4
lisp.scm
4
lisp.scm
@ -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))))))))
|
||||||
|
12
util.scm
12
util.scm
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user