Ruby: add step8_macros

ruby/core.rb

@@ -14,6 +14,11 @@ $core_ns = {
     :/ =>         lambda {|a,b| a / b},
     :list =>      lambda {|*a| List.new a},
     :list? =>     lambda {|*a| a[0].is_a? List},
+    :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]},
+    :first =>     lambda {|a| a[0]},
+    :rest =>      lambda {|a| List.new(a.size > 0 && a.drop(1) || [])},
     :empty? =>    lambda {|a| a.size == 0},
     :count =>     lambda {|a| a.size},
 }

ruby/step8_macros.rb

@@ -0,0 +1,158 @@
+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 :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[:"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["(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

ruby/types.rb

@@ -14,12 +14,14 @@ class Function < Proc
     attr_accessor :ast
     attr_accessor :env
     attr_accessor :params
+    attr_accessor :is_macro
 
     def initialize(ast=nil, env=nil, params=nil, &block)
         super()
         @ast = ast
         @env = env
         @params = params
+        @is_macro = false
     end
 
     def gen_env(args)

tests/step8_macros.mal

@@ -1,3 +1,61 @@
+;; Testing cons function
+(cons 1 (list))
+;=>(1)
+(cons 1 (list 2))
+;=>(1 2)
+(cons 1 (list 2 3))
+;=>(1 2 3)
+(cons (list 1) (list 2 3))
+;=>((1) 2 3)
+(cons [1] [2 3])
+;=>([1] 2 3)
+(cons 1 [2 3])
+;=>(1 2 3)
+
+;; Testing concat function
+(concat)
+;=>()
+(concat (list 1 2))
+;=>(1 2)
+(concat (list 1 2) (list 3 4))
+;=>(1 2 3 4)
+(concat (list 1 2) (list 3 4) (list 5 6))
+;=>(1 2 3 4 5 6)
+(concat [1 2] (list 3 4) [5 6])
+;=>(1 2 3 4 5 6)
+(concat (concat))
+;=>()
+
+;; Testing first function
+(first '())
+;=>nil
+(first '(6))
+;=>6
+(first '(7 8 9))
+;=>7
+(first [])
+;=>nil
+(first [10])
+;=>10
+(first [10 11 12])
+;=>10
+
+;; Testing rest function
+(rest '())
+;=>()
+(rest '(6))
+;=>()
+(rest '(7 8 9))
+;=>(8 9)
+(rest [])
+;=>()
+(rest [10])
+;=>()
+(rest [10 11 12])
+;=>(11 12)
+
+
+
 ;; Testing trivial macros
 (defmacro! one (fn* () 1))
 (one)

tests/stepA_more.mal

@@ -71,34 +71,6 @@
 ;=>(2 4 6)
 
 
-;; Testing concat function
-(concat)
-;=>()
-(concat (list 1 2))
-;=>(1 2)
-(concat (list 1 2) (list 3 4))
-;=>(1 2 3 4)
-(concat (list 1 2) (list 3 4) (list 5 6))
-;=>(1 2 3 4 5 6)
-(concat [1 2] (list 3 4) [5 6])
-;=>(1 2 3 4 5 6)
-(concat (concat))
-;=>()
-
-;; Testing cons function
-(cons 1 (list))
-;=>(1)
-(cons 1 (list 2))
-;=>(1 2)
-(cons 1 (list 2 3))
-;=>(1 2 3)
-(cons (list 1) (list 2 3))
-;=>((1) 2 3)
-(cons [1] [2 3])
-;=>([1] 2 3)
-(cons 1 [2 3])
-;=>(1 2 3)
-
 ;; Testing conj function
 (conj (list) 1)
 ;=>(1)
@@ -122,33 +94,6 @@
 (conj [1] [2 3])
 ;=>[1 [2 3]]
 
-;; Testing first/rest functions
-(first '())
-;=>nil
-(first '(6))
-;=>6
-(first '(7 8 9))
-;=>7
-(first [])
-;=>nil
-(first [10])
-;=>10
-(first [10 11 12])
-;=>10
-
-(rest '())
-;=>()
-(rest '(6))
-;=>()
-(rest '(7 8 9))
-;=>(8 9)
-(rest [])
-;=>()
-(rest [10])
-;=>()
-(rest [10 11 12])
-;=>(11 12)
-
 
 
 ;;