slope/interpreter.go

package main

import (
	"fmt"
	"sort"
	"strings"
)

type proc struct {
	params expression
	body   expression
	en     *env
}

func eval(exp expression, en *env) (value expression) {
	switch e := exp.(type) {
	case symbol:
		value = en.Find(e).vars[e]
	case string:
		value = unescapeString(e)
	case bool, number:
		value = e
	case exception:
		if panicOnException {
			panic(string(e))
		}
		value = e
	case []expression:
		switch car, _ := e[0].(symbol); car {
		case "quote":
			if len(e) < 2 {
				value = exception("Invalid 'quote' syntax - too few arguments")
				break
			}
			value = e[1]
		case "if":
			if len(e) < 3 {
				value = exception("Invalid 'if' syntax - too few arguments")
				break
			}
			if AnythingToBool(eval(e[1], en)).(bool) {
				value = eval(e[2], en)
			} else if len(e) > 3 {
				value = eval(e[3], en)
			} else {
				value = make([]expression, 0)
			}
		case "and":
			if len(e) < 2 {
				value = exception("Invalid 'and' syntax - too few arguments")
				break
			}
		OuterAnd:
			for i := range e[1:] {
				switch item := e[i+1].(type) {
				case []expression:
					value = eval(item, en)
					if !AnythingToBool(value).(bool) {
						break OuterAnd
					}
				default:
					value = eval(item, en)
					if !AnythingToBool(value).(bool) {
						break OuterAnd
					}
				}
			}
		case "or":
			if len(e) < 2 {
				value = exception("Invalid 'or' syntax - too few arguments")
				break
			}
		OuterOr:
			for i := range e[1:] {
				switch item := e[i+1].(type) {
				case []expression:
					value = eval(item, en)
					if AnythingToBool(value).(bool) {
						break OuterOr
					}
				default:
					value = eval(item, en)
					if AnythingToBool(value).(bool) {
						break OuterOr
					}
				}
			}
		case "cond":
			if len(e) < 2 {
				value = exception("Invalid 'cond' syntax - too few arguments")
				break
			}
		CondLoop:
			for _, exp := range e[1:] {
				switch i := exp.(type) {
				case []expression:
					if len(i) < 2 {
						value = exception("Invalid 'cond' case, cases must take the form: `(<test> <expression>)")
						break CondLoop
					}
					if i[0] == "else" || i[0] == symbol("else") {
						value = eval(i[1], en)
						break CondLoop
					}
					if AnythingToBool(eval(i[0], en)).(bool) {
						value = eval(i[1], en)
						break CondLoop
					}
				default:
					value = exception("Invalid 'cond' case, cases must take the form: `(<test> <expression>)")
					break CondLoop
				}
			}
		case "set!":
			if len(e) < 3 {
				value = exception("Invalid 'set!' syntax - too few arguments")
				break
			}
			v, ok := e[1].(symbol)
			if !ok {
				value = exception("'set!' expected a symbol as its first argument, a non-symbol was provided")
				break
			}
			val := eval(e[2], en)
			en.Find(v).vars[v] = val
			value = val
		case "define":
			if len(e) < 3 {
				value = exception("Invalid 'define' syntax - too few arguments")
				break
			}
			if _, ok := e[1].(symbol); !ok {
				value = exception("'define' expects a symbol as its first argument")
				break
			}
			val := eval(e[2], en)
			en.vars[e[1].(symbol)] = val
			value = val
		case "lambda", "λ":
			if len(e) < 3 {
				value = exception("'lambda' expects at least three arguments")
				break
			}
			b := []expression{symbol("begin")}
			b = append(b, e[2:]...)
			value = proc{e[1], b, en}
		case "begin":
			for _, i := range e[1:] {
				value = eval(i, en)
			}
		case "begin0":
			for ii, i := range e[1:] {
				if ii == 0 {
					value = eval(i, en)
				} else {
					eval(i, en)
				}
			}
		case "usage":
			if len(e) < 2 {
				fmt.Print("(usage [[procedure: symbol]])\n\n\033[1;4mKnown procedures\033[0m\n\n")
				keys := make([]string, 0, len(usageStrings))
				var out strings.Builder
				for key, _ := range usageStrings {
					keys = append(keys, key)
				}
				sort.Strings(keys)
				for i := range keys {
					out.WriteString(fmt.Sprintf("%-26s", keys[i]))
					if (i+1)%2 == 0 {
						out.WriteRune('\n')
					}
				}
				fmt.Println(out.String())
				value = make([]expression, 0)
				break
			}
			proc, ok := e[1].(string)
			if !ok {
				p, ok2 := e[1].(symbol)
				if !ok2 {
					value = exception("'usage' expected a string or symbol as its first argument, a non-string non-symbol value was given")
				}
				proc = string(p)
			}
			v, ok := usageStrings[proc]
			if !ok {
				fmt.Printf("%q does not have a usage definition\n", proc)
			} else {
				fmt.Println(v)
			}
			value = make([]expression, 0)
		case "load":
			if en.outer != nil {
				value = expression("'load' is only callable from the global/top-level")
				break
			}
			for _, fp := range e[1:] {
				if _, ok := fp.(string); !ok {
					value = expression("'load' expects filepaths as a string, a non-string value was encountered")
					break
				}
			}
			loadFiles(e[1:])
			value = symbol("ok")
		case "load-mod":
			fullLoadEnv := env{make(map[symbol]expression), &globalenv}
			for _, fp := range e[1:] {
				if p, ok := fp.(string); !ok {
					panic("'load-mod' expects filepaths as a string, a non-string value was encountered")
				} else {
					modEnv, err := RunModule(p, false)
					if err != nil {
						panic(fmt.Errorf("'load-mod' failed loading module %s: %s", p, err.Error()))
					}
					for k, v := range modEnv.vars {
						fullLoadEnv.vars[k] = v
					}
				}
			}
			for k, v := range fullLoadEnv.vars {
				globalenv.vars[k] = v
			}
			value = symbol("ok")
		case "load-mod-file":
			fullLoadEnv := env{make(map[symbol]expression), &globalenv}
			for _, fp := range e[1:] {
				if p, ok := fp.(string); !ok {
					panic("'load-mod-file' expects relative filepaths as a string, a non-string value was encountered")
				} else {
					modEnv, err := RunModule(p, true)
					if err != nil {
						panic(fmt.Errorf("'load-mod-file' failed loading module %s: %s", p, err.Error()))
					}
					for k, v := range modEnv.vars {
						fullLoadEnv.vars[k] = v
					}
				}
			}
			for k, v := range fullLoadEnv.vars {
				globalenv.vars[k] = v
			}
			value = symbol("ok")
		case "filter":
			if len(e) < 3 {
				value = expression("'filter' expects two arguments: a procedure and an argument list, too few arguments were given")
				break
			}
			proc := eval(e[1], en)
			list, ok := eval(e[2], en).([]expression)
			if !ok {
				value = expression("'filter' expects a list as its second argument, a non-list value was given")
				break
			}
			val := make([]expression, 0)
			for i := range list {
				app := apply(proc, list[i:i+1])
				v := AnythingToBool(app).(bool)
				if v {
					val = append(val, list[i])
				}
			}
			value = val
		case "apply":
			if len(e) < 3 {
				value = expression("'apply' expects two arguments: a procedure and an argument list, too few arguments were given")
				break
			}
			args := eval(e[2], en)
			switch item := args.(type) {
			case []expression:
				value = apply(eval(e[1], en), item)
			default:
				value = apply(eval(e[1], en), []expression{item})
			}
		default:
			operands := e[1:]
			values := make([]expression, len(operands))
			for i, x := range operands {
				values[i] = eval(x, en)
			}
			value = apply(eval(e[0], en), values)
		}
	default:
		panic("Unknown expression type encountered during EVAL")
	}

	if e, ok := value.(exception); panicOnException && ok {
		panic(string(e))
	}
	return
}

func apply(procedure expression, args []expression) (value expression) {
	switch p := procedure.(type) {
	case func(...expression) expression:
		value = p(args...)
	case proc: // Mostly used by lambda
		en := &env{make(vars), p.en}
		switch params := p.params.(type) {
		case []expression:
			if len(params)-variadic(params) > len(args) {
				return expression(fmt.Sprintf("Lambda expected %d arguments but received %d", len(params), len(args)))
			}
			for i, param := range params {
				if param.(symbol) == symbol("args-list") {
					if len(args) >= len(params) {
						en.vars[param.(symbol)] = args[i:]
					} else {
						en.vars[param.(symbol)] = make([]expression, 0)
					}
					break
				}
				en.vars[param.(symbol)] = args[i]
			}
		default:
			en.vars[params.(symbol)] = args
		}
		value = eval(p.body, en)
	default:
		panic("Unknown procedure type encountered during APPLY")
	}
	return
}