racket/step6_file.rkt

   1 #!/usr/bin/env racket
   2 #lang racket
   3
   4 (require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt"
   5          "env.rkt" "core.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             [(eq? 'do a0)
  36              (eval-ast (drop (drop-right ast 1) 1) env)
  37              (EVAL (last ast) env)]
  38             [(eq? 'if a0)
  39              (let ([cnd (EVAL (_nth ast 1) env)])
  40                (if (or (eq? cnd nil) (eq? cnd #f))
  41                  (if (> (length ast) 3)
  42                    (EVAL (_nth ast 3) env)
  43                    nil)
  44                  (EVAL (_nth ast 2) env)))]
  45             [(eq? 'fn* a0)
  46              (malfunc
  47                (lambda args (EVAL (_nth ast 2)
  48                                   (new Env% [outer env]
  49                                             [binds (_nth ast 1)]
  50                                             [exprs args])))
  51                (_nth ast 2) env (_nth ast 1) #f nil)]
  52             [else (let* ([el (eval-ast ast env)]
  53                          [f (first el)]
  54                          [args (rest el)])
  55                     (if (malfunc? f)
  56                       (EVAL (malfunc-ast f)
  57                             (new Env%
  58                                  [outer (malfunc-env f)]
  59                                  [binds (malfunc-params f)]
  60                                  [exprs args]))
  61                       (apply f args)))]))))
  62
  63 ;; print
  64 (define (PRINT exp)
  65   (pr_str exp true))
  66
  67 ;; repl
  68 (define repl-env
  69   (new Env% [outer null] [binds null] [exprs null]))
  70 (define (rep str)
  71   (PRINT (EVAL (READ str) repl-env)))
  72
  73 (for ()  ;; ignore return values
  74
  75 ;; core.rkt: defined using Racket
  76 (hash-for-each core_ns (lambda (k v) (send repl-env set k v)))
  77 (send repl-env set 'eval (lambda [ast] (EVAL ast repl-env)))
  78 (send repl-env set '*ARGV* (list))
  79
  80 ;; core.mal: defined using the language itself
  81 (rep "(def! not (fn* (a) (if a false true)))")
  82 (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
  83
  84 )
  85
  86 (define (repl-loop)
  87   (let ([line (readline "user> ")])
  88     (when (not (eq? nil line))
  89       (with-handlers
  90         ([string? (lambda (exc) (printf "Error: ~a~n" exc))]
  91          [blank-exn? (lambda (exc) null)])
  92         (printf "~a~n" (rep line)))
  93       (repl-loop))))
  94 (let ([args (current-command-line-arguments)])
  95   (if (> (vector-length args) 0)
  96     (for () (rep (string-append "(load-file \"" (vector-ref args 0) "\")")))
  97     (repl-loop)))