mirror of
https://github.com/kanaka/mal.git
synced 2024-11-11 00:52:44 +03:00
63 lines
1.9 KiB
Scheme
63 lines
1.9 KiB
Scheme
|
(import (scheme base))
|
||
|
|
(import (scheme write))
|
||
|
|
|
||
|
|
(import (lib util))
|
||
|
|
(import (lib reader))
|
||
|
|
(import (lib printer))
|
||
|
|
(import (lib types))
|
||
|
|
|
||
|
|
(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) (or (alist-ref value env)
|
||
|
|
(error (str "'" value "' not found"))))
|
||
|
|
((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
|
||
|
|
(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
|
||
|
|
`((+ . ,(lambda (a b) (mal-number (+ (mal-value a) (mal-value b)))))
|
||
|
|
(- . ,(lambda (a b) (mal-number (- (mal-value a) (mal-value b)))))
|
||
|
|
(* . ,(lambda (a b) (mal-number (* (mal-value a) (mal-value b)))))
|
||
|
|
(/ . ,(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)
|