From be7e5da6c3839002ac5355a86f5164c3f60c86cc Mon Sep 17 00:00:00 2001 From: Akshay Date: Thu, 5 Nov 2020 21:51:30 +0530 Subject: let there be lambda! * begin form * define form * let derived form * function application and stuff --- environment.scm | 5 ++- main.scm | 92 +++++++++++++++++++++++++++++++++++++++++++++++--- prelude/primitives.scm | 15 ++++---- 3 files changed, 99 insertions(+), 13 deletions(-) diff --git a/environment.scm b/environment.scm index 5906a1d..4917a40 100644 --- a/environment.scm +++ b/environment.scm @@ -1,6 +1,9 @@ (define-module (environment) #: export (lookup-variable-value - setup-environment)) + setup-environment + set-variable-value! + define-variable! + extend-env)) (add-to-load-path ".") (use-modules (prelude/primitives)) diff --git a/main.scm b/main.scm index 8db3289..7476efb 100644 --- a/main.scm +++ b/main.scm @@ -44,7 +44,7 @@ [(cond-else? (car clauses)) (cond-consequent (car clauses))] [(last-clause? clauses) (make-if (cond-predicate (car clauses)) (cond-consequent (car clauses)) - '())] + 'false)] [else (make-if (cond-predicate (car clauses)) (cond-consequent (car clauses)) (cond->if (make-cond (cdr clauses))))]))) @@ -64,16 +64,56 @@ ;;; assignment (define (assignment? expr) (tagged? expr 'set!)) +(define (assignment-name expr) (cadr expr)) +(define (assignment-value expr) (caddr expr)) + +;;; definition +(define (definition? expr) (tagged? expr 'define)) +(define (definition-name expr) (cadr expr)) +(define (definition-value expr) (caddr expr)) + +;;; lambda +(define (lambda-form? expr) (tagged? expr 'lambda)) +(define (lambda-params expr) (cadr expr)) +(define (lambda-body expr) (cddr expr)) +(define (make-lambda params body) (cons 'lambda (cons params body))) + +;;; begin +(define (begin-form? expr) (tagged? expr 'begin)) +(define (begin-actions begin-form) (cdr begin-form)) +(define (last-action? actions) (null? (cdr actions))) +(define (make-begin actions) (cons 'begin actions)) +(define (sequence->expr actions) + (cond + [(null? actions) '()] + [(last-action? actions) (car actions)] + [else (make-begin actions)])) + +;;; let +(define (let-form? expr) (tagged? expr 'let)) +(define (let-bindings expr) (cadr expr)) +(define (let-body expr) (cddr expr)) +(define (let-binding-variables bindings) (map car bindings)) +(define (let-binding-values bindings) (map cadr bindings)) +(define (let->lambda expr) + (let ([bindings (let-bindings expr)]) + (make-lambda (let-binding-variables bindings) + (let-body expr)))) (define (eval-expr expr env) (cond [(self-evaluating? expr) expr] + [(variable? expr) (lookup-variable-value expr env)] [(if-else? expr) (eval-if expr env)] + [(begin-form? expr) (eval-sequence (begin-actions expr) env)] + [(lambda-form? expr) (make-lambda (lambda-params expr) + (lambda-body expr))] + [(let-form? expr) (eval-let expr env)] + [(assignment? expr) (eval-assignment expr env)] + [(definition? expr) (eval-definition expr env)] [(cond-form? expr) (eval-cond expr env)] [(quote-form? expr) (quotation-text expr)] - [(function-application? expr) - (apply-expr (operator expr) - (list-of-values (operands expr) env))])) + [(function-application? expr) (eval-function-application expr env)])) (define (eval-if expr env) (if (true? (eval-expr (if-predicate expr) env)) @@ -83,6 +123,43 @@ (define (eval-cond expr env) (eval-expr (cond->if expr) env)) +(define (eval-sequence exprs env) + (cond + [(last-action? exprs) (eval-expr (car exprs) env)] + [else (begin + (eval-expr (car exprs) env) + (eval-sequence (cdr exprs) env))])) + +(define (eval-let expr env) + (eval-function-application (cons (let->lambda expr) + (let-binding-values (let-bindings expr))) + env)) + +(define (eval-assignment expr env) + (set-variable-value! + (assignment-name expr) + (eval-expr (assignment-value expr) env) + env)) + +(define (eval-definition expr env) + (define-variable! + (definition-name expr) + (eval-expr (definition-value expr) env) + env)) + +(define (eval-function-application expr env) + (let ([proc (operator expr)] + [args (list-of-values (operands expr) env)]) + (cond + [(primitive? proc) (apply-primitive-proc proc args)] + [else + (let ([compound-proc (eval-expr proc env)]) + (eval-sequence + (lambda-body compound-proc) + (extend-env (lambda-params compound-proc) + args + env)))]))) + (define (primitive? proc) (is-elem-assoc-list proc primitives)) @@ -113,4 +190,9 @@ (driver-loop)))))) (define (show-lisp-expr object) - (display object)) + (cond + [(tagged? object 'lambda) + (display "#")] + [else (display object)])) diff --git a/prelude/primitives.scm b/prelude/primitives.scm index 2e5f5d9..cd7f1bf 100644 --- a/prelude/primitives.scm +++ b/prelude/primitives.scm @@ -7,7 +7,7 @@ bool? true?)) -(define (lift-bool expr) (if expr 'true 'false)) +(define (convert-bool expr) (if expr 'true 'false)) (define (true? expr) (eq? expr 'true)) (define (false? expr) (eq? expr 'false)) (define (bool? expr) @@ -34,17 +34,18 @@ (define (not-fn x) (not (true? x))) -(define (lift-arithmetic op) - (lambda vals (lift-bool (apply op vals)))) +(define (lift-bool op) + (lambda vals (convert-bool (apply op vals)))) (define primitives `((+ . ,+) (- . ,-) (* . ,*) - (< . ,(lift-arithmetic <)) - (> . ,(lift-arithmetic >)) - (<= . ,(lift-arithmetic <=)) - (>= . ,(lift-arithmetic >=)) + (< . ,(lift-bool <)) + (> . ,(lift-bool >)) + (<= . ,(lift-bool <=)) + (>= . ,(lift-bool >=)) + (eq? . ,(lift-bool eq?)) (&& . ,and-special) (|| . ,or-special) (/= . ,not-fn) -- cgit v1.2.3