racket/step3_env.rkt

   1 #!/usr/bin/env racket
   2 #lang racket
   3
   4 (require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt"
   5          "env.rkt")
   6
   7 ;; read
   8 (define (READ str)
   9   (read_str str))
  10
  11 ;; eval
  12 (define (eval-ast ast env)
  13   (cond
  14     [(symbol? ast) (send env get ast)]
  15     [(_sequential? ast) (_map (lambda (x) (EVAL x env)) ast)]
  16     [(hash? ast) (make-hash
  17                   (dict-map ast (lambda (k v) (cons k (EVAL v env)))))]
  18     [else ast]))
  19
  20 (define (EVAL ast env)
  21   (if (not (list? ast))
  22         (eval-ast ast env)
  23
  24         (let ([a0 (_nth ast 0)])
  25           (cond
  26             [(eq? 'def! a0)
  27              (send env set (_nth ast 1) (EVAL (_nth ast 2) env))]
  28             [(eq? 'let* a0)
  29              (let ([let-env (new Env% [outer env] [binds null] [exprs null])])
  30                (_map (lambda (b_e)
  31                        (send let-env set (_first b_e)
  32                              (EVAL (_nth b_e 1) let-env)))
  33                     (_partition 2 (_to_list (_nth ast 1))))
  34                (EVAL (_nth ast 2) let-env))]
  35             [else (let* ([el (eval-ast ast env)]
  36                          [f (first el)]
  37                          [args (rest el)])
  38                     (apply f args))]))))
  39
  40 ;; print
  41 (define (PRINT exp)
  42   (pr_str exp true))
  43
  44 ;; repl
  45 (define repl-env
  46   (new Env%
  47        [outer null]
  48        [binds '(+ - * /)]
  49        [exprs (list + - * /)]))
  50 (define (rep str)
  51   (PRINT (EVAL (READ str) repl-env)))
  52
  53 (define (repl-loop)
  54   (let ([line (readline "user> ")])
  55     (when (not (eq? nil line))
  56       (with-handlers
  57         ([string? (lambda (exc) (printf "Error: ~a~n" exc))]
  58          [blank-exn? (lambda (exc) null)])
  59         (printf "~a~n" (rep line)))
  60       (repl-loop))))
  61 (repl-loop)