guile/step2_eval.scm

   1 ;;  Copyright (C) 2015
   2 ;;      "Mu Lei" known as "NalaGinrut" <NalaGinrut@gmail.com>
   3 ;;  This file is free software: you can redistribute it and/or modify
   4 ;;  it under the terms of the GNU General Public License as published by
   5 ;;  the Free Software Foundation, either version 3 of the License, or
   6 ;;  (at your option) any later version.
   7
   8 ;;  This file is distributed in the hope that it will be useful,
   9 ;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 ;;  GNU General Public License for more details.
  12
  13 ;;  You should have received a copy of the GNU General Public License
  14 ;;  along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15
  16 (import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43))
  17
  18 (define *toplevel*
  19   `((+ . ,+)
  20     (- . ,-)
  21     (* . ,*)
  22     (/ . ,/)))
  23
  24 (define (READ str)
  25   (read_str str))
  26
  27 (define (eval_ast ast env)
  28   (define (_eval x) (EVAL x env))
  29   (match ast
  30     ((? symbol? sym)
  31      (or (assoc-ref env sym)
  32          (throw 'mal-error (format #f "'~a' not found" sym))))
  33     ((? list? lst) (map _eval lst))
  34     ((? vector? vec) (vector-map (lambda (i x) (_eval x)) vec))
  35     ((? hash-table? ht)
  36      (hash-for-each (lambda (k v) (hash-set! ht k (_eval v))) ht)
  37      ht)
  38     (else ast)))
  39
  40 (define (EVAL ast env)
  41   (match ast
  42     (() ast)
  43     ((? list?)
  44      (let ((el (eval_ast ast env)))
  45         (apply (car el) (cdr el))))
  46     (else (eval_ast ast env))))
  47
  48 (define (PRINT exp)
  49   (and (not (eof-object? exp))
  50        (format #t "~a~%" (pr_str exp #t))))
  51
  52 (define (LOOP continue?)
  53   (and continue? (REPL)))
  54
  55 (define (REPL)
  56   (LOOP
  57    (let ((line (_readline "user> ")))
  58      (cond
  59        ((eof-object? line) #f)
  60        ((string=? line "") #t)
  61        (else
  62          (catch 'mal-error
  63                 (lambda () (PRINT (EVAL (READ line) *toplevel*)))
  64                 (lambda (k . e)
  65                   (format #t "Error: ~a~%" (pr_str (car e) #t)))))))))
  66
  67 (REPL)