fisl

commit e98c287ec33108ff0904f5391fc3de4ed9f1d948 (patch)
parent 3d533c5a47739af341647b03d0e3ac9b6513fa8e
Author: Alex Karle <alex@alexkarle.com>
Date:   Fri, 18 Nov 2022 11:33:37 -0500

ch9.3: Implement 'and' and 'or' operators

It feels a little weird that these return the _value_ and not #t or #f.

Let's see what scheme does :thinking:

> (and "hi" "hello")
"hello"
> (or "hi" "hello")
"hi"

Well, you learn something new every day.

Diffstat:
M
interpreter.scm
 | 
12
++++++++++++
M
parser.scm
 | 
24
+++++++++++++++++++++---

2 files changed, 33 insertions(+), 3 deletions(-)
diff --git a/interpreter.scm b/interpreter.scm
@@ -79,6 +79,18 @@
          (assert-num op right)
          (- right))
         (else (runtime-err! (format "Unknown unary op ~A" op))))))
+   ((logical? expr)
+    (let ((left (evaluate (logical-left expr) env))
+          (op (token-type (logical-operator expr))))
+      (case op
+	((OR)
+	 (if (truthy? left)
+	     left
+	     (evaluate (logical-right expr) env)))
+	((AND)
+	 (if (truthy? left)
+	     (evaluate (logical-right expr) env)
+	     left)))))
    ((binary? expr)
     (let ((left (evaluate (binary-left expr) env))
           (right (evaluate (binary-right expr) env))
diff --git a/parser.scm b/parser.scm
@@ -11,6 +11,7 @@
 (define-record unary operator right)
 (define-record variable name)
 (define-record assignment name value)
+(define-record logical left operator right)
 
 (set-record-printer! binary
   (lambda (x out) (fprintf out "(~A ~S ~S)"
@@ -35,6 +36,11 @@
 (set-record-printer! assignment
   (lambda (x out) (fprintf out "(set! ~A ~A)" (token-lexeme (assignment-name x)) (assignment-value x))))
 
+(set-record-printer! logical
+  (lambda (x out) (fprintf out "(~A ~A ~A)"
+		    (token-lexeme (logical-operator x))
+		    (logical-left x)
+		    (logical-right x))))
 
 
 ;; STATEMENTS
@@ -141,7 +147,7 @@
 		  (values (make-if-stmt cond-expr then-stmt '()) toks2)))))))
 
 (define (parse-assignment expr toks)
-  (let-values (((e2 t2) (parse-equality expr toks)))
+  (let-values (((e2 t2) (parse-or expr toks)))
     (if (top-type? t2 '(EQUAL))
       (let-values (((e3 t3) (parse-assignment e2 (cdr t2))))
         (if (variable? e2)
@@ -157,15 +163,18 @@
 ;;   2. While the top is the operator, keep evaluating / building up the expression
 ;;   3. Return once the operator isn't matched
 ;; This function does it all, with a generic 'lower' to evaluate if 'types' matched
-(define (parse-generic-binary expr tokens lower types)
+(define (parse-generic maker expr tokens lower types)
   (let-values (((e2 t2) (lower expr tokens)))
     (let loop ((e e2) (ts t2))
       (if (top-type? ts types)
         ;; top of ts is an operator, eval right side on rest
         (let-values (((e3 t3) (lower e (cdr ts))))
-          (loop (make-binary e (car ts) e3) t3))
+          (loop (maker e (car ts) e3) t3))
         (values e ts)))))
 
+(define (parse-generic-binary expr tokens lower types)
+  (parse-generic make-binary expr tokens lower types))
+
 (define (parse-equality expr toks)
   (parse-generic-binary expr toks parse-comparison '(BANG_EQUAL EQUAL_EQUAL)))
 
@@ -178,6 +187,15 @@
 (define (parse-factor expr toks)
   (parse-generic-binary expr toks parse-unary '(SLASH STAR)))
 
+(define (parse-generic-logical expr tokens lower types)
+  (parse-generic make-logical expr tokens lower types))
+
+(define (parse-or expr toks)
+  (parse-generic-logical expr toks parse-and '(OR)))
+
+(define (parse-and expr toks)
+  (parse-generic-logical expr toks parse-equality '(AND)))
+
 (define (parse-unary expr toks)
   (if (top-type? toks '(BANG MINUS))
       (let-values (((e2 t2) (parse-unary expr (cdr toks))))