Commit | Line | Data |
---|---|---|
4abefe45 JM |
1 | #!/usr/bin/env hy |
2 | ||
081c3223 | 3 | (import [hy.models [HyString :as Str HySymbol :as Sym]]) |
4abefe45 | 4 | (import sys traceback) |
dd7a4f55 | 5 | (import [mal_types [MalException]]) |
4abefe45 JM |
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 pair? [x] | |
081c3223 | 17 | (and (core.sequential? x) (> (len x) 0))) |
4abefe45 JM |
18 | |
19 | (defn QUASIQUOTE [ast] | |
20 | (if | |
21 | (not (pair? ast)) | |
22 | (tuple [(Sym "quote") ast]) | |
23 | ||
24 | (= (Sym "unquote") (first ast)) | |
25 | (nth ast 1) | |
26 | ||
27 | (and (pair? (first ast)) | |
28 | (= (Sym "splice-unquote") (first (first ast)))) | |
29 | (tuple [(Sym "concat") (nth (first ast) 1) (QUASIQUOTE (tuple (rest ast)))]) | |
30 | ||
31 | True | |
32 | (tuple [(Sym "cons") (QUASIQUOTE (first ast)) (QUASIQUOTE (tuple (rest ast)))]))) | |
33 | ||
34 | (defn eval-ast [ast env] | |
35 | ;;(print "eval-ast:" ast (type ast)) | |
36 | (if | |
37 | (symbol? ast) (env-get env ast) | |
081c3223 JM |
38 | (instance? dict ast) (dict (map (fn [k] |
39 | [(EVAL k env) (EVAL (get ast k) env)]) | |
40 | ast)) | |
4abefe45 JM |
41 | (instance? tuple ast) (tuple (map (fn [x] (EVAL x env)) ast)) |
42 | (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) | |
43 | True ast)) | |
44 | ||
45 | (defn EVAL [ast env] | |
46 | ;;(print "EVAL:" ast (type ast) (instance? tuple ast)) | |
1872f735 | 47 | ;; indented to match later steps |
4abefe45 JM |
48 | (setv res None) |
49 | (while True | |
1872f735 JM |
50 | (setv res |
51 | (if (not (instance? tuple ast)) | |
52 | (eval-ast ast env) | |
53 | ||
54 | ;; apply list | |
55 | (do | |
56 | (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) | |
57 | (if | |
58 | (none? a0) | |
59 | ast | |
60 | ||
61 | (= (Sym "def!") a0) | |
62 | (env-set env a1 (EVAL a2 env)) | |
63 | ||
64 | (= (Sym "let*") a0) | |
65 | (do | |
66 | (setv env (env-new env)) | |
67 | (for [[b e] (partition a1 2)] | |
68 | (env-set env b (EVAL e env))) | |
69 | (setv ast a2) | |
4abefe45 | 70 | (continue)) ;; TCO |
e8f52c24 | 71 | |
1872f735 JM |
72 | (= (Sym "quote") a0) |
73 | a1 | |
74 | ||
75 | (= (Sym "quasiquote") a0) | |
76 | (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO | |
77 | ||
78 | (= (Sym "do") a0) | |
79 | (do (eval-ast (list (butlast (rest ast))) env) | |
80 | (setv ast (last ast)) | |
81 | (continue)) ;; TCO | |
82 | ||
83 | (= (Sym "if") a0) | |
84 | (do | |
85 | (setv cond (EVAL a1 env)) | |
86 | (if (or (none? cond) (and (instance? bool cond) | |
87 | (= cond False))) | |
88 | (if (> (len ast) 2) | |
89 | (do (setv ast (nth ast 3)) (continue)) ;; TCO | |
90 | None) | |
91 | (do (setv ast a2) (continue)))) ;; TCO | |
92 | ||
93 | (= (Sym "fn*") a0) | |
94 | (do | |
95 | (setv func (fn [&rest args] | |
96 | (EVAL a2 (env-new env a1 (or args [])))) | |
97 | func.ast a2 | |
98 | func.env env | |
99 | func.params a1) | |
100 | func) | |
101 | ||
102 | ;; apply | |
103 | (do | |
104 | (setv el (eval-ast ast env) | |
105 | f (first el) | |
106 | args (list (rest el))) | |
107 | (if (hasattr f "ast") | |
108 | (do (setv ast f.ast | |
109 | env (env-new f.env f.params args)) | |
110 | (continue)) ;; TCO | |
111 | (apply f args))))))) | |
4abefe45 JM |
112 | (break)) |
113 | res) | |
114 | ||
115 | ||
116 | (defn PRINT [exp] | |
117 | (pr-str exp True)) | |
118 | ||
119 | ;; repl | |
120 | (def repl-env (env-new)) | |
121 | (defn REP [str] | |
122 | (PRINT (EVAL (READ str) repl-env))) | |
123 | ||
124 | ;; core.hy: defined using Hy | |
125 | (for [k core.ns] | |
126 | (env-set repl-env (Sym k) (get core.ns k))) | |
127 | (env-set repl-env (Sym "eval") (fn [ast] (EVAL ast repl-env))) | |
e8f52c24 | 128 | (env-set repl-env (Sym "*ARGV*") (, )) |
4abefe45 JM |
129 | |
130 | ;; core.mal: defined using the language itself | |
131 | (REP "(def! not (fn* [a] (if a false true)))") | |
e6d41de4 | 132 | (REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") |
4abefe45 | 133 | |
e8f52c24 JM |
134 | (defmain [&rest args] |
135 | (if (>= (len args) 2) | |
136 | (do | |
137 | (env-set repl-env (Sym "*ARGV*") (tuple (map Str (rest (rest args))))) | |
138 | (REP (+ "(load-file \"" (get args 1) "\")"))) | |
139 | (do | |
140 | (while True | |
141 | (try | |
142 | (do (setv line (raw_input "user> ")) | |
143 | (if (= "" line) (continue)) | |
144 | (print (REP line))) | |
145 | (except [EOFError] (break)) | |
146 | (except [Blank]) | |
dd7a4f55 JM |
147 | (except [e Exception] |
148 | (setv msg (.rstrip (.join "" (apply traceback.format_exception | |
149 | (.exc_info sys))))) | |
150 | (if (instance? MalException e) | |
151 | (setv msg (+ (.rstrip msg) ": " (pr-str e.val True)))) | |
152 | (print msg))))))) |