slope/interpreter.go

package main

import (
	"fmt"
	"regexp"
	"sort"
	"strings"

	"git.rawtext.club/sloum/slope/termios"
)

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

func eval(exp expression, en *env) (value expression) {
	switch e := exp.(type) {
	case symbol:
		ex, err := en.Find(e)
		if err != nil {
			value = exception(err.Error())
		} else {
			value = ex.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
				}
			}
			if value == nil {
				value = make([]expression, 0)
			}
		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)
			ex, err := en.Find(v)
			if err != nil {
				value = exception(err.Error())
			} else {
				ex.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":
			var procSigRE = regexp.MustCompile(`(?s)(\()([^() ]+\b)([^)]*)(\))(?:(\s*=>)([^\n]*))?(.*)`)
			var replacer = "\033[40;33;1m$1\033[95m$2\033[92m$3\033[33m$4\033[94m$5\033[36m$6\033[0m$7"
			if len(e) < 2 {
				var out strings.Builder
				header := "(usage [[procedure: symbol]])\n\n\033[1;4mKnown procedures\033[0m\n\n"
				out.WriteString(procSigRE.ReplaceAllString(header, replacer))
				keys := make([]string, 0, len(usageStrings))
				for key, _ := range usageStrings {
					keys = append(keys, key)
				}

				var width int = 60
				if globalenv.vars[symbol("slope-interactive?")] != false {
					width, _ = termios.GetWindowSize()
				}
				printedWidth := 0
				sort.Strings(keys)
				for i := range keys {
					if printedWidth+26 >= width {
						out.WriteRune('\n')
						printedWidth = 0
					}
					out.WriteString(fmt.Sprintf("%-26s", keys[i]))
					printedWidth += 26
				}

				if len(moduleUsageStrings) > 0 {
					out.WriteString("\n\n\033[1;4mKnown modules\033[0m\n\n")
					for k, _ := range moduleUsageStrings {
						out.WriteString(k)
						out.WriteRune('\n')
					}
				}

				SysoutPrint(out.String(), Sysout)
				value = make([]expression, 0)
				break
			} else if len(e) == 2 {
				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")
						break
					}
					proc = string(p)
				}
				v, ok := usageStrings[proc]
				if !ok {
					SysoutPrint(fmt.Sprintf("%q does not have a usage definition\n", proc), Sysout)

				} else {
					SysoutPrint(fmt.Sprintf("%v\n\n", procSigRE.ReplaceAllString(v, replacer)), Sysout)
				}
			} else {
				module, ok := e[1].(string)
				if !ok {
					m, 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")
						break
					}
					module = string(m)
				}
				modMap, ok := moduleUsageStrings[module]
				if !ok {
					value = exception("'usage' expected a string or symbol representing the name of a loaded module as its first argument, there is no loaded module with the given name/value")
					break
				}
				funcName := String(e[2], false)
				if funcName == "" || funcName == "#f" {
					SysoutPrint(fmt.Sprintf("\033[1;4m%s's Known Procedures\033[0m\n\n", module), Sysout)

					for k := range modMap {
						SysoutPrint(fmt.Sprintf("%v\n", k), Sysout)
					}
				} else {
					subFunc, ok := modMap[funcName]
					if !ok {
						value = exception("'usage' could not find the requested symbol within the " + module + "module's usage data")
						break
					}
					SysoutPrint(fmt.Sprintf("%v\n", procSigRE.ReplaceAllString(subFunc, replacer)), Sysout)
				}
			}
			value = make([]expression, 0)
		case "load":
			if en.outer != nil {
				value = exception("'load' is only callable from the global/top-level")
				break
			}
			files := make([]expression, 0, len(e)-1)
			for _, fp := range e[1:] {
				var p string
				if _, ok := fp.([]expression); ok {
					p = String(eval(fp, en), false)
				} else {
					p = String(fp, false)
				}
				files = append(files, p)
			}
			loadFiles(files)
			value = symbol("ok")
		case "load-mod":
			fullLoadEnv := env{make(map[symbol]expression), &globalenv}
			for _, fp := range e[1:] {
				var p string
				if _, ok := fp.([]expression); ok {
					p = String(eval(fp, en), false)
				} else {
					p = String(fp, false)
				}
				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 {
					if k == "_USAGE" {
						// Add helper text if available
						helpOut := make(map[string]string)
						if val, ok := v.([]expression); ok {
							for _, helpPair := range val {
								switch p := helpPair.(type) {
								case []expression:
									if len(p) < 2 {
										break
									}
									helpOut[String(p[0], false)] = String(p[1], false)
								}
							}
						}
						if len(helpOut) > 0 {
							moduleUsageStrings[p] = helpOut
						}
					} else {
						// Otherwise add to the global symbol table
						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:] {
				var p string
				if _, ok := fp.([]expression); ok {
					p = String(eval(fp, en), false)
				} else {
					p = String(fp, false)
				}
				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 "exists?":
			if len(e) == 0 {
				value = exception("'exists?' expects at least one symbol or string, no values were given")
			}
			value = true
			var err error
			for i := range e {
				if i == 0 {
					continue
				}
				doPanic := panicOnException
				if doPanic {
					panicOnException = false
				}
				_, ok := e[i].([]expression)
				if ok {
					_, err = en.Find(symbol(String(eval(e[i], en), false)))
				} else {
					_, err = en.Find(symbol(String(e[i], false)))
				}
				if doPanic {
					panicOnException = true
				}
				if err != nil {
					value = false
					break
				}
			}
		case "apply":
			if len(e) < 3 {
				value = exception("'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})
			}
		case "eval":
			if len(e) < 1 {
				value = exception("'eval' expects a string and an optional boolean to indicate that a string should be parsed and evaluated, but was not given any arguments")
			}
			sParse := false
			if len(e) >= 3 {
				v, ok := e[2].(bool)
				if ok {
					sParse = v
				}
			}
			switch item := eval(e[1], en).(type) {
			case []expression:
				if _, ok := item[0].(symbol); !ok {
					value = item
				} else {
					value = eval(item, en)
					v, ok := value.(string)
					if ok && sParse {
						p := Parse(v)
						value = eval(p.([]expression)[0], en)
					}
				}
			case string:
				if sParse {
					p := Parse(item)
					if l, ok := p.([]expression)[0].([]expression); ok {
						if _, ok := l[0].(symbol); ok {
							value = eval(p.([]expression)[0], en)
						} else {
							value = l
						}
					} else {
						value = eval(l[0], en)
					}
				} else {
					value = item
				}
			default:
				value = 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 exception(fmt.Sprintf("Lambda expected %d arguments but received %d", len(params), len(args)))
			}
			for i, param := range params {
				if param.(symbol) == symbol("args-list") || param.(symbol) == symbol("...") {
					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: " + String(procedure, true))
	}
	return
}