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