Browse Source

finally conceptually got it right

master
whiteline 10 months ago
parent
commit
6d0c8c2b6a
3 changed files with 15 additions and 3 deletions
  1. +3
    -1
      lisp.scm
  2. +11
    -1
      util.scm
  3. +1
    -1
      world.scm

+ 3
- 1
lisp.scm 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))))))))

+ 11
- 1
util.scm 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)


+ 1
- 1
world.scm 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


Loading…
Cancel
Save