aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoel Martin <github@martintribe.org>2014-10-06 23:53:51 -0500
committerJoel Martin <github@martintribe.org>2014-10-06 23:53:51 -0500
commit82efc357ba67da1eaf35ca92b6f249a344aae8d5 (patch)
tree1cdf298c1c971a3bdecec1e31727ea8f214eedef
parentaeabd2145ff133cc6991166d8f1023ed33e223c8 (diff)
downloadmal-82efc357ba67da1eaf35ca92b6f249a344aae8d5.tar.gz
mal-82efc357ba67da1eaf35ca92b6f249a344aae8d5.zip
go: add step8_macros
-rw-r--r--go/Makefile5
-rw-r--r--go/src/core/core.go32
-rw-r--r--go/src/step5_tco/step5_tco.go4
-rw-r--r--go/src/step6_file/step6_file.go4
-rw-r--r--go/src/step7_quote/step7_quote.go4
-rw-r--r--go/src/step8_macros/step8_macros.go282
-rw-r--r--go/src/types/types.go27
7 files changed, 346 insertions, 12 deletions
diff --git a/go/Makefile b/go/Makefile
index ddf29f6..dbdfeaf 100644
--- a/go/Makefile
+++ b/go/Makefile
@@ -4,13 +4,14 @@ export GOPATH := $(dir $(abspath $(lastword $(MAKEFILE_LIST))))
SOURCES_BASE = src/types/types.go src/reader/reader.go src/printer/printer.go \
src/env/env.go src/core/core.go
-SOURCES_LISP = src/step7_quote/step7_quote.go
+SOURCES_LISP = src/step8_macros/step8_macros.go
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
#####################
SRCS = step0_repl.go step1_read_print.go step2_eval.go step3_env.go \
- step4_if_fn_do.go step5_tco.go step6_file.go step7_quote.go
+ step4_if_fn_do.go step5_tco.go step6_file.go step7_quote.go \
+ step8_macros.go
BINS = $(SRCS:%.go=%)
#####################
diff --git a/go/src/core/core.go b/go/src/core/core.go
index 65475bb..3c6693e 100644
--- a/go/src/core/core.go
+++ b/go/src/core/core.go
@@ -50,12 +50,35 @@ func cons(a []MalType) (MalType, error) {
}
func concat(a []MalType) (MalType, error) {
- lst1, e := GetSlice(a[0]); if e != nil { return nil, e }
- lst2, e := GetSlice(a[1]); if e != nil { return nil, e }
+ if len(a) == 0 { return List{}, nil }
+ slc1, e := GetSlice(a[0]); if e != nil { return nil, e }
+ for i := 1; i < len(a); i+=1 {
+ slc2, e := GetSlice(a[i]); if e != nil { return nil, e }
+ slc1 = append(slc1, slc2...)
+ }
+ return List{slc1}, nil
+}
+
+func nth(a []MalType) (MalType, error) {
+ slc, e := GetSlice(a[0]); if e != nil { return nil, e }
+ idx := a[1].(int)
+ return slc[idx], nil
+}
- return List{append(lst1, lst2...)}, nil
+func first(a []MalType) (MalType, error) {
+ if len(a) == 0 { return nil, nil }
+ slc, e := GetSlice(a[0]); if e != nil { return nil, e }
+ if len(slc) == 0 { return nil, nil }
+ return slc[0], nil
}
+func rest(a []MalType) (MalType, error) {
+ slc, e := GetSlice(a[0]); if e != nil { return nil, e }
+ if len(slc) == 0 { return List{}, nil }
+ return List{slc[1:]}, nil
+}
+
+
func empty_Q(a []MalType) (MalType, error) {
switch obj := a[0].(type) {
case List: return len(obj.Val) == 0, nil
@@ -112,6 +135,9 @@ var NS = map[string]MalType{
"cons": cons,
"concat": concat,
+ "nth": nth,
+ "first": first,
+ "rest": rest,
"empty?": empty_Q,
"count": count,
}
diff --git a/go/src/step5_tco/step5_tco.go b/go/src/step5_tco/step5_tco.go
index 0c07316..ad4b5e2 100644
--- a/go/src/step5_tco/step5_tco.go
+++ b/go/src/step5_tco/step5_tco.go
@@ -123,7 +123,9 @@ func EVAL(ast MalType, env EnvType) (MalType, error) {
ast = a2
}
case "fn*":
- fn := MalFunc{EVAL, a2, env, a1}
+ fn := MalFunc{EVAL, a2, env, a1, false,
+ func(outer EnvType, binds []MalType, exprs []MalType) (EnvType, error) {
+ return NewEnv(outer, binds, exprs) }}
return fn, nil
default:
el, e := eval_ast(ast, env)
diff --git a/go/src/step6_file/step6_file.go b/go/src/step6_file/step6_file.go
index ddf748e..046f24e 100644
--- a/go/src/step6_file/step6_file.go
+++ b/go/src/step6_file/step6_file.go
@@ -123,7 +123,9 @@ func EVAL(ast MalType, env EnvType) (MalType, error) {
ast = a2
}
case "fn*":
- fn := MalFunc{EVAL, a2, env, a1}
+ fn := MalFunc{EVAL, a2, env, a1, false,
+ func(outer EnvType, binds []MalType, exprs []MalType) (EnvType, error) {
+ return NewEnv(outer, binds, exprs) }}
return fn, nil
default:
el, e := eval_ast(ast, env)
diff --git a/go/src/step7_quote/step7_quote.go b/go/src/step7_quote/step7_quote.go
index 2acc9c7..8642cf0 100644
--- a/go/src/step7_quote/step7_quote.go
+++ b/go/src/step7_quote/step7_quote.go
@@ -156,7 +156,9 @@ func EVAL(ast MalType, env EnvType) (MalType, error) {
ast = a2
}
case "fn*":
- fn := MalFunc{EVAL, a2, env, a1}
+ fn := MalFunc{EVAL, a2, env, a1, false,
+ func(outer EnvType, binds []MalType, exprs []MalType) (EnvType, error) {
+ return NewEnv(outer, binds, exprs) }}
return fn, nil
default:
el, e := eval_ast(ast, env)
diff --git a/go/src/step8_macros/step8_macros.go b/go/src/step8_macros/step8_macros.go
new file mode 100644
index 0000000..12f036a
--- /dev/null
+++ b/go/src/step8_macros/step8_macros.go
@@ -0,0 +1,282 @@
+package main
+
+import (
+ "bufio"
+ //"io"
+ "fmt"
+ "os"
+ "strings"
+ "errors"
+)
+
+import (
+ . "types"
+ "reader"
+ "printer"
+ . "env"
+ "core"
+)
+
+// read
+func READ(str string) (MalType, error) {
+ return reader.Read_str(str)
+}
+
+// eval
+func is_pair(x MalType) bool {
+ slc, e := GetSlice(x)
+ if e != nil { return false }
+ return len(slc) > 0
+}
+
+func quasiquote(ast MalType) MalType {
+ if !is_pair(ast) {
+ return List{[]MalType{Symbol{"quote"}, ast}}
+ } else {
+ slc, _ := GetSlice(ast)
+ a0 := slc[0]
+ if Symbol_Q(a0) && (a0.(Symbol).Val == "unquote") {
+ return slc[1]
+ } else if is_pair(a0) {
+ slc0, _ := GetSlice(a0)
+ a00 := slc0[0]
+ if Symbol_Q(a00) && (a00.(Symbol).Val == "splice-unquote") {
+ return List{[]MalType{Symbol{"concat"},
+ slc0[1],
+ quasiquote(List{slc[1:]})}}
+ }
+ }
+ return List{[]MalType{Symbol{"cons"},
+ quasiquote(a0),
+ quasiquote(List{slc[1:]})}}
+ }
+}
+
+func is_macro_call(ast MalType, env EnvType) bool {
+ if List_Q(ast) {
+ slc, _ := GetSlice(ast)
+ a0 := slc[0]
+ if Symbol_Q(a0) && env.Find(a0.(Symbol).Val) != nil {
+ mac, e := env.Get(a0.(Symbol).Val)
+ if e != nil { return false }
+ if MalFunc_Q(mac) {
+ return mac.(MalFunc).GetMacro()
+ }
+ }
+ }
+ return false
+}
+
+func macroexpand(ast MalType, env EnvType) (MalType, error) {
+ var mac MalType
+ var e error
+ for ; is_macro_call(ast, env) ; {
+ slc, _ := GetSlice(ast)
+ a0 := slc[0]
+ mac, e = env.Get(a0.(Symbol).Val); if e != nil { return nil, e }
+ fn := mac.(MalFunc)
+ ast, e = fn.Apply(slc[1:]); if e != nil { return nil, e }
+ }
+ return ast, nil
+}
+
+func eval_ast(ast MalType, env EnvType) (MalType, error) {
+ //fmt.Printf("eval_ast: %#v\n", ast)
+ if Symbol_Q(ast) {
+ return env.Get(ast.(Symbol).Val)
+ } else if List_Q(ast) {
+ lst := []MalType{}
+ for _, a := range ast.(List).Val {
+ exp, e := EVAL(a, env)
+ if e != nil { return nil, e }
+ lst = append(lst, exp)
+ }
+ return List{lst}, nil
+ } else if Vector_Q(ast) {
+ lst := []MalType{}
+ for _, a := range ast.(Vector).Val {
+ exp, e := EVAL(a, env)
+ if e != nil { return nil, e }
+ lst = append(lst, exp)
+ }
+ return Vector{lst}, nil
+ } else if Hash_Map_Q(ast) {
+ m := ast.(map[string]MalType)
+ new_hm := map[string]MalType{}
+ for k, v := range m {
+ ke, e1 := EVAL(k, env)
+ if e1 != nil { return nil, e1 }
+ if _, ok := ke.(string); !ok {
+ return nil, errors.New("non string hash-map key")
+ }
+ kv, e2 := EVAL(v, env)
+ if e2 != nil { return nil, e2 }
+ new_hm[ke.(string)] = kv
+ }
+ return new_hm, nil
+ } else {
+ return ast, nil
+ }
+}
+
+func EVAL(ast MalType, env EnvType) (MalType, error) {
+ var e error
+ for {
+
+ //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true))
+ switch ast.(type) {
+ case List: // continue
+ default: return eval_ast(ast, env)
+ }
+
+ // apply list
+ ast, e = macroexpand(ast, env); if e != nil { return nil, e }
+ if (!List_Q(ast)) { return ast, nil }
+
+ a0 := ast.(List).Val[0]
+ var a1 MalType = nil; var a2 MalType = nil
+ switch len(ast.(List).Val) {
+ case 1:
+ a1 = nil; a2 = nil
+ case 2:
+ a1 = ast.(List).Val[1]; a2 = nil
+ default:
+ a1 = ast.(List).Val[1]; a2 = ast.(List).Val[2]
+ }
+ a0sym := "__<*fn*>__"
+ if Symbol_Q(a0) { a0sym = a0.(Symbol).Val }
+ switch a0sym {
+ case "def!":
+ res, e := EVAL(a2, env)
+ if e != nil { return nil, e }
+ return env.Set(a1.(Symbol).Val, res), nil
+ case "let*":
+ let_env, e := NewEnv(env, nil, nil)
+ if e != nil { return nil, e }
+ arr1, e := GetSlice(a1)
+ if e != nil { return nil, e }
+ for i := 0; i < len(arr1); i+=2 {
+ if !Symbol_Q(arr1[i]) {
+ return nil, errors.New("non-symbol bind value")
+ }
+ exp, e := EVAL(arr1[i+1], let_env)
+ if e != nil { return nil, e }
+ let_env.Set(arr1[i].(Symbol).Val, exp)
+ }
+ ast = a2
+ env = let_env
+ case "quote":
+ return a1, nil
+ case "quasiquote":
+ ast = quasiquote(a1)
+ case "defmacro!":
+ fn, e := EVAL(a2, env)
+ fn = fn.(MalFunc).SetMacro()
+ if e != nil { return nil, e }
+ return env.Set(a1.(Symbol).Val, fn), nil
+ case "macroexpand":
+ return macroexpand(a1, env)
+ case "do":
+ lst := ast.(List).Val
+ _, e := eval_ast(List{lst[1:len(lst)-1]}, env)
+ if e != nil { return nil, e }
+ if len(lst) == 1 { return nil, nil }
+ ast = lst[len(lst)-1]
+ case "if":
+ cond, e := EVAL(a1, env)
+ if e != nil { return nil, e }
+ if cond == nil || cond == false {
+ if len(ast.(List).Val) >= 4 {
+ ast = ast.(List).Val[3]
+ } else {
+ return nil, nil
+ }
+ } else {
+ ast = a2
+ }
+ case "fn*":
+ fn := MalFunc{EVAL, a2, env, a1, false,
+ func(outer EnvType, binds []MalType, exprs []MalType) (EnvType, error) {
+ return NewEnv(outer, binds, exprs) }}
+ return fn, nil
+ default:
+ el, e := eval_ast(ast, env)
+ if e != nil { return nil, e }
+ f := el.(List).Val[0]
+ if MalFunc_Q(f) {
+ fn := f.(MalFunc)
+ ast = fn.Exp
+ env, e = NewEnv(fn.Env, fn.Params.(List).Val, el.(List).Val[1:])
+ if e != nil { return nil, e }
+ } else {
+ fn, ok := f.(func([]MalType)(MalType, error))
+ if !ok { return nil, errors.New("attempt to call non-function") }
+ return fn(el.(List).Val[1:])
+ }
+ }
+
+ } // TCO loop
+}
+
+// print
+func PRINT(exp MalType) (string, error) {
+ return printer.Pr_str(exp, true), nil
+}
+
+
+var repl_env, _ = NewEnv(nil, nil, nil)
+
+// repl
+func rep(str string) (MalType, error) {
+ var exp MalType
+ var res string
+ var e error
+ if exp, e = READ(str); e != nil { return nil, e }
+ if exp, e = EVAL(exp, repl_env); e != nil { return nil, e }
+ if res, e = PRINT(exp); e != nil { return nil, e }
+ return res, nil
+}
+
+func main() {
+ // core.go: defined using go
+ for k, v := range core.NS {
+ repl_env.Set(k, v)
+ }
+ repl_env.Set("eval", func(a []MalType) (MalType, error) {
+ return EVAL(a[0], repl_env) })
+ repl_env.Set("*ARGV*", List{})
+
+ // core.mal: defined using the language itself
+ rep("(def! not (fn* (a) (if a false true)))")
+ rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
+
+ // called with mal script to load and eval
+ if len(os.Args) > 1 {
+ args := make([]MalType, 0, len(os.Args)-2)
+ for _,a := range os.Args[2:] {
+ args = append(args, a)
+ }
+ repl_env.Set("*ARGV*", List{args})
+ rep("(load-file \"" + os.Args[1] + "\")")
+ os.Exit(0)
+ }
+
+ rdr := bufio.NewReader(os.Stdin);
+ // repl loop
+ for {
+ fmt.Print("user> ");
+ text, err := rdr.ReadString('\n');
+ text = strings.TrimRight(text, "\n");
+ if (err != nil) {
+ return
+ }
+ var out MalType
+ var e error
+ if out, e = rep(text); e != nil {
+ if e.Error() == "<empty line>" { continue }
+ fmt.Printf("Error: %v\n", e)
+ continue
+ }
+ fmt.Printf("%v\n", out)
+ }
+}
diff --git a/go/src/types/types.go b/go/src/types/types.go
index f0ab427..c79810f 100644
--- a/go/src/types/types.go
+++ b/go/src/types/types.go
@@ -35,10 +35,12 @@ func Symbol_Q(obj MalType) bool {
// Functions
type MalFunc struct {
- Eval func(MalType, EnvType) (MalType, error)
- Exp MalType
- Env EnvType
- Params MalType
+ Eval func(MalType, EnvType) (MalType, error)
+ Exp MalType
+ Env EnvType
+ Params MalType
+ IsMacro bool
+ GenEnv func(EnvType, []MalType, []MalType) (EnvType, error)
}
func MalFunc_Q(obj MalType) bool {
@@ -48,6 +50,23 @@ func MalFunc_Q(obj MalType) bool {
}
}
+func (f MalFunc) SetMacro() MalType {
+ f.IsMacro = true
+ return f
+}
+
+func (f MalFunc) GetMacro() bool {
+ return f.IsMacro
+}
+
+func (f MalFunc) Apply(a []MalType) (MalType, error) {
+ slc, e := GetSlice(f.Params)
+ if e != nil { return nil, e }
+ env, e := f.GenEnv(f.Env, slc, a)
+ if e != nil { return nil, e }
+ return f.Eval(f.Exp, env)
+}
+
// Lists
type List struct {