├── .gitignore ├── LICENSE ├── README.md ├── data ├── and.lox ├── block.lox ├── class.lox ├── closure.lox ├── collide_with_parameter.lox ├── constuctor_missing_arguments.lox ├── fib.lox ├── for-loop.lox ├── if.lox ├── inheritance.lox ├── lang-lox │ ├── fib.rkt │ └── hello_world.rkt ├── missing_comma_in_parameters.lox ├── number_literals.lox ├── resolving.lox ├── return_value.lox ├── super_parenthesized.lox ├── this.lox ├── too_many_arguments.lox ├── unterminated_string.lox └── while-loop.lox └── src ├── lox ├── expander.rkt ├── lib │ ├── class.rkt │ ├── env.rkt │ ├── error.rkt │ ├── expr.rkt │ ├── function.rkt │ ├── instance.rkt │ ├── interpreter.rkt │ ├── parser.rkt │ ├── pretty-print.rkt │ ├── resolver.rkt │ ├── scanner.rkt │ ├── stmt.rkt │ └── token.rkt ├── main.rkt ├── reader.rkt └── utils │ ├── stack.rkt │ └── while.rkt └── main.rkt /.gitignore: -------------------------------------------------------------------------------- 1 | compiled/ 2 | dist/ 3 | *~ -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2021 Micah Cantor 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # racket-lox 2 | 3 | racket-lox is an implementation of [the Lox language](https://github.com/munificent/craftinginterpreters/) from Robert Nystrom's book [Crafting Interpreters](https://craftinginterpreters.com/) in Typed Racket. 4 | 5 | This interpreter is based on the tree-walking Java interpreter described in part II of the book, meaning it largely follows the book's imperative style, rather than the functional programming that is more common in Racket. However, there are a few differences in the implementation: 6 | 7 | - Rather than using classes and inheritance to model the AST nodes, we instead model the tree as a union type of structs. This means that we use pattern matching rather than [the Visitor pattern](https://craftinginterpreters.com/representing-code.html#the-visitor-pattern) in the evaluator and the resolver. 8 | - As such, there is no need for [the metaprogramming described in chapter 5](https://craftinginterpreters.com/representing-code.html#metaprogramming-the-trees) to create classes for the AST nodes. 9 | - `Callable` is implemented as a union type of `Function`, `NativeFunction` and `Class`. Because of annoyances surrounding cyclic imports, the `Callable`-related code lives in [interpreter.rkt](src/interpreter.rkt) rather than in a separate file. 10 | - Error related functions are placed in a separate file, [error.rkt](src/error.rkt) rather than with the top-level program interface, which lives in [main.rkt](src/main.rkt). 11 | 12 | Despite the differences, racket-lox passes all of [the tests provided by Nystrom](https://github.com/munificent/craftinginterpreters#testing). 13 | 14 | ## Running the interpreter 15 | 16 | To run the interpreter, simply use `racket src/main.rkt`, passing a `.lox` file as an argument to run a script. Note that because of the use of typed racket, the interpreter is very slow when run uncompiled. Therefore it's best to use `raco make src/main.rkt` before executing. 17 | 18 | To build an executable (e.g. to use with the test runner), use `raco exe -o dist/main src/main.rkt`. -------------------------------------------------------------------------------- /data/and.lox: -------------------------------------------------------------------------------- 1 | // Note: These tests implicitly depend on ints being truthy. 2 | 3 | // Return the first non-true argument. 4 | print false and 1; // expect: false 5 | print true and 1; // expect: 1 6 | print 1 and 2 and false; // expect: false 7 | 8 | // Return the last argument if all are true. 9 | print 1 and true; // expect: true 10 | print 1 and 2 and 3; // expect: 3 11 | 12 | // Short-circuit at the first false argument. 13 | var a = "before"; 14 | var b = "before"; 15 | (a = true) and 16 | (b = false) and 17 | (a = "bad"); 18 | print a; // expect: true 19 | print b; // expect: false -------------------------------------------------------------------------------- /data/block.lox: -------------------------------------------------------------------------------- 1 | { 2 | var a = "local"; 3 | { 4 | var a = "shadow"; 5 | print a; // expect: shadow 6 | } 7 | print a; // expect: local 8 | } -------------------------------------------------------------------------------- /data/class.lox: -------------------------------------------------------------------------------- 1 | class Cake { 2 | init(flavor) { 3 | this.flavor = flavor; 4 | } 5 | 6 | taste() { 7 | var adjective = "delicious"; 8 | return "This " + this.flavor + " cake is " + adjective + "!"; 9 | } 10 | } 11 | 12 | var cake = Cake("German Chocolate"); 13 | print cake.taste(); -------------------------------------------------------------------------------- /data/closure.lox: -------------------------------------------------------------------------------- 1 | fun makeCounter() { 2 | var i = 0; 3 | fun count() { 4 | i = i + 1; 5 | print i; 6 | } 7 | return count; 8 | } 9 | 10 | var counter = makeCounter(); 11 | counter(); 12 | counter(); -------------------------------------------------------------------------------- /data/collide_with_parameter.lox: -------------------------------------------------------------------------------- 1 | fun foo(a) { 2 | var a; // Error at 'a': Already a variable with this name in this scope. 3 | } 4 | 5 | foo(3); -------------------------------------------------------------------------------- /data/constuctor_missing_arguments.lox: -------------------------------------------------------------------------------- 1 | class Foo { 2 | init(a, b) {} 3 | } 4 | 5 | var foo = Foo(1); // expect runtime error: Expected 2 arguments but got 1. -------------------------------------------------------------------------------- /data/fib.lox: -------------------------------------------------------------------------------- 1 | fun fib(n) { 2 | if (n <= 1) return n; 3 | return fib(n-2) + fib(n-1); 4 | } 5 | 6 | for (var i = 0; i < 10; i = i + 1) { 7 | print fib(i); 8 | } -------------------------------------------------------------------------------- /data/for-loop.lox: -------------------------------------------------------------------------------- 1 | for (var i = 0; i < 10; i = i + 1) { 2 | print i; 3 | } -------------------------------------------------------------------------------- /data/if.lox: -------------------------------------------------------------------------------- 1 | // Evaluate the 'then' expression if the condition is true. 2 | if (true) print "good"; // expect: good 3 | if (false) print "bad"; 4 | 5 | // Allow block body. 6 | if (true) { print "block"; } // expect: block 7 | 8 | // Assignment in if condition. 9 | var a = false; 10 | if (a = true) print "true"; 11 | -------------------------------------------------------------------------------- /data/inheritance.lox: -------------------------------------------------------------------------------- 1 | class Doughnut { 2 | cook() { 3 | print "Fry until golden brown."; 4 | } 5 | } 6 | 7 | class BostonCream < Doughnut { 8 | cook() { 9 | super.cook(); 10 | print "Pipe full of custard and coat with chocolate."; 11 | } 12 | } 13 | 14 | BostonCream().cook(); -------------------------------------------------------------------------------- /data/lang-lox/fib.rkt: -------------------------------------------------------------------------------- 1 | #lang lox 2 | 3 | fun fib(n) { 4 | if (n <= 1) return n; 5 | return fib(n-2) + fib(n-1); 6 | } 7 | 8 | for (var i = 0; i < 10; i = i + 1) { 9 | print fib(i); 10 | } -------------------------------------------------------------------------------- /data/lang-lox/hello_world.rkt: -------------------------------------------------------------------------------- 1 | #lang lox 2 | 3 | print "hello world"; -------------------------------------------------------------------------------- /data/missing_comma_in_parameters.lox: -------------------------------------------------------------------------------- 1 | // [line 3] Error at 'c': Expect ')' after parameters. 2 | fun foo(a, b c, d, e, f) {} -------------------------------------------------------------------------------- /data/number_literals.lox: -------------------------------------------------------------------------------- 1 | print 123; // expect: 123 2 | print 987654; // expect: 987654 3 | print 0; // expect: 0 4 | print -0; // expect: -0 5 | 6 | print 123.456; // expect: 123.456 7 | print -0.001; // expect: -0.001 -------------------------------------------------------------------------------- /data/resolving.lox: -------------------------------------------------------------------------------- 1 | var a = "global"; 2 | { 3 | fun showA() { 4 | print a; 5 | } 6 | 7 | showA(); // "global" 8 | var a = "block"; 9 | showA(); // "global" 10 | } 11 | -------------------------------------------------------------------------------- /data/return_value.lox: -------------------------------------------------------------------------------- 1 | class Foo { 2 | init() { 3 | return "result"; // Error at 'return': Can't return a value from an initializer. 4 | } 5 | } -------------------------------------------------------------------------------- /data/super_parenthesized.lox: -------------------------------------------------------------------------------- 1 | class A { 2 | method() {} 3 | } 4 | 5 | class B < A { 6 | method() { 7 | // [line 8] Error at ')': Expect '.' after 'super'. 8 | (super).method(); 9 | } 10 | } -------------------------------------------------------------------------------- /data/this.lox: -------------------------------------------------------------------------------- 1 | fun notAMethod() { 2 | print this; 3 | } 4 | 5 | notAMethod(); -------------------------------------------------------------------------------- /data/too_many_arguments.lox: -------------------------------------------------------------------------------- 1 | fun foo() {} 2 | { 3 | var a = 1; 4 | foo( 5 | a, // 1 6 | a, // 2 7 | a, // 3 8 | a, // 4 9 | a, // 5 10 | a, // 6 11 | a, // 7 12 | a, // 8 13 | a, // 9 14 | a, // 10 15 | a, // 11 16 | a, // 12 17 | a, // 13 18 | a, // 14 19 | a, // 15 20 | a, // 16 21 | a, // 17 22 | a, // 18 23 | a, // 19 24 | a, // 20 25 | a, // 21 26 | a, // 22 27 | a, // 23 28 | a, // 24 29 | a, // 25 30 | a, // 26 31 | a, // 27 32 | a, // 28 33 | a, // 29 34 | a, // 30 35 | a, // 31 36 | a, // 32 37 | a, // 33 38 | a, // 34 39 | a, // 35 40 | a, // 36 41 | a, // 37 42 | a, // 38 43 | a, // 39 44 | a, // 40 45 | a, // 41 46 | a, // 42 47 | a, // 43 48 | a, // 44 49 | a, // 45 50 | a, // 46 51 | a, // 47 52 | a, // 48 53 | a, // 49 54 | a, // 50 55 | a, // 51 56 | a, // 52 57 | a, // 53 58 | a, // 54 59 | a, // 55 60 | a, // 56 61 | a, // 57 62 | a, // 58 63 | a, // 59 64 | a, // 60 65 | a, // 61 66 | a, // 62 67 | a, // 63 68 | a, // 64 69 | a, // 65 70 | a, // 66 71 | a, // 67 72 | a, // 68 73 | a, // 69 74 | a, // 70 75 | a, // 71 76 | a, // 72 77 | a, // 73 78 | a, // 74 79 | a, // 75 80 | a, // 76 81 | a, // 77 82 | a, // 78 83 | a, // 79 84 | a, // 80 85 | a, // 81 86 | a, // 82 87 | a, // 83 88 | a, // 84 89 | a, // 85 90 | a, // 86 91 | a, // 87 92 | a, // 88 93 | a, // 89 94 | a, // 90 95 | a, // 91 96 | a, // 92 97 | a, // 93 98 | a, // 94 99 | a, // 95 100 | a, // 96 101 | a, // 97 102 | a, // 98 103 | a, // 99 104 | a, // 100 105 | a, // 101 106 | a, // 102 107 | a, // 103 108 | a, // 104 109 | a, // 105 110 | a, // 106 111 | a, // 107 112 | a, // 108 113 | a, // 109 114 | a, // 110 115 | a, // 111 116 | a, // 112 117 | a, // 113 118 | a, // 114 119 | a, // 115 120 | a, // 116 121 | a, // 117 122 | a, // 118 123 | a, // 119 124 | a, // 120 125 | a, // 121 126 | a, // 122 127 | a, // 123 128 | a, // 124 129 | a, // 125 130 | a, // 126 131 | a, // 127 132 | a, // 128 133 | a, // 129 134 | a, // 130 135 | a, // 131 136 | a, // 132 137 | a, // 133 138 | a, // 134 139 | a, // 135 140 | a, // 136 141 | a, // 137 142 | a, // 138 143 | a, // 139 144 | a, // 140 145 | a, // 141 146 | a, // 142 147 | a, // 143 148 | a, // 144 149 | a, // 145 150 | a, // 146 151 | a, // 147 152 | a, // 148 153 | a, // 149 154 | a, // 150 155 | a, // 151 156 | a, // 152 157 | a, // 153 158 | a, // 154 159 | a, // 155 160 | a, // 156 161 | a, // 157 162 | a, // 158 163 | a, // 159 164 | a, // 160 165 | a, // 161 166 | a, // 162 167 | a, // 163 168 | a, // 164 169 | a, // 165 170 | a, // 166 171 | a, // 167 172 | a, // 168 173 | a, // 169 174 | a, // 170 175 | a, // 171 176 | a, // 172 177 | a, // 173 178 | a, // 174 179 | a, // 175 180 | a, // 176 181 | a, // 177 182 | a, // 178 183 | a, // 179 184 | a, // 180 185 | a, // 181 186 | a, // 182 187 | a, // 183 188 | a, // 184 189 | a, // 185 190 | a, // 186 191 | a, // 187 192 | a, // 188 193 | a, // 189 194 | a, // 190 195 | a, // 191 196 | a, // 192 197 | a, // 193 198 | a, // 194 199 | a, // 195 200 | a, // 196 201 | a, // 197 202 | a, // 198 203 | a, // 199 204 | a, // 200 205 | a, // 201 206 | a, // 202 207 | a, // 203 208 | a, // 204 209 | a, // 205 210 | a, // 206 211 | a, // 207 212 | a, // 208 213 | a, // 209 214 | a, // 210 215 | a, // 211 216 | a, // 212 217 | a, // 213 218 | a, // 214 219 | a, // 215 220 | a, // 216 221 | a, // 217 222 | a, // 218 223 | a, // 219 224 | a, // 220 225 | a, // 221 226 | a, // 222 227 | a, // 223 228 | a, // 224 229 | a, // 225 230 | a, // 226 231 | a, // 227 232 | a, // 228 233 | a, // 229 234 | a, // 230 235 | a, // 231 236 | a, // 232 237 | a, // 233 238 | a, // 234 239 | a, // 235 240 | a, // 236 241 | a, // 237 242 | a, // 238 243 | a, // 239 244 | a, // 240 245 | a, // 241 246 | a, // 242 247 | a, // 243 248 | a, // 244 249 | a, // 245 250 | a, // 246 251 | a, // 247 252 | a, // 248 253 | a, // 249 254 | a, // 250 255 | a, // 251 256 | a, // 252 257 | a, // 253 258 | a, // 254 259 | a, // 255 260 | a); // Error at 'a': Can't have more than 255 arguments. 261 | } 262 | -------------------------------------------------------------------------------- /data/unterminated_string.lox: -------------------------------------------------------------------------------- 1 | "doesn't end -------------------------------------------------------------------------------- /data/while-loop.lox: -------------------------------------------------------------------------------- 1 | { 2 | var i = 0; 3 | while (i < 10) { 4 | print i; 5 | i = i + 1; 6 | } 7 | } -------------------------------------------------------------------------------- /src/lox/expander.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require "lib/interpreter.rkt") 4 | (require "lib/resolver.rkt") 5 | (require "lib/error.rkt") 6 | 7 | (define interpreter (make-interpreter)) 8 | (define resolver (make-resolver interpreter)) 9 | 10 | (define-syntax-rule (run stmts) 11 | (unless had-error ; parser error 12 | (resolve-all! resolver stmts) 13 | (unless had-error ; resolver error 14 | (interpret! interpreter stmts)))) 15 | 16 | (define-syntax-rule (lox-module-begin STMT ...) 17 | (#%module-begin (run (list STMT ...)))) 18 | 19 | (provide 20 | (rename-out [lox-module-begin #%module-begin]) 21 | #%top #%app #%datum #%top-interaction) -------------------------------------------------------------------------------- /src/lox/lib/class.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (require racket/match) 4 | (require "function.rkt") 5 | 6 | (provide (all-defined-out)) 7 | 8 | (define-type Class class) 9 | (struct class ([name : String] [superclass : (Option Class)] [methods : (HashTable String Function)])) 10 | 11 | (: make-class (-> String (Option Class) (HashTable String Function) Class)) 12 | (define (make-class name superclass methods) 13 | (class name superclass methods)) 14 | 15 | (: class-find-method (-> Class String (Option Function))) 16 | (define (class-find-method c name) 17 | (match-define (class class-name superclass methods) c) 18 | (cond 19 | [(hash-has-key? methods name) 20 | (hash-ref methods name)] ; override superclass methods 21 | [superclass 22 | (class-find-method superclass name)] 23 | [else #f])) -------------------------------------------------------------------------------- /src/lox/lib/env.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (require racket/match) 4 | (require "error.rkt") 5 | (require "token.rkt") 6 | 7 | (provide (all-defined-out)) 8 | 9 | (struct env ([values : (HashTable String Any)] 10 | [enclosing : (Option Env)])) 11 | (define-type Env env) 12 | 13 | (: make-env (->* () (Env) Env)) 14 | (define (make-env [enclosure #f]) 15 | (env (make-hash) enclosure)) 16 | 17 | (: env-define (-> Env String Any Void)) 18 | (define (env-define e name value) 19 | (hash-set! (env-values e) name value)) 20 | 21 | (: env-get (-> Env Token Any)) 22 | (define (env-get e name) 23 | (define lexeme (token-lexeme name)) 24 | (define-values (val _) (env-member e name)) 25 | val) 26 | 27 | (: env-get-at (-> Env Integer String Any)) 28 | (define (env-get-at e dist name) 29 | (define vals (env-values (env-ancestor e dist))) 30 | (hash-ref vals name)) 31 | 32 | (: env-ancestor (-> Env Integer Env)) 33 | (define (env-ancestor e dist) 34 | (define env e) 35 | (for ([i (in-range dist)]) 36 | (set! env (assert (env-enclosing env)))) 37 | env) 38 | 39 | (: env-assign (-> Env Token Any Void)) 40 | (define (env-assign e name value) 41 | (define lexeme (token-lexeme name)) 42 | (define-values (variable defined-env) 43 | (env-member e name)) 44 | (env-define defined-env lexeme value)) 45 | 46 | (: env-assign-at (-> Env Integer Token Any Void)) 47 | (define (env-assign-at e dist name value) 48 | (define vals (env-values (env-ancestor e dist))) 49 | (hash-set! vals (token-lexeme name) value)) 50 | 51 | (: env-member (-> Env Token (Values Any Env))) 52 | (define (env-member e name) 53 | (match-define (env env-values enclosing) e) 54 | (define lexeme (token-lexeme name)) 55 | (cond 56 | [(hash-has-key? env-values lexeme) 57 | (values (hash-ref env-values lexeme) e)] 58 | [enclosing (env-member enclosing name)] 59 | [else 60 | (raise-undefined-variable-error name lexeme) 61 | (values null (make-env))])) -------------------------------------------------------------------------------- /src/lox/lib/error.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (require racket/match) 4 | (require "token.rkt") 5 | 6 | (provide (all-defined-out)) 7 | 8 | #| Global error flags |# 9 | 10 | (: had-error Boolean) 11 | (define had-error #f) 12 | 13 | (: had-runtime-error Boolean) 14 | (define had-runtime-error #f) 15 | 16 | (: set-had-error! (-> Boolean Void)) 17 | (define (set-had-error! bool) 18 | (set! had-error bool)) 19 | 20 | (: set-had-runtime-error! (-> Boolean Void)) 21 | (define (set-had-runtime-error! bool) 22 | (set! had-runtime-error bool)) 23 | 24 | #| Parse errors |# 25 | 26 | (struct exn:parse-error exn:fail ()) 27 | (define-type ParseError exn:parse-error) 28 | 29 | (: make-parse-error (-> Token String exn:parse-error)) 30 | (define (make-parse-error token message) 31 | (lox-error token message) ; print error message and set had-error 32 | (exn:parse-error (lox-error-message (token-line token) "" message) 33 | (current-continuation-marks))) 34 | 35 | (: raise-parse-error (-> Token String exn:parse-error)) 36 | (define (raise-parse-error token message) 37 | (raise (make-parse-error token message))) 38 | 39 | #| Runtime errors |# 40 | 41 | (struct exn:runtime-error exn:fail ([token : Token])) 42 | (define-type RuntimeError exn:runtime-error) 43 | 44 | (: make-runtime-error (-> Token String RuntimeError)) 45 | (define (make-runtime-error token message) 46 | (exn:runtime-error message (current-continuation-marks) token)) 47 | 48 | (: raise-runtime-error (-> Token String RuntimeError)) 49 | (define (raise-runtime-error token message) 50 | (raise (make-runtime-error token message))) 51 | 52 | (: runtime-error (-> RuntimeError Void)) 53 | (define (runtime-error e) 54 | (set-had-runtime-error! #t) 55 | (displayln (runtime-error-message e) (current-error-port))) 56 | 57 | (: runtime-error-message (-> RuntimeError String)) 58 | (define (runtime-error-message e) 59 | (format "~a\n[line ~a]" 60 | (exn-message e) 61 | (token-line (exn:runtime-error-token e)))) 62 | 63 | (: raise-undefined-variable-error (-> Token String exn:runtime-error)) 64 | (define (raise-undefined-variable-error name lexeme) 65 | (raise-runtime-error 66 | name (format "Undefined variable '~a'." lexeme))) 67 | 68 | #| Lox errors |# 69 | 70 | (: lox-error (-> Token String Void)) 71 | (define (lox-error t message) 72 | (match-define (token type lexeme _ line) t) 73 | (if (equal? type EOF) 74 | (report-error line " at end" message) 75 | (report-error line (format " at '~a'" lexeme) message))) 76 | 77 | (: report-error (-> Integer String String Void)) 78 | (define (report-error line where message) 79 | (displayln (lox-error-message line where message) (current-error-port)) 80 | (set-had-error! #t)) 81 | 82 | (: lox-error-message (-> Integer String String String)) 83 | (define (lox-error-message line where message) 84 | (format "[line ~a] Error~a: ~a" line where message)) 85 | -------------------------------------------------------------------------------- /src/lox/lib/expr.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (require "token.rkt") 4 | 5 | (provide (all-defined-out)) 6 | 7 | (define-type Expr 8 | (U AssignExpr BinaryExpr CallExpr GetExpr GroupingExpr LiteralExpr 9 | SetExpr SuperExpr ThisExpr UnaryExpr VariableExpr EmptyExpr)) 10 | 11 | (struct assign ([name : Token] [value : Expr])) 12 | (define-type AssignExpr assign) 13 | 14 | (struct binary ([left : Expr] [operator : Token] [right : Expr])) 15 | (define-type BinaryExpr binary) 16 | 17 | (struct call ([callee : Expr] [paren : Token] [args : (Listof Expr)])) 18 | (define-type CallExpr call) 19 | 20 | (struct get ([object : Expr] [name : Token])) 21 | (define-type GetExpr get) 22 | 23 | (struct grouping ([expression : Expr])) 24 | (define-type GroupingExpr grouping) 25 | 26 | (struct literal ([value : Lox-Literal])) 27 | (define-type LiteralExpr literal) 28 | 29 | (struct set-expr ([object : Expr] [name : Token] [value : Expr])) 30 | (define-type SetExpr set-expr) 31 | 32 | (struct super-expr ([keyword : Token] [method : Token])) 33 | (define-type SuperExpr super-expr) 34 | 35 | (struct this-expr ([keyword : Token])) 36 | (define-type ThisExpr this-expr) 37 | 38 | (struct unary ([operator : Token] [right : Expr])) 39 | (define-type UnaryExpr unary) 40 | 41 | (struct variable ([name : Token])) 42 | (define-type VariableExpr variable) 43 | 44 | (struct empty-expr ()) 45 | (define-type EmptyExpr empty-expr) -------------------------------------------------------------------------------- /src/lox/lib/function.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (require "stmt.rkt") 4 | (require "env.rkt") 5 | 6 | (provide (all-defined-out)) 7 | 8 | (struct function ([declaration : FunDecl] [closure : Env] [is-initalizer? : Boolean])) 9 | (define-type Function function) 10 | 11 | (struct return exn ([value : Any])) 12 | (define-type Return return) 13 | 14 | (: make-return (-> Any Return)) 15 | (define (make-return v) 16 | (return "" (current-continuation-marks) v)) 17 | -------------------------------------------------------------------------------- /src/lox/lib/instance.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (require racket/match) 4 | (require "function.rkt") 5 | (require "env.rkt") 6 | (require "class.rkt") 7 | (require "token.rkt") 8 | (require "error.rkt") 9 | 10 | (provide (all-defined-out)) 11 | 12 | (define-type Instance instance) 13 | (struct instance ([class : Class] [fields : (HashTable String Any)])) 14 | 15 | (: make-instance (-> Class Instance)) 16 | (define (make-instance class) 17 | (define fields : (HashTable String Any) (make-hash)) 18 | (instance class fields)) 19 | 20 | (: instance-get (-> Instance Token Any)) 21 | (define (instance-get in name) 22 | (match-define (instance class fields) in) 23 | (define lexeme (token-lexeme name)) 24 | (define method (class-find-method class lexeme)) 25 | (cond 26 | [(hash-has-key? fields lexeme) 27 | (hash-ref fields lexeme)] 28 | [method 29 | (bind method in)] 30 | [else 31 | (raise-runtime-error name (format "Undefined property '~a'." lexeme))])) 32 | 33 | (: instance-set! (-> Instance Token Any Void)) 34 | (define (instance-set! instance name value) 35 | (hash-set! (instance-fields instance) (token-lexeme name) value)) 36 | 37 | ; Create a new function bound to an instance of a class, by 38 | ; creating a new environment with "this" local variable 39 | ; bound to the given instance. 40 | (: bind (-> Function Instance Function)) 41 | (define (bind fun in) 42 | (match-define (function declaration closure is-initalizer?) fun) 43 | (define env (make-env closure)) 44 | (env-define env "this" in) 45 | (function declaration env is-initalizer?)) 46 | 47 | (: instance->string (-> Instance String)) 48 | (define (instance->string instance) 49 | (define name (class-name (instance-class instance))) 50 | (format "~a instance" name)) -------------------------------------------------------------------------------- /src/lox/lib/interpreter.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (require racket/match) 4 | (require racket/string) 5 | (require racket/format) 6 | (require "expr.rkt") 7 | (require "stmt.rkt") 8 | (require "token.rkt") 9 | (require "error.rkt") 10 | (require "env.rkt") 11 | (require "class.rkt") 12 | (require "function.rkt") 13 | (require "instance.rkt") 14 | (require "../utils/while.rkt") 15 | 16 | (provide interpret! make-interpreter interpreter-resolve! Interpreter) 17 | 18 | (define-type Interpreter interpreter) 19 | (struct interpreter ([env : Env] 20 | [globals : Env] 21 | [locals : (HashTable Expr Integer)]) #:mutable) 22 | 23 | (: make-interpreter (-> Interpreter)) 24 | (define (make-interpreter) 25 | (define globals (make-env)) 26 | (define environment globals) 27 | (define locals : (HashTable Expr Integer) (make-hash)) 28 | (env-define globals "clock" (make-clock)) 29 | (interpreter environment globals locals)) 30 | 31 | (: interpret! (-> Interpreter (Listof Stmt) Void)) 32 | (define (interpret! i statements) 33 | (with-handlers ([exn:runtime-error? runtime-error]) 34 | (for ([statement statements]) 35 | (execute i statement)))) 36 | 37 | #| Resolving |# 38 | 39 | (: interpreter-resolve! (-> Interpreter Expr Integer Void)) 40 | (define (interpreter-resolve! i expr depth) 41 | (hash-set! (interpreter-locals i) expr depth)) 42 | 43 | #| Statements |# 44 | 45 | (: execute (-> Interpreter Stmt Void)) 46 | (define (execute i stmt) 47 | (cond 48 | [(expression-stmt? stmt) (exec-expression-stmt i stmt)] 49 | [(print-stmt? stmt) (exec-print-stmt i stmt)] 50 | [(block-stmt? stmt) (exec-block-stmt i stmt)] 51 | [(if-stmt? stmt) (exec-if-stmt i stmt)] 52 | [(while-stmt? stmt) (exec-while-stmt i stmt)] 53 | [(return-stmt? stmt) (exec-return-stmt i stmt)] 54 | [(class-decl? stmt) (exec-class-decl i stmt)] 55 | [(fun-decl? stmt) (exec-fun-decl i stmt)] 56 | [(var-decl? stmt) (exec-var-decl i stmt)])) 57 | 58 | (: exec-expression-stmt (-> Interpreter ExpressionStmt Void)) 59 | (define (exec-expression-stmt i stmt) 60 | (evaluate i (expression-stmt-expr stmt)) 61 | (void)) 62 | 63 | (: exec-print-stmt (-> Interpreter PrintStmt Void)) 64 | (define (exec-print-stmt i stmt) 65 | (define value (evaluate i (print-stmt-value stmt))) 66 | (displayln (value->string value))) 67 | 68 | (: exec-block-stmt (-> Interpreter BlockStmt Void)) 69 | (define (exec-block-stmt i stmt) 70 | (define statements (block-stmt-statements stmt)) 71 | (exec-block i statements (make-env (interpreter-env i)))) 72 | 73 | (: exec-block (-> Interpreter (Listof Stmt) Env Void)) 74 | (define (exec-block i statements env) 75 | (define previous (interpreter-env i)) 76 | (: handle-return (-> Return Any)) 77 | (define (handle-return v) 78 | (set-interpreter-env! i previous) 79 | (raise v)) 80 | (set-interpreter-env! i env) 81 | (with-handlers ([return? handle-return]) 82 | (for ([statement statements]) 83 | (execute i statement))) 84 | (set-interpreter-env! i previous)) 85 | 86 | (: exec-if-stmt (-> Interpreter IfStmt Void)) 87 | (define (exec-if-stmt i stmt) 88 | (match-define (if-stmt condition consequent alternate) stmt) 89 | (cond 90 | [(truthy? (evaluate i condition)) 91 | (execute i consequent)] 92 | [alternate 93 | (execute i alternate)])) 94 | 95 | (: exec-while-stmt (-> Interpreter WhileStmt Void)) 96 | (define (exec-while-stmt i stmt) 97 | (match-define (while-stmt condition body) stmt) 98 | (while (truthy? (evaluate i condition)) 99 | (execute i body))) 100 | 101 | (: exec-return-stmt (-> Interpreter ReturnStmt Void)) 102 | (define (exec-return-stmt i stmt) 103 | (define value 104 | (if (return-stmt-value stmt) 105 | (evaluate i (return-stmt-value stmt)) 106 | null)) 107 | (raise (make-return value)) 108 | (void)) 109 | 110 | (: exec-class-decl (-> Interpreter ClassDecl Void)) 111 | (define (exec-class-decl i stmt) 112 | (match-define (class-decl name stmt-superclass methods) stmt) 113 | (define superclass : (Option Class) 114 | (cond 115 | [stmt-superclass 116 | (define evaluated (evaluate i stmt-superclass)) 117 | (unless (class? evaluated) 118 | (raise-runtime-error (variable-name stmt-superclass) "Superclass must be a class.")) 119 | (assert evaluated class?)] 120 | [else #f])) 121 | (define env (interpreter-env i)) 122 | (env-define env (token-lexeme name) null) 123 | (when stmt-superclass 124 | (set! env (make-env env)) 125 | (env-define env "super" superclass)) 126 | (define class-methods : (HashTable String Function) (make-hash)) 127 | (for ([method methods]) 128 | (define is-initalizer? (equal? "init" (token-lexeme (fun-decl-name method)))) 129 | (define fun (function method env is-initalizer?)) 130 | (define name (token-lexeme (fun-decl-name method))) 131 | (hash-set! class-methods name fun)) 132 | (define lox-class (make-class (token-lexeme name) superclass class-methods)) 133 | (when superclass (set! env (assert (env-enclosing env)))) 134 | (env-assign env name lox-class)) 135 | 136 | (: exec-fun-decl (-> Interpreter FunDecl Void)) 137 | (define (exec-fun-decl i stmt) 138 | (define env (interpreter-env i)) 139 | (define fun (function stmt env #f)) 140 | (define fun-name (token-lexeme (fun-decl-name stmt))) 141 | (env-define env fun-name fun)) 142 | 143 | (: exec-var-decl (-> Interpreter VarDecl Void)) 144 | (define (exec-var-decl i stmt) 145 | (match-define (var-decl name initializer) stmt) 146 | (define value (if initializer (evaluate i initializer) null)) 147 | (env-define (interpreter-env i) (token-lexeme name) value)) 148 | 149 | #| Expressions |# 150 | 151 | (: evaluate (-> Interpreter Expr Any)) 152 | (define (evaluate i expr) 153 | (cond 154 | [(literal? expr) (eval-literal i expr)] 155 | [(variable? expr) (eval-variable-expression i expr)] 156 | [(assign? expr) (eval-assign i expr)] 157 | [(grouping? expr) (eval-grouping i expr)] 158 | [(unary? expr) (eval-unary i expr)] 159 | [(call? expr) (eval-call i expr)] 160 | [(get? expr) (eval-get i expr)] 161 | [(set-expr? expr) (eval-set-expr i expr)] 162 | [(super-expr? expr) (eval-super-expr i expr)] 163 | [(this-expr? expr) (eval-this-expr i expr)] 164 | [(binary? expr) (eval-binary i expr)])) 165 | 166 | (: eval-literal (-> Interpreter LiteralExpr Any)) 167 | (define (eval-literal i expr) 168 | (literal-value expr)) 169 | 170 | (: eval-variable-expression (-> Interpreter VariableExpr Any)) 171 | (define (eval-variable-expression i expr) 172 | (lookup-variable i (variable-name expr) expr)) 173 | 174 | (: lookup-variable (-> Interpreter Token Expr Any)) 175 | (define (lookup-variable i name expr) 176 | (match-define (interpreter env globals locals) i) 177 | (define distance (hash-ref locals expr #f)) 178 | (if distance 179 | (env-get-at env distance (token-lexeme name)) 180 | (env-get globals name))) 181 | 182 | (: eval-assign (-> Interpreter AssignExpr Any)) 183 | (define (eval-assign i expr) 184 | (match-define (interpreter env globals locals) i) 185 | (match-define (assign name val) expr) 186 | (define value (evaluate i val)) 187 | (define distance (hash-ref locals expr #f)) 188 | (if distance 189 | (env-assign-at env distance name value) 190 | (env-assign globals name value)) 191 | value) ; return the assigned value 192 | 193 | (: eval-grouping (-> Interpreter GroupingExpr Any)) 194 | (define (eval-grouping i expr) 195 | (evaluate i (grouping-expression expr))) 196 | 197 | (: eval-unary (-> Interpreter UnaryExpr Any)) 198 | (define (eval-unary i expr) 199 | (match-define (unary operator r) expr) 200 | (define right (evaluate i r)) 201 | (match (token-type operator) 202 | [(quote MINUS) 203 | (check-number-operand operator right) 204 | (- right)] 205 | [(quote BANG) (not (truthy? right))])) 206 | 207 | (: eval-call (-> Interpreter CallExpr Any)) 208 | (define (eval-call i expr) 209 | (match-define (call callee-expr call-site args) expr) 210 | (define callee (evaluate i callee-expr)) 211 | (check-callable callee call-site) 212 | (define arity (callable-arity callee)) 213 | (define arguments : (Vectorof Any) 214 | (for/vector ([arg args]) 215 | (evaluate i arg))) 216 | (define argc (vector-length arguments)) 217 | (unless (= argc arity) 218 | (raise-runtime-error 219 | call-site (format "Expected ~a arguments but got ~a." arity argc))) 220 | (callable-call callee i arguments)) 221 | 222 | (: eval-get (-> Interpreter GetExpr Any)) 223 | (define (eval-get i expr) 224 | (match-define (get obj name) expr) 225 | (define object (evaluate i obj)) 226 | (if (instance? object) 227 | (instance-get object name) 228 | (raise-runtime-error name "Only instances have properties."))) 229 | 230 | (: eval-set-expr (-> Interpreter SetExpr Any)) 231 | (define (eval-set-expr i expr) 232 | (match-define (set-expr expr-object expr-name expr-value) expr) 233 | (define object (evaluate i expr-object)) 234 | (cond 235 | [(instance? object) 236 | (define value (evaluate i expr-value)) 237 | (instance-set! object expr-name value) 238 | value] 239 | [else 240 | (raise-runtime-error expr-name "Only instances have fields.")])) 241 | 242 | (: eval-super-expr (-> Interpreter SuperExpr Any)) 243 | (define (eval-super-expr i expr) 244 | (define method-name (token-lexeme (super-expr-method expr))) 245 | (define distance (hash-ref (interpreter-locals i) expr)) 246 | (define superclass 247 | (env-get-at (interpreter-env i) distance "super")) 248 | (define object 249 | (env-get-at (interpreter-env i) (sub1 distance) "this")) 250 | (assert superclass class?) 251 | (assert object instance?) 252 | (define method (class-find-method superclass method-name)) 253 | (if method 254 | (bind method object) 255 | (raise-runtime-error (super-expr-method expr) (format "Undefined property '~a'." method-name)))) 256 | 257 | (: eval-this-expr (-> Interpreter ThisExpr Any)) 258 | (define (eval-this-expr i expr) 259 | (lookup-variable i (this-expr-keyword expr) expr)) 260 | 261 | (: eval-binary (-> Interpreter BinaryExpr Any)) 262 | (define (eval-binary i expr) 263 | (match-define (binary l operator r) expr) 264 | (define left (evaluate i l)) 265 | (define right 266 | (match (token-type operator) 267 | [(or (quote OR) (quote AND)) #f] 268 | [_ (evaluate i r)])) 269 | (match (token-type operator) 270 | [(quote OR) 271 | (if (truthy? left) left (evaluate i r))] 272 | [(quote AND) 273 | (if (truthy? left) (evaluate i r) left)] 274 | [(quote BANG_EQUAL) 275 | (not (lox-equal? left right))] 276 | [(quote EQUAL_EQUAL) 277 | (lox-equal? left right)] 278 | [(quote GREATER) 279 | (check-number-operands operator left right) 280 | (> left right)] 281 | [(quote GREATER_EQUAL) 282 | (check-number-operands operator left right) 283 | (>= left right)] 284 | [(quote LESS) 285 | (check-number-operands operator left right) 286 | (< left right)] 287 | [(quote LESS_EQUAL) 288 | (check-number-operands operator left right) 289 | (<= left right)] 290 | [(quote MINUS) 291 | (check-number-operands operator left right) 292 | (- left right)] 293 | [(quote SLASH) 294 | (check-number-operands operator left right) 295 | (/ left right)] 296 | [(quote STAR) 297 | (check-number-operands operator left right) 298 | (* left right)] 299 | [(quote PLUS) 300 | (cond 301 | [(and (string? left) (string? right)) 302 | (string-append left right)] 303 | [(and (number? left) (number? right)) 304 | (+ left right)] 305 | [else 306 | (raise-runtime-error operator "Operands must be two numbers or two strings.")])])) 307 | 308 | #| Callable |# 309 | 310 | (define-type Callable (U Function NativeFunction Class)) 311 | 312 | (: callable? (Any -> Boolean : Callable)) 313 | (define-predicate callable? Callable) 314 | 315 | (define-syntax-rule (check-callable callee call-site) 316 | (begin 317 | (unless (callable? callee) 318 | (raise-runtime-error call-site "Can only call functions and classes.")) 319 | (assert callee callable?))) 320 | 321 | (: callable-call (-> Callable Interpreter (Vectorof Any) Any)) 322 | (define (callable-call callee i args) 323 | (match callee 324 | [(function _ _ _) (call-function callee i args)] 325 | [(native-function call-func _) (call-func callee i args)] 326 | [(class _ _ _) (call-class callee i args)])) 327 | 328 | (: callable-arity (-> Callable Natural)) 329 | (define (callable-arity callee) 330 | (match callee 331 | [(function (fun-decl _ params _) _ _) (vector-length params)] 332 | [(native-function _ arity) arity] 333 | [(class _ _ _) (class-arity callee)])) 334 | 335 | (: callable->string (-> Callable String)) 336 | (define (callable->string callee) 337 | (match callee 338 | [(function (fun-decl name _ _) _ _) (format "" (token-lexeme name))] 339 | [(native-function _ _) ""] 340 | [(class name _ _) name])) 341 | 342 | (: call-function (-> Function Interpreter (Vectorof Any) Any)) 343 | (define (call-function func i args) 344 | (match-define (function (fun-decl _ params body) closure is-initalizer?) func) 345 | (define env (make-env (function-closure func))) 346 | (for ([param params] [arg args]) 347 | (env-define env (token-lexeme param) arg)) 348 | (: handle-return (-> Return Any)) 349 | (define (handle-return r) 350 | (if is-initalizer? 351 | (env-get-at closure 0 "this") 352 | (return-value r))) 353 | (with-handlers ([return? handle-return]) 354 | (exec-block i body env) 355 | (if is-initalizer? 356 | (env-get-at closure 0 "this") ; return 'this' 357 | null))) ; implicitly return null 358 | 359 | (: call-class (-> Class Interpreter (Vectorof Any) Any)) 360 | (define (call-class c i args) 361 | (define instance (make-instance c)) 362 | (define initializer (class-find-method c "init")) 363 | (when initializer 364 | (call-function (bind initializer instance) i args)) 365 | instance) 366 | 367 | (: class-arity (-> Class Natural)) 368 | (define (class-arity c) 369 | (define initializer (class-find-method c "init")) 370 | (if initializer (callable-arity initializer) 0)) 371 | 372 | (struct native-function ([call : (-> NativeFunction Interpreter (Vectorof Any) Any)] [arity : Natural])) 373 | (define-type NativeFunction native-function) 374 | 375 | (: make-clock (-> NativeFunction)) 376 | (define (make-clock) 377 | (native-function (λ (callee i args) (current-seconds)) 0)) 378 | 379 | #| Helpers |# 380 | 381 | ; lox evaluates false and null literals to false 382 | (: truthy? (-> Any Boolean)) 383 | (define (truthy? v) 384 | (and v (not (null? v)))) 385 | 386 | (define lox-equal? equal?) 387 | 388 | ; raises error if operand is not number, then asserts the predicate. 389 | (define-syntax-rule (check-number-operand operator operand) 390 | (begin 391 | (unless (number? operand) 392 | (raise-runtime-error operator "Operand must be a number.")) 393 | (assert operand number?))) 394 | 395 | ; raises error if operands are not numbers, then asserts the predicates. 396 | (define-syntax-rule (check-number-operands operator left right) 397 | (begin 398 | (unless (and (real? left) (real? right)) 399 | (raise-runtime-error operator "Operands must be numbers.")) 400 | (assert left real?) 401 | (assert right real?))) 402 | 403 | (: value->string (-> Any String)) 404 | (define (value->string v) 405 | (cond 406 | [(equal? v #t) "true"] 407 | [(equal? v #f) "false"] 408 | [(null? v) "nil"] 409 | [(number? v) 410 | (define text (number->string v)) 411 | (if (string-suffix? text ".0") 412 | (substring text 0 (- (string-length text) 2)) 413 | text)] 414 | [(callable? v) (callable->string v)] 415 | [(instance? v) (instance->string v)] 416 | [else (~a v)])) 417 | -------------------------------------------------------------------------------- /src/lox/lib/parser.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (require racket/match) 4 | (require "../utils/while.rkt") 5 | (require "token.rkt") 6 | (require "expr.rkt") 7 | (require "error.rkt") 8 | (require "stmt.rkt") 9 | 10 | (provide make-parser parse!) 11 | 12 | (: parse! (-> Parser (Listof Stmt))) 13 | (define (parse! p) 14 | (let loop ([statements : (Listof Stmt) null]) 15 | (if (at-end? p) 16 | (reverse statements) 17 | (loop (cons (parse-declaration p) statements))))) 18 | 19 | (struct parser ([tokens : (Vectorof Token)] [current : Integer]) #:mutable) 20 | (define-type Parser parser) 21 | 22 | (: make-parser (-> (Vectorof Token) Parser)) 23 | (define (make-parser [tokens (vector)]) 24 | (parser tokens 0)) 25 | 26 | (: parser-next! (-> Parser Void)) 27 | (define (parser-next! p) 28 | (set-parser-current! p (add1 (parser-current p)))) 29 | 30 | #| Statement Parsing |# 31 | 32 | (: parse-declaration (-> Parser Stmt)) 33 | (define (parse-declaration p) 34 | ; synchronize after a parse error on a statement. 35 | (define (handle-parse-error e) (synchronize p) (empty-stmt)) 36 | (with-handlers ([exn:parse-error? handle-parse-error]) 37 | (cond 38 | [(matches? p CLASS) (parse-class-declaration p)] 39 | [(matches? p FUN) (parse-fun-declaration p "function")] 40 | [(matches? p VAR) (parse-var-declaration p)] 41 | [else (parse-statement p)]))) 42 | 43 | (: parse-class-declaration (-> Parser ClassDecl)) 44 | (define (parse-class-declaration p) 45 | (define name (consume! p IDENTIFIER "Expect class name.")) 46 | (define superclass 47 | (and (matches? p LESS) 48 | (variable (consume! p IDENTIFIER "Expect superclass name.")))) 49 | (consume! p LEFT_BRACE "Expect '{' before class body.") 50 | (define methods : (Listof FunDecl) null) 51 | (while (and (not (check? p RIGHT_BRACE)) (not (at-end? p))) 52 | (set! methods (cons (parse-fun-declaration p "method") methods))) 53 | (consume! p RIGHT_BRACE "Expect '}' after class body.") 54 | (class-decl name superclass (reverse methods))) 55 | 56 | (: parse-fun-declaration (-> Parser String FunDecl)) 57 | (define (parse-fun-declaration p kind) 58 | (define name (consume! p IDENTIFIER (format "Expect ~a name." kind))) 59 | (consume! p LEFT_PAREN (format "Expect '(' after ~a name." kind)) 60 | (define params (parse-parameters p)) 61 | (consume! p RIGHT_PAREN "Expect ')' after parameters.") 62 | (consume! p LEFT_BRACE (format "Expect '{' before ~a body." kind)) 63 | (define body (parse-block p)) 64 | (fun-decl name params body)) 65 | 66 | (: parse-parameters (-> Parser (Vectorof Token))) 67 | (define (parse-parameters p) 68 | (define params : (Listof Token) null) 69 | (define paramc : Natural 0) 70 | (define (add-param!) 71 | (define name (consume! p IDENTIFIER "Expect parameter name.")) 72 | (set! params (cons name params)) 73 | (set! paramc (add1 paramc))) 74 | (unless (check? p RIGHT_PAREN) 75 | (add-param!) 76 | (while (matches? p COMMA) 77 | (when (>= paramc 255) 78 | (lox-error (peek p) "Can't have more than 255 parameters.")) 79 | (add-param!))) 80 | (list->vector (reverse params))) 81 | 82 | (: parse-var-declaration (-> Parser VarDecl)) 83 | (define (parse-var-declaration p) 84 | (define name (consume! p IDENTIFIER "Expect variable name.")) 85 | (: initializer (Option Expr)) 86 | (define initializer #f) 87 | (when (matches? p EQUAL) 88 | (set! initializer (parse-expression p))) 89 | (consume! p SEMICOLON "Expect ';' after variable declaration.") 90 | (var-decl name initializer)) 91 | 92 | (: parse-statement (-> Parser Stmt)) 93 | (define (parse-statement p) 94 | (cond 95 | [(matches? p PRINT) (parse-print-statement p)] 96 | [(matches? p LEFT_BRACE) (parse-block-statement p)] 97 | [(matches? p IF) (parse-if-statement p)] 98 | [(matches? p WHILE) (parse-while-statement p)] 99 | [(matches? p FOR) (parse-for-statement p)] 100 | [(matches? p RETURN) (parse-return-statement p)] 101 | [else (parse-expression-statement p)])) 102 | 103 | (: parse-print-statement (-> Parser PrintStmt)) 104 | (define (parse-print-statement p) 105 | (define value (parse-expression p)) 106 | (consume! p SEMICOLON "Expect ';' after value.") 107 | (print-stmt value)) 108 | 109 | (: parse-block-statement (-> Parser BlockStmt)) 110 | (define (parse-block-statement p) 111 | (block-stmt (parse-block p))) 112 | 113 | (: parse-block (-> Parser (Listof Stmt))) 114 | (define (parse-block p) 115 | (: stmts (Listof Stmt)) 116 | (define stmts null) 117 | (while (and (not (check? p RIGHT_BRACE)) (not (at-end? p))) 118 | (set! stmts (cons (parse-declaration p) stmts))) 119 | (consume! p RIGHT_BRACE "Expect '}' after block.") 120 | (reverse stmts)) 121 | 122 | (: parse-if-statement (-> Parser IfStmt)) 123 | (define (parse-if-statement p) 124 | (consume! p LEFT_PAREN "Expect '(' after 'if'.") 125 | (define condition (parse-expression p)) 126 | (consume! p RIGHT_PAREN "Expect ')' after if condition.") 127 | (define consequent (parse-statement p)) 128 | (define alternate 129 | (and (matches? p ELSE) (parse-statement p))) 130 | (if-stmt condition consequent alternate)) 131 | 132 | (: parse-while-statement (-> Parser WhileStmt)) 133 | (define (parse-while-statement p) 134 | (consume! p LEFT_PAREN "Expect '(' after 'while'.") 135 | (define condition (parse-expression p)) 136 | (consume! p RIGHT_PAREN "Expect ')' after 'while' condition.") 137 | (define body (parse-statement p)) 138 | (while-stmt condition body)) 139 | 140 | (: parse-for-statement (-> Parser Stmt)) 141 | (define (parse-for-statement p) 142 | (consume! p LEFT_PAREN "Expect '(' after 'for'.") 143 | (define initializer 144 | (cond 145 | [(matches? p SEMICOLON) #f] 146 | [(matches? p VAR) (parse-var-declaration p)] 147 | [else (parse-expression-statement p)])) 148 | (define condition 149 | (if (check? p SEMICOLON) 150 | (literal #t) 151 | (parse-expression p))) 152 | (consume! p SEMICOLON "Expect ';' after loop condition.") 153 | (define increment 154 | (if (check? p RIGHT_PAREN) #f (parse-expression p))) 155 | (consume! p RIGHT_PAREN "Expect ')' after clauses.") 156 | (define body (parse-statement p)) 157 | (desugar-for initializer condition increment body)) 158 | 159 | (: desugar-for (-> (Option Stmt) Expr (Option Expr) Stmt Stmt)) 160 | (define (desugar-for initializer condition increment body) 161 | (when increment 162 | (set! body 163 | (block-stmt (list body (expression-stmt increment))))) 164 | (unless condition (set! condition (literal #t))) 165 | (set! body (while-stmt condition body)) 166 | (when initializer 167 | (set! body (block-stmt (list initializer body)))) 168 | body) 169 | 170 | (: parse-return-statement (-> Parser ReturnStmt)) 171 | (define (parse-return-statement p) 172 | (define keyword (previous p)) 173 | (define value 174 | (and (not (check? p SEMICOLON)) 175 | (parse-expression p))) 176 | (consume! p SEMICOLON "Expect ';' after return value.") 177 | (return-stmt keyword value)) 178 | 179 | (: parse-expression-statement (-> Parser ExpressionStmt)) 180 | (define (parse-expression-statement p) 181 | (define expr (parse-expression p)) 182 | (consume! p SEMICOLON "Expect ';' after expression.") 183 | (expression-stmt expr)) 184 | 185 | #| Expression Parsing |# 186 | 187 | (: parse-expression (-> Parser Expr)) 188 | (define (parse-expression p) 189 | (parse-assignment p)) 190 | 191 | ; parses right-assosiative assignment expression. 192 | ; report error if the left side of assignment is not a variable name. 193 | ; e.g: a = 2; // okay 194 | ; newPoint(x + 2, 0).y = 2; // okay 195 | ; a + b = 2; // not okay 196 | (: parse-assignment (-> Parser Expr)) 197 | (define (parse-assignment p) 198 | (define expr (parse-or p)) 199 | (cond 200 | [(matches? p EQUAL) 201 | (define equals (previous p)) 202 | (define value (parse-assignment p)) 203 | (match expr 204 | [(variable name) 205 | (assign name value)] 206 | [(get object name) 207 | (set-expr object name value)] 208 | [else 209 | (lox-error equals "Invalid assignment target.") 210 | expr])] 211 | [else expr])) 212 | 213 | (: parse-or (-> Parser Expr)) 214 | (define (parse-or p) 215 | (define token-matches (list OR)) 216 | (parse-left-assosiative-binary p parse-and token-matches)) 217 | 218 | (: parse-and (-> Parser Expr)) 219 | (define (parse-and p) 220 | (define token-matches (list AND)) 221 | (parse-left-assosiative-binary p parse-equality token-matches)) 222 | 223 | (: parse-equality (-> Parser Expr)) 224 | (define (parse-equality p) 225 | (define token-matches (list BANG_EQUAL EQUAL_EQUAL)) 226 | (parse-left-assosiative-binary p parse-comparison token-matches)) 227 | 228 | (: parse-comparison (-> Parser Expr)) 229 | (define (parse-comparison p) 230 | (define token-matches (list GREATER GREATER_EQUAL LESS LESS_EQUAL)) 231 | (parse-left-assosiative-binary p parse-term token-matches)) 232 | 233 | (: parse-term (-> Parser Expr)) 234 | (define (parse-term p) 235 | (define token-matches (list MINUS PLUS)) 236 | (parse-left-assosiative-binary p parse-factor token-matches)) 237 | 238 | (: parse-factor (-> Parser Expr)) 239 | (define (parse-factor p) 240 | (define token-matches (list SLASH STAR)) 241 | (parse-left-assosiative-binary p parse-unary token-matches)) 242 | 243 | (: parse-unary (-> Parser Expr)) 244 | (define (parse-unary p) 245 | (cond 246 | [(matches? p BANG MINUS) 247 | (define operator (previous p)) 248 | (define right (parse-unary p)) 249 | (unary operator right)] 250 | [else (parse-call p)])) 251 | 252 | (: parse-call (-> Parser Expr)) 253 | (define (parse-call p) 254 | (define expr (parse-primary p)) 255 | (let loop ([expr expr]) 256 | (cond 257 | [(matches? p LEFT_PAREN) 258 | (loop (finish-call p expr))] 259 | [(matches? p DOT) 260 | (define name (consume! p IDENTIFIER "Expect property name after '.'.")) 261 | (loop (get expr name))] 262 | [else expr]))) 263 | 264 | (: finish-call (-> Parser Expr Expr)) 265 | (define (finish-call p callee) 266 | (define args : (Listof Expr) null) 267 | (define argc : Natural 0) 268 | (define (add-arg!) 269 | (set! args (cons (parse-expression p) args)) 270 | (set! argc (add1 argc))) 271 | (unless (check? p RIGHT_PAREN) 272 | (add-arg!) 273 | (while (matches? p COMMA) 274 | (when (>= argc 255) 275 | (lox-error (peek p) "Can't have more than 255 arguments.")) 276 | (add-arg!))) 277 | (define paren (consume! p RIGHT_PAREN "Expect ')' after arguments.")) 278 | (call callee paren (reverse args))) 279 | 280 | (: parse-primary (-> Parser Expr)) 281 | (define (parse-primary p) 282 | (cond 283 | [(matches? p FALSE) 284 | (literal #f)] 285 | [(matches? p TRUE) 286 | (literal #t)] 287 | [(matches? p NIL) 288 | (literal null)] 289 | [(matches? p STRING) 290 | (literal (token-literal (previous p)))] 291 | [(matches? p NUMBER) 292 | (literal (exact->inexact (assert (token-literal (previous p)) number?)))] 293 | [(matches? p IDENTIFIER) 294 | (variable (previous p))] 295 | [(matches? p SUPER) 296 | (define keyword (previous p)) 297 | (consume! p DOT "Expect '.' after 'super'.") 298 | (define method (consume! p IDENTIFIER "Expect superclass method name.")) 299 | (super-expr keyword method)] 300 | [(matches? p THIS) 301 | (this-expr (previous p))] 302 | [(matches? p LEFT_PAREN) 303 | (define expr (parse-expression p)) ; parse the following expression 304 | (consume! p RIGHT_PAREN "Expect ')' after expression.") 305 | (grouping expr)] 306 | [else 307 | (raise-parse-error (peek p) "Expect expression.") 308 | (empty-expr)])) 309 | 310 | ; (parse-left-assosiative-binary parser (parser -> token) (listof Token-type)) -> token 311 | ; First parse the left side, which can be any expression of higher precedence. 312 | ; Then recursively parse the right side while the desire tokens match, setting 313 | ; the final expression to the binary result of the two sides. 314 | (: parse-left-assosiative-binary (-> Parser (-> Parser Expr) (Listof Symbol) Expr)) 315 | (define (parse-left-assosiative-binary p token-parser token-matches) 316 | (define expr (token-parser p)) 317 | (while (apply matches? p token-matches) 318 | (define operator (previous p)) 319 | (define right (token-parser p)) 320 | (set! expr (binary expr operator right))) 321 | expr) 322 | 323 | #| Helpers |# 324 | 325 | (: matches? (-> Parser Symbol * (Option Token))) 326 | (define (matches? p . types) 327 | (for/or ([type types]) 328 | (if (check? p type) 329 | (advance! p) 330 | #f))) 331 | 332 | (: consume! (-> Parser Symbol String Token)) 333 | (define (consume! p type message) 334 | (unless (check? p type) 335 | (raise-parse-error (peek p) message)) 336 | (advance! p)) 337 | 338 | (: check? (-> Parser Symbol Boolean)) 339 | (define (check? p type) 340 | (and (not (at-end? p)) 341 | (equal? (token-type (peek p)) type))) 342 | 343 | (: advance! (-> Parser Token)) 344 | (define (advance! p) 345 | (unless (at-end? p) (parser-next! p)) 346 | (previous p)) 347 | 348 | (: at-end? (-> Parser Boolean)) 349 | (define (at-end? p) 350 | (equal? (token-type (peek p)) EOF)) 351 | 352 | (: peek (-> Parser Token)) 353 | (define (peek p) 354 | (vector-ref (parser-tokens p) (parser-current p))) 355 | 356 | (: previous (-> Parser Token)) 357 | (define (previous p) 358 | (vector-ref (parser-tokens p) (sub1 (parser-current p)))) 359 | 360 | ; (synchronize parser) -> void 361 | ; Discard tokens until we're at the beginning of the next statement. 362 | ; After a semicolon, we are probably finished with a statement. 363 | ; When the next token is a keyword, we are probably beginning a statement. 364 | (: synchronize (-> Parser Void)) 365 | (define (synchronize p) 366 | (advance! p) 367 | (define keywords (list CLASS FUN VAR FOR IF WHILE PRINT RETURN)) 368 | (until (or (at-end? p) 369 | (equal? (token-type (previous p)) SEMICOLON) 370 | (member (token-type (peek p)) keywords)) 371 | (advance! p))) -------------------------------------------------------------------------------- /src/lox/lib/pretty-print.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/match) 4 | (require racket/format) 5 | (require "expr.rkt") 6 | (require "token.rkt") 7 | 8 | (provide expr->string) 9 | 10 | (define (expr->string expr) 11 | (match expr 12 | [(struct binary (left op right)) 13 | (parenthesize (token-lexeme op) left right)] 14 | [(struct grouping (expression)) 15 | (parenthesize "group" expression)] 16 | [(struct literal (value)) 17 | (~a value)] 18 | [(struct unary (op right)) 19 | (parenthesize (token-lexeme op) right)])) 20 | 21 | (define (parenthesize name . exprs) 22 | (define printed-exprs 23 | (foldl (λ (x z) (string-append z " " (expr->string x))) "" exprs)) 24 | (string-append "(" name printed-exprs ")")) 25 | 26 | (define (test) 27 | (define expression 28 | (binary (unary (make-token MINUS "-" 1) 29 | (literal 123)) 30 | (make-token STAR "*" 1) 31 | (grouping (literal 45.67)))) 32 | (displayln (expr->string expression))) -------------------------------------------------------------------------------- /src/lox/lib/resolver.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (require racket/match) 4 | (require "../utils/stack.rkt") 5 | (require "error.rkt") 6 | (require "interpreter.rkt") 7 | (require "stmt.rkt") 8 | (require "expr.rkt") 9 | (require "token.rkt") 10 | 11 | (provide resolve-all! make-resolver) 12 | 13 | (define-type Resolver resolver) 14 | (struct resolver ([interpreter : Interpreter] 15 | [scopes : (Stackof (HashTable String Boolean))] 16 | [current-function : FunctionType] 17 | [current-class : ClassType]) 18 | #:mutable) 19 | 20 | #| Function Type |# 21 | (struct none ()) 22 | (struct function ()) 23 | (struct initializer ()) 24 | (struct method ()) 25 | (define-type FunctionType (U none function initializer method)) 26 | 27 | #| ClassType |# 28 | (struct class ()) 29 | (struct subclass ()) 30 | (define-type ClassType (U none class subclass)) 31 | 32 | (: make-resolver (-> Interpreter Resolver)) 33 | (define (make-resolver i) 34 | (resolver i (make-stack) (none) (none))) 35 | 36 | (: resolve-all! (-> Resolver (Listof Stmt) Void)) 37 | (define (resolve-all! r stmts) 38 | (for ([stmt stmts]) 39 | (resolve! r stmt))) 40 | 41 | (: resolve! (-> Resolver (U Stmt Expr) Void)) 42 | (define (resolve! r val) 43 | (cond 44 | [(block-stmt? val) (resolve-block-stmt! r val)] 45 | [(var-decl? val) (resolve-var-decl! r val)] 46 | [(fun-decl? val) (resolve-fun-decl! r val)] 47 | [(class-decl? val) (resolve-class-decl! r val)] 48 | [(variable? val) (resolve-var-expr! r val)] 49 | [(assign? val) (resolve-assign-expr! r val)] 50 | [(expression-stmt? val) (resolve-expr-stmt! r val)] 51 | [(if-stmt? val) (resolve-if-stmt! r val)] 52 | [(print-stmt? val) (resolve-print-stmt! r val)] 53 | [(return-stmt? val) (resolve-return-stmt! r val)] 54 | [(while-stmt? val) (resolve-while-stmt! r val)] 55 | [(binary? val) (resolve-binary-expr! r val)] 56 | [(unary? val) (resolve-unary-expr! r val)] 57 | [(call? val) (resolve-call-expr! r val)] 58 | [(get? val) (resolve-get-expr! r val)] 59 | [(set-expr? val) (resolve-set-expr! r val)] 60 | [(super-expr? val) (resolve-super-expr! r val)] 61 | [(this-expr? val) (resolve-this-expr! r val)] 62 | [(grouping? val) (resolve-grouping-expr! r val)] 63 | [(literal? val) (resolve-literal-expr!)])) 64 | 65 | (: resolve-block-stmt! (-> Resolver BlockStmt Void)) 66 | (define (resolve-block-stmt! r stmt) 67 | (with-scope r 68 | (resolve-all! r (block-stmt-statements stmt)))) 69 | 70 | (: resolve-var-decl! (-> Resolver VarDecl Void)) 71 | (define (resolve-var-decl! r stmt) 72 | (match-define (var-decl name initializer) stmt) 73 | (declare! r name) 74 | (when initializer (resolve! r initializer)) 75 | (define! r name)) 76 | 77 | (: resolve-fun-decl! (-> Resolver FunDecl Void)) 78 | (define (resolve-fun-decl! r stmt) 79 | (define name (fun-decl-name stmt)) 80 | (declare! r name) 81 | (define! r name) ; define the function name before resolving the body 82 | (resolve-function! r stmt (function))) 83 | 84 | (: resolve-function! (-> Resolver FunDecl FunctionType Void)) 85 | (define (resolve-function! r function type) 86 | (define enclosing-function (resolver-current-function r)) 87 | (set-resolver-current-function! r type) 88 | (with-scope r 89 | (for ([param (fun-decl-params function)]) 90 | (declare! r param) 91 | (define! r param)) 92 | (resolve-all! r (fun-decl-body function))) 93 | (set-resolver-current-function! r enclosing-function)) 94 | 95 | (: resolve-class-decl! (-> Resolver ClassDecl Void)) 96 | (define (resolve-class-decl! r stmt) 97 | (match-define (class-decl name superclass methods) stmt) 98 | (define enclosing-class (resolver-current-class r)) 99 | (set-resolver-current-class! r (class)) 100 | (declare! r name) 101 | (define! r name) 102 | (when superclass 103 | (set-resolver-current-class! r (subclass)) 104 | (if (equal? (token-lexeme (variable-name superclass)) 105 | (token-lexeme (class-decl-name stmt))) 106 | (lox-error (variable-name superclass) "A class can't inherit from itself.") 107 | (resolve! r superclass)) 108 | (begin-scope! r) 109 | (hash-set! (stack-top (resolver-scopes r)) "super" #t)) 110 | (with-scope r 111 | ; resolve "this" to a local variable within class body. 112 | (hash-set! (stack-top (resolver-scopes r)) "this" #t) 113 | (for ([m methods]) 114 | (define declaration 115 | (if (equal? "init" (token-lexeme (fun-decl-name m))) 116 | (initializer) 117 | (method))) 118 | (resolve-function! r m declaration))) 119 | (when superclass (end-scope! r)) 120 | (set-resolver-current-class! r enclosing-class)) 121 | 122 | (: resolve-var-expr! (-> Resolver VariableExpr Void)) 123 | (define (resolve-var-expr! r expr) 124 | (define scopes (resolver-scopes r)) 125 | (define name (variable-name expr)) 126 | (when (and (not (stack-empty? scopes)) 127 | (hash-has-key? (stack-top scopes) (token-lexeme name)) 128 | (not (hash-ref (stack-top scopes) (token-lexeme name)))) ; variable has been declared but not defined 129 | (lox-error name "Can't read local variable in its own initializer.")) 130 | (resolve-local! r expr name)) 131 | 132 | (: resolve-assign-expr! (-> Resolver AssignExpr Void)) 133 | (define (resolve-assign-expr! r expr) 134 | (match-define (assign name value) expr) 135 | (resolve! r value) 136 | (resolve-local! r expr name)) 137 | 138 | (: resolve-expr-stmt! (-> Resolver ExpressionStmt Void)) 139 | (define (resolve-expr-stmt! r stmt) 140 | (resolve! r (expression-stmt-expr stmt))) 141 | 142 | (: resolve-if-stmt! (-> Resolver IfStmt Void)) 143 | (define (resolve-if-stmt! r stmt) 144 | (match-define (if-stmt condition consequent alternate) stmt) 145 | (resolve! r condition) 146 | (resolve! r consequent) 147 | (when alternate (resolve! r alternate))) 148 | 149 | (: resolve-print-stmt! (-> Resolver PrintStmt Void)) 150 | (define (resolve-print-stmt! r stmt) 151 | (resolve! r (print-stmt-value stmt))) 152 | 153 | (: resolve-return-stmt! (-> Resolver ReturnStmt Void)) 154 | (define (resolve-return-stmt! r stmt) 155 | (define current-function (resolver-current-function r)) 156 | (when (none? current-function) 157 | (lox-error (return-stmt-keyword stmt) "Can't return from top-level code.")) 158 | (define value (return-stmt-value stmt)) 159 | (when value 160 | (if (initializer? current-function) 161 | (lox-error (return-stmt-keyword stmt) "Can't return a value from an initializer.") 162 | (resolve! r value)))) 163 | 164 | (: resolve-while-stmt! (-> Resolver WhileStmt Void)) 165 | (define (resolve-while-stmt! r stmt) 166 | (match-define (while-stmt condition body) stmt) 167 | (resolve! r condition) 168 | (resolve! r body)) 169 | 170 | (: resolve-binary-expr! (-> Resolver BinaryExpr Void)) 171 | (define (resolve-binary-expr! r expr) 172 | (match-define (binary left _ right) expr) 173 | (resolve! r left) 174 | (resolve! r right)) 175 | 176 | (: resolve-call-expr! (-> Resolver CallExpr Void)) 177 | (define (resolve-call-expr! r expr) 178 | (match-define (call callee _ args) expr) 179 | (resolve! r callee) 180 | (for ([arg args]) 181 | (resolve! r arg))) 182 | 183 | (: resolve-get-expr! (-> Resolver GetExpr Void)) 184 | (define (resolve-get-expr! r expr) 185 | (resolve! r (get-object expr))) 186 | 187 | (: resolve-set-expr! (-> Resolver SetExpr Void)) 188 | (define (resolve-set-expr! r expr) 189 | (resolve! r (set-expr-value expr)) 190 | (resolve! r (set-expr-object expr))) 191 | 192 | (: resolve-super-expr! (-> Resolver SuperExpr Void)) 193 | (define (resolve-super-expr! r expr) 194 | (define keyword (super-expr-keyword expr)) 195 | (match (resolver-current-class r) 196 | [(none) 197 | (lox-error keyword "Can't use 'super' outside of a class.")] 198 | [(class) 199 | (lox-error keyword "Can't use 'super' in a class with no superclass.")] 200 | [else 201 | (resolve-local! r expr keyword)])) 202 | 203 | (: resolve-this-expr! (-> Resolver ThisExpr Void)) 204 | (define (resolve-this-expr! r expr) 205 | (define keyword (this-expr-keyword expr)) 206 | (if (none? (resolver-current-class r)) 207 | (lox-error keyword "Can't use 'this' outside of a class.") 208 | (resolve-local! r expr keyword))) 209 | 210 | (: resolve-grouping-expr! (-> Resolver GroupingExpr Void)) 211 | (define (resolve-grouping-expr! r expr) 212 | (resolve! r (grouping-expression expr))) 213 | 214 | (: resolve-unary-expr! (-> Resolver UnaryExpr Void)) 215 | (define (resolve-unary-expr! r expr) 216 | (resolve! r (unary-right expr))) 217 | 218 | (define (resolve-literal-expr!) (void)) 219 | 220 | (: begin-scope! (-> Resolver Void)) 221 | (define (begin-scope! r) 222 | (define scopes (resolver-scopes r)) 223 | (define scope : (HashTable String Boolean) (make-hash)) 224 | (stack-push! scopes scope)) 225 | 226 | (: end-scope! (-> Resolver Void)) 227 | (define (end-scope! r) 228 | (define scopes (resolver-scopes r)) 229 | (void (stack-pop! scopes))) 230 | 231 | (define-syntax-rule (with-scope r body ...) 232 | (begin 233 | (begin-scope! r) 234 | body ... 235 | (end-scope! r))) 236 | 237 | (: declare! (-> Resolver Token Void)) 238 | (define (declare! r name) 239 | (define scopes (resolver-scopes r)) 240 | (unless (stack-empty? scopes) 241 | (define scope (stack-top scopes)) 242 | (if (hash-has-key? scope (token-lexeme name)) 243 | (lox-error name "Already a variable with this name in this scope.") 244 | (hash-set! scope (token-lexeme name) #f)))) 245 | 246 | (: define! (-> Resolver Token Void)) 247 | (define (define! r name) 248 | (define scopes (resolver-scopes r)) 249 | (unless (stack-empty? scopes) 250 | (hash-set! (stack-top scopes) (token-lexeme name) #t))) 251 | 252 | (: resolve-local! (-> Resolver Expr Token Void)) 253 | (define (resolve-local! r expr name) 254 | (define interpreter (resolver-interpreter r)) 255 | (match-define (stack data size) (resolver-scopes r)) 256 | (for/or ([scope data] 257 | [i (in-naturals)] 258 | #:when (hash-has-key? scope (token-lexeme name))) 259 | (interpreter-resolve! interpreter expr i)) 260 | (void)) 261 | -------------------------------------------------------------------------------- /src/lox/lib/scanner.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (provide make-scanner scan-tokens!) 4 | 5 | (require racket/match) 6 | (require racket/function) 7 | (require "../utils/while.rkt") 8 | (require "token.rkt") 9 | (require "error.rkt") 10 | 11 | (struct scanner ([source : String] 12 | [tokens : (Listof Token)] 13 | [start : Integer] 14 | [current : Integer] 15 | [line : Integer]) 16 | #:mutable) 17 | 18 | (define-type (Scanner) scanner) 19 | 20 | (: make-scanner (->* () (String (Listof Token) Integer Integer Integer) scanner)) 21 | (define (make-scanner [source ""] [tokens '()] [start 0] [current 0] [line 1]) 22 | (scanner source tokens start current line)) 23 | 24 | (: scanner-current-char (-> Scanner Char)) 25 | (define (scanner-current-char s) 26 | (string-ref (scanner-source s) (scanner-current s))) 27 | 28 | (: scanner-next! (-> Scanner Void)) 29 | (define (scanner-next! s) 30 | (set-scanner-current! s (add1 (scanner-current s)))) 31 | 32 | (: scanner-next-line! (-> Scanner Void)) 33 | (define (scanner-next-line! s) 34 | (set-scanner-line! s (add1 (scanner-line s)))) 35 | 36 | (: scanner-substring (->* (Scanner) (Integer Integer) String)) 37 | (define (scanner-substring s [start (scanner-start s)] [end (scanner-current s)]) 38 | (substring (scanner-source s) start end)) 39 | 40 | (: scan-tokens! (-> Scanner (Vectorof Token))) 41 | (define (scan-tokens! s) 42 | (until (at-end? s) 43 | (set-scanner-start! s (scanner-current s)) ; set start of the current scan to the current pos 44 | (scan-token! s)) ; scan from current pos 45 | (define eof-token (make-token EOF "" (scanner-line s))) 46 | (set-scanner-tokens! s (cons eof-token (scanner-tokens s))) 47 | (list->vector (reverse (scanner-tokens s)))) 48 | 49 | (: scan-token! (-> Scanner Void)) 50 | (define (scan-token! s) 51 | (match (advance! s) 52 | [#\( (add-token! s LEFT_PAREN)] 53 | [#\) (add-token! s RIGHT_PAREN)] 54 | [#\{ (add-token! s LEFT_BRACE)] 55 | [#\} (add-token! s RIGHT_BRACE)] 56 | [#\, (add-token! s COMMA)] 57 | [#\. (add-token! s DOT)] 58 | [#\- (add-token! s MINUS)] 59 | [#\+ (add-token! s PLUS)] 60 | [#\; (add-token! s SEMICOLON)] 61 | [#\* (add-token! s STAR)] 62 | [#\! (add-token! s (if (matches? s #\=) BANG_EQUAL BANG))] 63 | [#\= (add-token! s (if (matches? s #\=) EQUAL_EQUAL EQUAL))] 64 | [#\< (add-token! s (if (matches? s #\=) LESS_EQUAL LESS))] 65 | [#\> (add-token! s (if (matches? s #\=) GREATER_EQUAL GREATER))] 66 | [#\/ (if (matches? s #\/) 67 | (while (and (not (next-is? s #\newline)) (not (at-end? s))) 68 | (advance! s)) ; ignore comments to the end of a line 69 | (add-token! s SLASH))] 70 | [#\newline (scanner-next-line! s)] ; increment line number 71 | [(? char-blank?) (void)] ; ignore whitespace 72 | [#\" (scan-string! s)] ; string literals 73 | [(? char-numeric?) (scan-number! s)] ; number literals 74 | [(? char-identifier-start?) (scan-identifier! s)] ; identifiers 75 | [_ (report-error (scanner-line s) "" "Unexpected character.")])) 76 | 77 | (: at-end? (-> Scanner Boolean)) 78 | (define (at-end? s) 79 | (>= (scanner-current s) 80 | (string-length (scanner-source s)))) 81 | 82 | (: advance! (-> Scanner Char)) 83 | (define (advance! s) 84 | (define current (scanner-current-char s)) 85 | (scanner-next! s) 86 | current) 87 | 88 | (: peek (-> Scanner Char)) 89 | (define (peek s) 90 | (if (at-end? s) 91 | #\nul 92 | (scanner-current-char s))) 93 | 94 | (: peek-next (-> Scanner Char)) 95 | (define (peek-next s) 96 | (define next-pos (add1 (scanner-current s))) 97 | (if (>= next-pos (string-length (scanner-source s))) 98 | #\nul 99 | (string-ref (scanner-source s) next-pos))) 100 | 101 | (: next-is? (-> Scanner Char Boolean)) 102 | (define (next-is? s ch) 103 | (char=? (peek s) ch)) 104 | 105 | (: matches? (-> Scanner Char Boolean)) 106 | (define (matches? s expected) 107 | (and (not (at-end? s)) 108 | (char=? (scanner-current-char s) expected) 109 | (scanner-next! s) 110 | #t)) 111 | 112 | (: add-token! (->* (Scanner Symbol) (Lox-Literal) Void)) 113 | (define (add-token! s type [literal null]) 114 | (define text (scanner-substring s)) 115 | (define new-token (make-token type text (scanner-line s) literal)) 116 | (set-scanner-tokens! s (cons new-token (scanner-tokens s)))) 117 | 118 | (: scan-string! (-> Scanner Void)) 119 | (define (scan-string! s) 120 | (while (and (not (next-is? s #\")) (not (at-end? s))) 121 | (when (next-is? s #\newline) 122 | (scanner-next-line! s)) 123 | (advance! s)) 124 | (cond 125 | [(at-end? s) 126 | (report-error (scanner-line s) "" "Unterminated string.")] 127 | [else 128 | (advance! s) ; consume the closing " 129 | ; trim the surrounding quotes, add token 130 | (define value (scanner-substring s (add1 (scanner-start s)) (sub1 (scanner-current s)))) 131 | (add-token! s STRING value)])) 132 | 133 | (: scan-number! (-> Scanner Void)) 134 | (define (scan-number! s) 135 | (while (char-numeric? (peek s)) (advance! s)) 136 | ; look for fractional part 137 | (when (and (next-is? s #\.) (char-numeric? (peek-next s))) 138 | (advance! s) ; consume the "." 139 | (while (char-numeric? (peek s)) (advance! s))) 140 | (define text (assert (scanner-substring s) string?)) 141 | (add-token! s NUMBER (string->number text))) 142 | 143 | (: char-identifier-start? (-> Char Boolean)) 144 | (define (char-identifier-start? ch) 145 | (or (char-alphabetic? ch) (char=? ch #\_))) 146 | 147 | (: char-alphanumeric? (-> Char Boolean)) 148 | (define (char-alphanumeric? ch) 149 | (or (char-identifier-start? ch) (char-numeric? ch))) 150 | 151 | (: scan-identifier! (-> Scanner Void)) 152 | (define (scan-identifier! s) 153 | (while (char-alphanumeric? (peek s)) 154 | (advance! s)) 155 | (define text (scanner-substring s)) 156 | (define keyword-type (hash-ref keywords text #f)) 157 | (if keyword-type 158 | (add-token! s keyword-type) 159 | (add-token! s IDENTIFIER))) -------------------------------------------------------------------------------- /src/lox/lib/stmt.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (require "expr.rkt") 4 | (require "token.rkt") 5 | (provide (all-defined-out)) 6 | 7 | (define-type Stmt 8 | (U PrintStmt ExpressionStmt VarDecl FunDecl ClassDecl 9 | BlockStmt IfStmt WhileStmt ReturnStmt EmptyStmt)) 10 | 11 | (struct print-stmt ([value : Expr])) 12 | (define-type PrintStmt print-stmt) 13 | 14 | (struct expression-stmt ([expr : Expr])) 15 | (define-type ExpressionStmt expression-stmt) 16 | 17 | (struct var-decl ([name : Token] [initializer : (Option Expr)])) 18 | (define-type VarDecl var-decl) 19 | 20 | (struct fun-decl ([name : Token] [params : (Vectorof Token)] [body : (Listof Stmt)])) 21 | (define-type FunDecl fun-decl) 22 | 23 | (struct class-decl ([name : Token] [superclass : (Option VariableExpr)] [methods : (Listof FunDecl)])) 24 | (define-type ClassDecl class-decl) 25 | 26 | (struct block-stmt ([statements : (Listof Stmt)])) 27 | (define-type BlockStmt block-stmt) 28 | 29 | (struct if-stmt ([condition : Expr] 30 | [consequent : Stmt] 31 | [alternate : (Option Stmt)])) 32 | (define-type IfStmt if-stmt) 33 | 34 | (struct while-stmt ([condition : Expr] [body : Stmt])) 35 | (define-type WhileStmt while-stmt) 36 | 37 | (struct return-stmt ([keyword : Token] [value : (Option Expr)])) 38 | (define-type ReturnStmt return-stmt) 39 | 40 | ; empty statement created after an error is found. 41 | (struct empty-stmt ()) 42 | (define-type EmptyStmt empty-stmt) -------------------------------------------------------------------------------- /src/lox/lib/token.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (provide (struct-out token) (all-defined-out)) 4 | 5 | (define-type Lox-Literal (U String Number Boolean Null)) 6 | 7 | (struct token ([type : Symbol] 8 | [lexeme : String] 9 | [literal : Lox-Literal] 10 | [line : Integer]) 11 | #:mutable) 12 | 13 | (define-type Token token) 14 | 15 | (: make-token (->* (Symbol String Integer) (Lox-Literal) Token)) 16 | (define (make-token type lexeme line [literal null]) 17 | (token type lexeme literal line)) 18 | 19 | (: keywords (HashTable String Symbol)) 20 | (define keywords 21 | (hash 22 | "and" 'AND 23 | "class" 'CLASS 24 | "else" 'ELSE 25 | "false" 'FALSE 26 | "for" 'FOR 27 | "fun" 'FUN 28 | "if" 'IF 29 | "nil" 'NIL 30 | "or" 'OR 31 | "print" 'PRINT 32 | "return" 'RETURN 33 | "super" 'SUPER 34 | "this" 'THIS 35 | "true" 'TRUE 36 | "var" 'VAR 37 | "while" 'WHILE)) 38 | 39 | (define LEFT_PAREN 'LEFT_PAREN) 40 | (define RIGHT_PAREN 'RIGHT_PAREN) 41 | (define LEFT_BRACE 'LEFT_BRACE) 42 | (define RIGHT_BRACE 'RIGHT_BRACE) 43 | (define COMMA 'COMMA) 44 | (define DOT 'DOT) 45 | (define MINUS 'MINUS) 46 | (define PLUS 'PLUS) 47 | (define SEMICOLON 'SEMICOLON) 48 | (define SLASH 'SLASH) 49 | (define STAR 'STAR) 50 | (define BANG 'BANG) 51 | (define BANG_EQUAL 'BANG_EQUAL) 52 | (define EQUAL 'EQUAL) 53 | (define EQUAL_EQUAL 'EQUAL_EQUAL) 54 | (define GREATER 'GREATER) 55 | (define GREATER_EQUAL 'GREATER_EQUAL) 56 | (define LESS 'LESS) 57 | (define LESS_EQUAL 'LESS_EQUAL) 58 | (define IDENTIFIER 'IDENTIFIER) 59 | (define STRING 'STRING) 60 | (define NUMBER 'NUMBER) 61 | (define AND 'AND) 62 | (define CLASS 'CLASS) 63 | (define ELSE 'ELSE) 64 | (define FALSE 'FALSE) 65 | (define FUN 'FUN) 66 | (define FOR 'FOR) 67 | (define IF 'IF) 68 | (define NIL 'NIL) 69 | (define OR 'OR) 70 | (define PRINT 'PRINT) 71 | (define RETURN 'RETURN) 72 | (define SUPER 'SUPER) 73 | (define THIS 'THIS) 74 | (define TRUE 'TRUE) 75 | (define VAR 'VAR) 76 | (define WHILE 'WHILE) 77 | (define EOF 'EOF) 78 | -------------------------------------------------------------------------------- /src/lox/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (module reader typed/racket/base 4 | (require "reader.rkt") 5 | (provide read-syntax)) -------------------------------------------------------------------------------- /src/lox/reader.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/port) 4 | (require "lib/parser.rkt") 5 | (require "lib/scanner.rkt") 6 | 7 | (define (read-syntax _ port) 8 | (define source (port->string port)) 9 | (define scanner (make-scanner source)) 10 | (define tokens (scan-tokens! scanner)) 11 | (define parser (make-parser tokens)) 12 | (define statements (parse! parser)) 13 | (define module-datum `(module lox-mod lox/expander 14 | ,@statements)) 15 | (datum->syntax #f module-datum)) 16 | 17 | (provide read-syntax) -------------------------------------------------------------------------------- /src/lox/utils/stack.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (provide (all-defined-out)) 4 | 5 | (define-type Stackof stack) 6 | (struct (A) stack ([data : (Listof A)] [size : Integer]) #:mutable) 7 | 8 | (: make-stack (All (A) (-> A * (Stackof A)))) 9 | (define (make-stack . vals) 10 | (stack vals (length vals))) 11 | 12 | (: stack-push! (All (A) (-> (Stackof A) A Void))) 13 | (define (stack-push! s x) 14 | (set-stack-data! s (cons x (stack-data s))) 15 | (set-stack-size! s (add1 (stack-size s)))) 16 | 17 | (: stack-pop! (All (A) (-> (Stackof A) A))) 18 | (define (stack-pop! s) 19 | (define top (stack-top s)) 20 | (set-stack-data! s (cdr (stack-data s))) 21 | (set-stack-size! s (sub1 (stack-size s))) 22 | top) 23 | 24 | (: stack-top (All (A) (-> (Stackof A) A))) 25 | (define (stack-top s) 26 | (car (stack-data s))) 27 | 28 | (: stack-empty? (All (A) (-> (Stackof A) Boolean))) 29 | (define (stack-empty? s) 30 | (define data (stack-data s)) 31 | (and (list? data) (null? data))) -------------------------------------------------------------------------------- /src/lox/utils/while.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (provide (all-defined-out)) 4 | 5 | (define-syntax-rule (while pred? body ...) 6 | (let loop : Void () 7 | (when pred? 8 | body ... 9 | (loop)))) 10 | 11 | (define-syntax-rule (until pred? body ...) 12 | (let loop : Void () 13 | (unless pred? 14 | body ... 15 | (loop)))) -------------------------------------------------------------------------------- /src/main.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (require racket/match) 4 | (require racket/file) 5 | (require "lox/lib/parser.rkt") 6 | (require "lox/lib/scanner.rkt") 7 | (require "lox/lib/interpreter.rkt") 8 | (require "lox/lib/resolver.rkt") 9 | (require "lox/lib/error.rkt") 10 | (require "lox/lib/stmt.rkt") 11 | (require "lox/lib/pretty-print.rkt") 12 | 13 | (: main (-> Void)) 14 | (define (main) 15 | (define args (current-command-line-arguments)) 16 | (match args 17 | [(vector) (run-prompt)] 18 | [(vector f) (run-file f)] 19 | [_ (println "Usage: racket-lox [script]")])) 20 | 21 | (: run-prompt (-> Void)) 22 | (define (run-prompt) 23 | (let loop () 24 | (display "> ") 25 | (define line (read-line)) 26 | (unless (eof-object? line) 27 | (run line) 28 | (set-had-error! #f) 29 | (loop)))) 30 | 31 | (: run-file (-> Path-String Void)) 32 | (define (run-file filename) 33 | (define source (file->string filename)) 34 | (run source) 35 | (when had-error (exit 65)) 36 | (when had-runtime-error (exit 70))) 37 | 38 | (: run (-> String Void)) 39 | (define (run source) 40 | (define scanner (make-scanner source)) 41 | (define tokens (scan-tokens! scanner)) 42 | (define parser (make-parser tokens)) 43 | (define statements (parse! parser)) 44 | (unless had-error 45 | (define interpreter (make-interpreter)) 46 | (define resolver (make-resolver interpreter)) 47 | (resolve-all! resolver statements) 48 | (unless had-error 49 | (interpret! interpreter statements)))) 50 | 51 | (main) --------------------------------------------------------------------------------