mirror of
https://github.com/kanaka/mal.git
synced 2024-09-17 16:47:22 +03:00
8a19f60386
- Reorder README to have implementation list after "learning tool" bullet. - This also moves tests/ and libs/ into impls. It would be preferrable to have these directories at the top level. However, this causes difficulties with the wasm implementations which need pre-open directories and have trouble with paths starting with "../../". So in lieu of that, symlink those directories to the top-level. - Move the run_argv_test.sh script into the tests directory for general hygiene.
84 lines
2.9 KiB
Scheme
84 lines
2.9 KiB
Scheme
(import (scheme base))
|
|
(import (scheme write))
|
|
|
|
(import (lib util))
|
|
(import (lib reader))
|
|
(import (lib printer))
|
|
(import (lib types))
|
|
(import (lib env))
|
|
|
|
(define (READ input)
|
|
(read-str input))
|
|
|
|
(define (eval-ast ast env)
|
|
(let ((type (and (mal-object? ast) (mal-type ast)))
|
|
(value (and (mal-object? ast) (mal-value ast))))
|
|
(case type
|
|
((symbol) (env-get env value))
|
|
((list) (mal-list (map (lambda (item) (EVAL item env)) value)))
|
|
((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) value)))
|
|
((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) value)))
|
|
(else ast))))
|
|
|
|
(define (EVAL ast env)
|
|
(let ((type (and (mal-object? ast) (mal-type ast))))
|
|
(if (not (eq? type 'list))
|
|
(eval-ast ast env)
|
|
(let ((items (mal-value ast)))
|
|
(if (null? items)
|
|
ast
|
|
(case (mal-value (car items))
|
|
((def!)
|
|
(let ((symbol (mal-value (cadr items)))
|
|
(value (EVAL (list-ref items 2) env)))
|
|
(env-set env symbol value)
|
|
value))
|
|
((let*)
|
|
(let* ((env* (make-env env))
|
|
(binds (mal-value (cadr items)))
|
|
(binds (if (vector? binds) (vector->list binds) binds))
|
|
(form (list-ref items 2)))
|
|
(let loop ((binds binds))
|
|
(when (pair? binds)
|
|
(let ((key (mal-value (car binds))))
|
|
(when (null? (cdr binds))
|
|
(error "unbalanced list"))
|
|
(let ((value (EVAL (cadr binds) env*)))
|
|
(env-set env* key value)
|
|
(loop (cddr binds))))))
|
|
(EVAL form env*)))
|
|
(else
|
|
(let* ((items (mal-value (eval-ast ast env)))
|
|
(op (car items))
|
|
(ops (cdr items)))
|
|
(apply op ops)))))))))
|
|
|
|
(define (PRINT ast)
|
|
(pr-str ast #t))
|
|
|
|
(define repl-env (make-env #f))
|
|
(env-set repl-env '+ (lambda (a b) (mal-number (+ (mal-value a) (mal-value b)))))
|
|
(env-set repl-env '- (lambda (a b) (mal-number (- (mal-value a) (mal-value b)))))
|
|
(env-set repl-env '* (lambda (a b) (mal-number (* (mal-value a) (mal-value b)))))
|
|
(env-set repl-env '/ (lambda (a b) (mal-number (/ (mal-value a) (mal-value b)))))
|
|
|
|
(define (rep input)
|
|
(PRINT (EVAL (READ input) repl-env)))
|
|
|
|
(define (main)
|
|
(let loop ()
|
|
(let ((input (readline "user> ")))
|
|
(when input
|
|
(guard
|
|
(ex ((error-object? ex)
|
|
(when (not (memv 'empty-input (error-object-irritants ex)))
|
|
(display "[error] ")
|
|
(display (error-object-message ex))
|
|
(newline))))
|
|
(display (rep input))
|
|
(newline))
|
|
(loop))))
|
|
(newline))
|
|
|
|
(main)
|