whiteline/kekkonen
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

lambda

Browse Source
This commit is contained in:
Victor Fors 2021-11-13 12:45:02 +01:00
parent 767542e4b1
commit b6a3daaa13
1 changed files with 25 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
kekkonen.scm
View File

@ -339,9 +339,9 @@
(cond ((procedure? function)
(apply function args))
((list? function)
(let ((function-arguments (cadr function))
(function-body (cddr function)))
(lisp function-body (cons (if (= (length function-arguments) (length argument-values))
(let ((function-arguments (car function))
(function-body (cdr function)))
(lisp function-body (cons (if (= (length function-arguments) (length args))
(map cons function-arguments args)
(lisp-exit "Wrong number of arguments to function")) environments) lisp-exit)))
(else (lisp-exit "attempt to call atom"))))
@ -349,8 +349,7 @@
(define (lisp-eval body)
(cond ((symbol? body) (reference body))
((atom? body) body)
((list? body) (let ((ln (map lisp-eval body)))
(lisp-apply (car ln) (cdr ln))))
((list? body) (lisp-apply (lisp-eval (car body)) (cdr body)))
(else (lisp-exit "Unknown value type in evaluation."))))
(define (bind name value)
@ -377,41 +376,48 @@
(_ (lisp-exit "malformed quote expression")))))
(cons . ,(lambda function-args
(match function-args
((a b) (cons a b))
((a b) (cons (lisp-eval a) (lisp-eval b)))
(_ (lisp-exit "malformed cons expression")))))
(car . ,(lambda function-args
(match function-args
((a) (if (atom? a)
(lisp-exit "tried to take car of atom")
(car a)))
((a) (let ((e (lisp-eval a)))
(if (atom? e)
(lisp-exit "tried to take car of atom")
(car e))))
(_ (lisp-exit "malformed car expression")))))
(cdr . ,(lambda function-args
(match function-args
((a) (if (atom? a)
(lisp-exit "tried to take cdr of atom")
(cdr a)))
((a) (let ((e (lisp-eval a)))
(if (atom? e)
(lisp-exit "tried to take cdr of atom")
(cdr e))))
(_ (lisp-exit "malformed cdr expression")))))
(atom . ,(lambda function-args
(match function-args
((a) (atom? a))
((a) (let ((e (lisp-eval a)))
(atom? e)))
(_ (lisp-exit "malformed atom expression")))))
(eq . ,(lambda function-args
(match function-args
((a b) (equal? a b))
((a b) (let ((ea (eval a))
(eb (eval b)))
(equal? ea eb)))
(_ (lisp-exit "malformed eq expression")))))
(set . ,(lambda function-args
(match function-args
((a b) (if (symbol? a)
(bind a b)
(lisp-exit "tried to bind to non-symbol")))
((a b) (let ((ea (eval a))
(eb (eval b)))
(if (symbol? a)
(bind a b)
(lisp-exit "tried to bind to non-symbol"))))
(_ (lisp-exit "malformed set expression")))))
(lambda . ,(lambda function-args
(match function-args
((args exp . exps)
(if (and (list? args) (every symbol? args))
(cons args (cons exp exps))
(lisp-exit "malformed lambda expression"))
(_ (lisp-exit "malformed lambda expression"))))))))
(lisp-exit "malformed lambda expression")))
(_ (lisp-exit "malformed lambda expression")))))))
(lisp-eval body))