From 541812a5b8a9977fab8a58e1e226b6b0e1347941 Mon Sep 17 00:00:00 2001 From: Victor Fors Date: Sun, 19 Sep 2021 23:46:14 +0200 Subject: [PATCH] nya --- kekkonen.scm | 64 +++++++++++++++++++++++++++++------------------------------- 1 file changed, 31 insertions(+), 33 deletions(-) diff --git a/kekkonen.scm b/kekkonen.scm index fa1f1a6..74e4016 100644 --- a/kekkonen.scm +++ b/kekkonen.scm @@ -327,6 +327,37 @@ result (loop (cdr ln))))))) +(define (lisp body environments exit) + (define (lisp-eval body) + (cond ((atom? body) body) + ((symbol? body) (reference body)) + ((list? body) (let ((ln (map lisp-eval body))) + (apply (car ln) (cdr ln)))) + (else (exit "Unknown value type in evaluation.")))) + + (define (reference symbol) + (cdr (any-or (curry assoc symbol) environments (exit (string-append "Undefined reference: " (symbol->string symbol)))))) + + (define (bind name value) + (set! environments (cons (let loop ((environment (car environments))) + (if (null? environment) + (list (cons name value)) + (if (eq? name (caar environment)) + (cons (cons name value) (cdr environment)) + (loop (cdr environment))))) + (cdr environments)))) + + (define (lisp-apply function args) + (cond ((function? function) + (apply function args)) + ((list? function) + (let ((function-arguments (car function)) + (function-body (cddr function))) + (lisp function-body (cons (if (= (length function-argumentsq) (length argument-values)) + (map cons function-arguments args) + (exit "Wrong number of arguments to function")) environments) exit))) + (_ (exit "attempt to call atom"))))) + (define lisp-builtins `((test . ,(lambda (function-args) (show "test function called"))) @@ -374,39 +405,6 @@ (exit "malformed lambda expression")) (_ (exit "malformed lambda expression"))))))) -(define (lisp body environments exit) - (define (lisp-eval body) - (cond ((atom? body) body) - ((symbol? body) (reference body)) - ((list? body) (let ((ln (map lisp-eval body))) - (apply (car ln) (cdr ln)))) - (else (exit "Unknown value type in evaluation.")))) - - (define (reference symbol) - (cdr (any-or (curry assoc symbol) environments (exit (string-append "Undefined reference: " (symbol->string symbol)))))) - - (define (bind name value) - (set! environments (cons (let loop ((environment (car environments))) - (if (null? environment) - (list (cons name value)) - (if (eq? name (caar environment)) - (cons (cons name value) (cdr environment)) - (loop (cdr environment))))) - (cdr environments)))) - - (define (lisp-apply function args) - (if (function? function) - (apply function args) - (case function-name - (else (let ((function (reference function-name environments))) - (let ((function-arguments (car function)) - (argument-values (cdr body)) - (function-body (cddr function))) - (lisp function-body (cons (if (= (length function-arguments) (length argument-values)) - (map cons function-arguments (map eval argument-values)) - (exit "Wrong number of arguments to function")) environments exit)))))) - (exit "attempt to call atom"))))) - (define (run-lisp body) (call/cc (lambda (exit) (cons #t (lisp body (list lisp-builtins) (compose exit (curry cons #f)))))))