$core_ns = {
:"=" => lambda {|a,b| a == b},
+ :throw => lambda {|a| raise MalException.new(a), "Mal Exception"},
+ :nil? => lambda {|a| a == nil},
+ :true? => lambda {|a| a == true},
+ :false? => lambda {|a| a == false},
+ :symbol? => lambda {|a| a.is_a? Symbol},
+ :symbol? => lambda {|a| a.is_a? Symbol},
:"pr-str" => lambda {|*a| a.map {|e| _pr_str(e, true)}.join(" ")},
:"str" => lambda {|*a| a.map {|e| _pr_str(e, false)}.join("")},
:"prn" => lambda {|*a| puts(a.map {|e| _pr_str(e, true)}.join(" "))},
:- => lambda {|a,b| a - b},
:* => lambda {|a,b| a * b},
:/ => lambda {|a,b| a / b},
+
:list => lambda {|*a| List.new a},
:list? => lambda {|*a| a[0].is_a? List},
+ :vector => lambda {|*a| Vector.new a},
+ :vector? => lambda {|*a| a[0].is_a? Vector},
+ :"hash-map" =>lambda {|*a| Hash[a.each_slice(2).to_a]},
+ :map? => lambda {|a| a.is_a? Hash},
+ :assoc => lambda {|*a| a[0].merge(Hash[a.drop(1).each_slice(2).to_a])},
+ :dissoc => lambda {|*a| h = a[0].clone; a.drop(1).each{|k| h.delete k}; h},
+ :get => lambda {|a,b| a[b]},
+ :contains? => lambda {|a,b| a.key? b},
+ :keys => lambda {|a| List.new a.keys},
+ :vals => lambda {|a| List.new a.values},
+
+ :sequential? => lambda {|a| sequential?(a)},
:cons => lambda {|a,b| List.new(b.clone.insert(0,a))},
:concat => lambda {|*a| List.new(a && a.reduce(:concat) || [])},
:nth => lambda {|a,b| a[b]},
:rest => lambda {|a| List.new(a.size > 0 && a.drop(1) || [])},
:empty? => lambda {|a| a.size == 0},
:count => lambda {|a| a.size},
+ :conj => lambda {|*a| a[0].clone.conj(a.drop(1))},
+ :apply => lambda {|*a| a[0][*a[1..-2].concat(a[-1])]},
+ :map => lambda {|a,b| List.new(b.map {|e| a[e]})},
+
+ :"with-meta" => lambda {|a,b| x = a.clone; x.meta = b; x},
+ :meta => lambda {|a| a.meta},
+ :atom => lambda {|a| Atom.new(a)},
+ :atom? => lambda {|a| a.is_a? Atom},
+ :deref => lambda {|a| a.val},
+ :reset! => lambda {|a,b| a.val = b},
+ :swap! => lambda {|*a| a[0].val = a[1][*[a[0].val].concat(a.drop(2))]},
}
"(" + obj.map{|x| _pr_str(x, _r)}.join(" ") + ")"
when Vector
"[" + obj.map{|x| _pr_str(x, _r)}.join(" ") + "]"
+ when Hash
+ ret = []
+ obj.each{|k,v| ret.push(_pr_str(k,_r), _pr_str(v,_r))}
+ "{" + ret.join(" ") + "}"
when String
if _r
obj.inspect # escape special characters
else
obj
end
+ when Atom
+ "(atom " + _pr_str(obj.val, true) + ")"
when nil
"nil"
else
when "`" then rdr.next; List.new [:quasiquote, read_form(rdr)]
when "~" then rdr.next; List.new [:unquote, read_form(rdr)]
when "~@" then rdr.next; List.new [:"splice-unquote", read_form(rdr)]
+ when "^" then rdr.next; meta = read_form(rdr);
+ List.new [:"with-meta", read_form(rdr), meta]
+ when "@" then rdr.next; List.new [:deref, read_form(rdr)]
+
when "(" then read_list(rdr, List, "(", ")")
when ")" then raise "unexpected ')'"
when "[" then read_list(rdr, Vector, "[", "]")
when "]" then raise "unexpected ']'"
- when "{" then raise "unexpected '{'"
+ when "{" then Hash[read_list(rdr, List, "{", "}").each_slice(2).to_a]
when "}" then raise "unexpected '}'"
else read_atom(rdr)
end
--- /dev/null
+require "readline"
+require "types"
+require "reader"
+require "printer"
+require "env"
+require "core"
+
+# read
+def READ(str)
+ return read_str(str)
+end
+
+# eval
+def is_pair(x)
+ return sequential?(x) && x.size > 0
+end
+
+def quasiquote(ast)
+ if not is_pair(ast)
+ return List.new([:quote, ast])
+ elsif ast[0] == :unquote
+ return ast[1]
+ elsif is_pair(ast[0]) && ast[0][0] == :"splice-unquote"
+ #p "xxx:", ast, List.new([:concat, ast[0][1], quasiquote(ast.drop(1))])
+ return List.new([:concat, ast[0][1], quasiquote(ast.drop(1))])
+ else
+ return List.new([:cons, quasiquote(ast[0]), quasiquote(ast.drop(1))])
+ end
+end
+
+def macro_call?(ast, env)
+ return (ast.is_a?(List) &&
+ ast[0].is_a?(Symbol) &&
+ env.find(ast[0]) &&
+ env.get(ast[0]).is_a?(Function) &&
+ env.get(ast[0]).is_macro)
+end
+
+def macroexpand(ast, env)
+ while macro_call?(ast, env)
+ mac = env.get(ast[0])
+ ast = mac[*ast.drop(1)]
+ end
+ return ast
+end
+
+def eval_ast(ast, env)
+ return case ast
+ when Symbol
+ env.get(ast)
+ when List
+ List.new ast.map{|a| EVAL(a, env)}
+ when Vector
+ Vector.new ast.map{|a| EVAL(a, env)}
+ else
+ ast
+ end
+end
+
+def EVAL(ast, env)
+ while true
+
+ #puts "EVAL: #{_pr_str(ast, true)}"
+
+ if not ast.is_a? List
+ return eval_ast(ast, env)
+ end
+
+ # apply list
+ ast = macroexpand(ast, env)
+ return ast if not ast.is_a? List
+
+ a0,a1,a2,a3 = ast
+ case a0
+ when :def!
+ return env.set(a1, EVAL(a2, env))
+ when :"let*"
+ let_env = Env.new(env)
+ a1.each_slice(2) do |a,e|
+ let_env.set(a, EVAL(e, let_env))
+ end
+ return EVAL(a2, let_env)
+ when :quote
+ return a1
+ when :quasiquote
+ return EVAL(quasiquote(a1), env)
+ when :defmacro!
+ func = EVAL(a2, env)
+ func.is_macro = true
+ return env.set(a1, func)
+ when :macroexpand
+ return macroexpand(a1, env)
+ when :"rb*"
+ return eval(a1)
+ when :"try*"
+ begin
+ return EVAL(a1, env)
+ rescue Exception => exc
+ if exc.is_a? MalException
+ exc = exc.data
+ else
+ exc = exc.message
+ end
+ if a2 && a2[0] == :"catch*"
+ return EVAL(a2[2], Env.new(env, [a2[1]], [exc]))
+ else
+ raise esc
+ end
+ end
+ when :do
+ eval_ast(ast[1..-2], env)
+ ast = ast.last
+ when :if
+ cond = EVAL(a1, env)
+ if not cond
+ return nil if a3 == nil
+ ast = a3
+ else
+ ast = a2
+ end
+ when :"fn*"
+ return Function.new(a2, env, a1) {|*args|
+ EVAL(a2, Env.new(env, a1, args))
+ }
+ else
+ el = eval_ast(ast, env)
+ f = el[0]
+ if f.class == Function
+ ast = f.ast
+ env = f.gen_env(el.drop(1))
+ else
+ return f[*el.drop(1)]
+ end
+ end
+
+ end
+end
+
+# print
+def PRINT(exp)
+ return _pr_str(exp, true)
+end
+
+# repl
+repl_env = Env.new
+RE = lambda {|str| EVAL(READ(str), repl_env) }
+REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) }
+_ref = lambda {|k,v| repl_env.set(k, v) }
+
+# Import core functions
+$core_ns.each &_ref
+
+_ref[:"readline", lambda {|prompt| Readline.readline(prompt,true)}]
+_ref[:"read-string", lambda {|str| read_str str}]
+_ref[:eval, lambda {|ast| EVAL(ast, repl_env)}]
+_ref[:slurp, lambda {|f| File.read(f) }]
+
+# Defined using the language itself
+RE["(def! not (fn* (a) (if a false true)))"]
+RE["(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"]
+RE["(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"]
+
+RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"]
+
+p Dir.pwd
+if ARGV.size > 0
+ ARGV.each {|f|
+ RE["(load-file \"" + f + "\")"]
+ }
+ exit 0
+end
+while line = Readline.readline("user> ", true)
+ begin
+ puts REP[line]
+ rescue Exception => e
+ puts "Error: #{e}"
+ puts "\t#{e.backtrace.join("\n\t")}"
+ end
+end
require "env"
+class MalException < StandardError
+ attr_reader :data
+ def initialize(data)
+ @data = data
+ end
+end
+
class List < Array
+ attr_accessor :meta
+ def conj(xs)
+ xs.each{|x| self.unshift(x)}
+ return self
+ end
end
class Vector < Array
+ attr_accessor :meta
+ def conj(xs)
+ self.push(*xs)
+ return self
+ end
+end
+
+class Hash # re-open and add meta
+ attr_accessor :meta
end
def sequential?(obj)
end
class Function < Proc
+ attr_accessor :meta
attr_accessor :ast
attr_accessor :env
attr_accessor :params
return Env.new(@env, @params, args)
end
end
+
+class Atom
+ attr_accessor :meta
+ attr_accessor :val
+ def initialize(val)
+ @val = val
+ end
+end
HCoop / jackhill / mal.git / commitdiff