hy/step6_file.hy

   1 #!/usr/bin/env hy
   2
   3 (import [hy.models [HyString :as Str 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) (instance? tuple ast))
  29   ;; indented to match later steps
  30   (setv res None)
  31   (while True
  32     (setv res
  33       (if (not (instance? tuple ast))
  34         (eval-ast ast env)
  35
  36         ;; apply list
  37             (do
  38               (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)])
  39               (if
  40                 (none? a0)
  41                 ast
  42
  43                 (= (Sym "def!") a0)
  44                 (env-set env a1 (EVAL a2 env))
  45
  46                 (= (Sym "let*") a0)
  47                 (do
  48                   (setv env (env-new env))
  49                   (for [[b e] (partition a1 2)]
  50                     (env-set env b (EVAL e env)))
  51                   (setv ast a2)
  52                   (continue)) ;; TCO
  53
  54                 (= (Sym "do") a0)
  55                 (do (eval-ast (list (butlast (rest ast))) env)
  56                     (setv ast (last ast))
  57                     (continue)) ;; TCO
  58
  59                 (= (Sym "if") a0)
  60                 (do
  61                   (setv cond (EVAL a1 env))
  62                   (if (or (none? cond) (and (instance? bool cond)
  63                                             (= cond False)))
  64                     (if (> (len ast) 2)
  65                       (do (setv ast (nth ast 3)) (continue)) ;; TCO
  66                       None)
  67                     (do (setv ast a2) (continue)))) ;; TCO
  68
  69                 (= (Sym "fn*") a0)
  70                 (do
  71                   (setv func (fn [&rest args]
  72                                (EVAL a2 (env-new env a1 (or args []))))
  73                         func.ast a2
  74                         func.env env
  75                         func.params a1)
  76                   func)
  77
  78                 ;; apply
  79                 (do
  80                   (setv el (eval-ast ast env)
  81                         f (first el)
  82                         args (list (rest el)))
  83                   (if (hasattr f "ast")
  84                     (do (setv ast f.ast
  85                               env (env-new f.env f.params args))
  86                         (continue)) ;; TCO
  87                     (apply f args)))))))
  88     (break))
  89   res)
  90
  91 ;; print
  92 (defn PRINT [exp]
  93   (pr-str exp True))
  94
  95 ;; repl
  96 (def repl-env (env-new))
  97 (defn REP [str]
  98   (PRINT (EVAL (READ str) repl-env)))
  99
 100 ;; core.hy: defined using Hy
 101 (for [k core.ns]
 102   (env-set repl-env (Sym k) (get core.ns k)))
 103 (env-set repl-env (Sym "eval") (fn [ast] (EVAL ast repl-env)))
 104 (env-set repl-env (Sym "*ARGV*") (, ))
 105
 106 ;; core.mal: defined using the language itself
 107 (REP "(def! not (fn* [a] (if a false true)))")
 108 (REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))")
 109
 110 (defmain [&rest args]
 111   (if (>= (len args) 2)
 112     (do
 113       (env-set repl-env (Sym "*ARGV*") (tuple (map Str (rest (rest args)))))
 114       (REP (+ "(load-file \"" (get args 1) "\")")))
 115     (do
 116       (while True
 117         (try
 118           (do (setv line (raw_input "user> "))
 119               (if (= "" line) (continue))
 120               (print (REP line)))
 121           (except [EOFError] (break))
 122           (except [Blank])
 123           (except [e Exception]
 124             (setv msg (.rstrip (.join "" (apply traceback.format_exception
 125                                                 (.exc_info sys)))))
 126             (if (instance? MalException e)
 127               (setv msg (+ (.rstrip msg) ": " (pr-str e.val True))))
 128             (print msg)))))))