hy/step4_if_fn_do.hy

   1 #!/usr/bin/env hy
   2
   3 (import [hy.models [HySymbol :as Sym]])
   4 (import sys traceback)
   5 (import [mal_types [MalException]])
   6 (import [reader [read-str Blank]])
   7 (import [printer [pr-str]])
   8 (import [env [env-new env-get env-set]])
   9 (import core)
  10
  11 ;; read
  12 (defn READ [str]
  13   (read-str str))
  14
  15 ;; eval
  16 (defn eval-ast [ast env]
  17   ;;(print "eval-ast:" ast (type ast))
  18   (if
  19     (symbol? ast)         (env-get env ast)
  20     (instance? dict ast)  (dict (map (fn [k]
  21                                        [(EVAL k env) (EVAL (get ast k) env)])
  22                                      ast))
  23     (instance? tuple ast) (tuple (map (fn [x] (EVAL x env)) ast))
  24     (instance? list ast)  (list (map (fn [x] (EVAL x env)) ast))
  25     True                  ast))
  26
  27 (defn EVAL [ast env]
  28   ;;(print "EVAL:" ast (type ast))
  29   ;; indented to match later steps
  30       (if (not (instance? tuple ast))
  31         (eval-ast ast env)
  32
  33         ;; apply list
  34             (do
  35               (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)])
  36               (if
  37                 (none? a0)
  38                 ast
  39
  40                 (= (Sym "def!") a0)
  41                 (env-set env a1 (EVAL a2 env))
  42
  43                 (= (Sym "let*") a0)
  44                 (do
  45                   (setv env (env-new env))
  46                   (for [[b e] (partition a1 2)]
  47                     (env-set env b (EVAL e env)))
  48                   (EVAL a2 env))
  49
  50                 (= (Sym "do") a0)
  51                 (last (eval-ast (list (rest ast)) env))
  52
  53                 (= (Sym "if") a0)
  54                 (do
  55                   (setv cond (EVAL a1 env))
  56                   (if (or (none? cond) (and (instance? bool cond)
  57                                             (= cond False)))
  58                     (if (> (len ast) 2)
  59                       (EVAL (nth ast 3) env)
  60                       None)
  61                     (EVAL a2 env)))
  62
  63                 (= (Sym "fn*") a0)
  64                 (fn [&rest args]
  65                   (EVAL a2 (env-new env a1 (or args []))))
  66
  67                 ;; apply
  68                 (do
  69                   (setv el (eval-ast ast env)
  70                         f (first el)
  71                         args (list (rest el)))
  72                   (apply f args))))))
  73
  74 ;; print
  75 (defn PRINT [exp]
  76   (pr-str exp True))
  77
  78 ;; repl
  79 (def repl-env (env-new))
  80 (defn REP [str]
  81   (PRINT (EVAL (READ str) repl-env)))
  82
  83 ;; core.hy: defined using Hy
  84 (for [k core.ns]
  85   (env-set repl-env (Sym k) (get core.ns k)))
  86
  87 ;; core.mal: defined using the language itself
  88 (REP "(def! not (fn* [a] (if a false true)))")
  89
  90 (defmain [&rest args]
  91   ;; indented to match later steps
  92       (while True
  93         (try
  94           (do (setv line (raw_input "user> "))
  95               (if (= "" line) (continue))
  96               (print (REP line)))
  97           (except [EOFError] (break))
  98           (except [Blank])
  99           (except [e Exception]
 100             (setv msg (.rstrip (.join "" (apply traceback.format_exception
 101                                                 (.exc_info sys)))))
 102             (if (instance? MalException e)
 103               (setv msg (+ (.rstrip msg) ": " (pr-str e.val True))))
 104             (print msg)))))