Initial commit

10 files changed, 585 insertions, 0 deletions

diff --git a/src/CoreBindings.kt b/src/CoreBindings.kt
new file mode 100644
index 0000000..9213917
--- /dev/null
+++ b/src/CoreBindings.kt
@@ -0,0 +1,109 @@
+package moe.nea.lisp
+
+object CoreBindings {
+    val nil = LispData.LispNil
+    val def = LispData.externalRawCall { context, callsite, stackFrame, args ->
+        if (args.size != 2) {
+            return@externalRawCall context.reportError("Function define expects exactly two arguments", callsite)
+        }
+        val (name, value) = args
+        if (name !is LispAst.Reference) {
+            return@externalRawCall context.reportError("Define expects a name as first argument", name)
+        }
+        if (name.label in stackFrame.variables) {
+            return@externalRawCall context.reportError("Cannot redefine value in local context", name)
+        }
+        return@externalRawCall stackFrame.setValueLocal(name.label, context.resolveValue(stackFrame, value))
+    }
+
+    val pure = LispData.externalCall { args, reportError ->
+        return@externalCall args.singleOrNull()?.let { value ->
+            LispData.externalCall { args, reportError ->
+                if (args.isNotEmpty())
+                    reportError("Pure function does not expect arguments")
+                else
+                    value
+            }
+        } ?: reportError("Function pure expects exactly one argument")
+    }
+
+    val lambda = LispData.externalRawCall { context, callsite, stackFrame, args ->
+        if (args.size != 2) {
+            return@externalRawCall context.reportError("Lambda needs exactly 2 arguments", callsite)
+        }
+        val (argumentNames, body) = args
+        if (argumentNames !is LispAst.Parenthesis) {
+            return@externalRawCall context.reportError("Lambda has invalid argument declaration", argumentNames)
+        }
+        val argumentNamesString = argumentNames.items.map {
+            val ref = it as? LispAst.Reference
+            if (ref == null) {
+                return@externalRawCall context.reportError("Lambda has invalid argument declaration", it)
+            }
+            ref.label
+        }
+        if (body !is LispAst.Parenthesis) {
+            return@externalRawCall context.reportError("Lambda has invalid body declaration", body)
+        }
+        LispData.createLambda(stackFrame, argumentNamesString, body)
+    }
+
+    val defun = LispData.externalRawCall { context, callSite, stackFrame, lispAsts ->
+        if (lispAsts.size != 3) {
+            return@externalRawCall context.reportError("Invalid function definition", callSite)
+        }
+        val (name, args, body) = lispAsts
+        if (name !is LispAst.Reference) {
+            return@externalRawCall context.reportError("Invalid function definition name", name)
+        }
+        if (name.label in stackFrame.variables) {
+            return@externalRawCall context.reportError("Cannot redefine function in local context", name)
+        }
+        if (args !is LispAst.Parenthesis) {
+            return@externalRawCall context.reportError("Invalid function definition arguments", args)
+        }
+        val argumentNames = args.items.map {
+            val ref = it as? LispAst.Reference
+                ?: return@externalRawCall context.reportError("Invalid function definition argument name", it)
+            ref.label
+        }
+        if (body !is LispAst.Parenthesis) {
+            return@externalRawCall context.reportError("Invalid function definition body", body)
+        }
+        return@externalRawCall stackFrame.setValueLocal(
+            name.label,
+            LispData.createLambda(stackFrame, argumentNames, body, name.label)
+        )
+    }
+    val seq = LispData.externalRawCall { context, callsite, stackFrame, args ->
+        var lastResult: LispData? = null
+        for (arg in args) {
+            lastResult = context.executeLisp(stackFrame, arg)
+        }
+        lastResult ?: context.reportError("Seq cannot be invoked with 0 argumens", callsite)
+    }
+    val debuglog = LispData.externalRawCall { context, callsite, stackFrame, args ->
+        println(args.joinToString(" ") { arg ->
+            when (val resolved = context.resolveValue(stackFrame, arg)) {
+                is LispData.Atom -> ":${resolved.label}"
+                is LispData.JavaExecutable -> "<native code>"
+                LispData.LispNil -> "nil"
+                is LispData.LispNumber -> resolved.number.toString()
+                is LispData.LispNode -> resolved.node.toSource()
+                is LispData.LispObject<*> -> resolved.data.toString()
+                is LispData.LispInterpretedCallable -> "<function ${resolved.name ?: ""} ${resolved.argNames} ${resolved.body.toSource()}>"
+            }
+        })
+        LispData.LispNil
+    }
+
+    fun offerAllTo(bindings: StackFrame) {
+        bindings.setValueLocal("nil", nil)
+        bindings.setValueLocal("def", def)
+        bindings.setValueLocal("pure", pure)
+        bindings.setValueLocal("lambda", lambda)
+        bindings.setValueLocal("defun", defun)
+        bindings.setValueLocal("seq", seq)
+        bindings.setValueLocal("debuglog", debuglog)
+    }
+}
\ No newline at end of file
diff --git a/src/LispAst.kt b/src/LispAst.kt
new file mode 100644
index 0000000..79fee8a
--- /dev/null
+++ b/src/LispAst.kt
@@ -0,0 +1,41 @@
+package moe.nea.lisp
+
+sealed class LispAst : HasLispPosition {
+
+
+    abstract fun toSource(): String
+
+
+    data class Program(override val position: LispPosition, val nodes: List<LispNode>) : LispAst() {
+        override fun toSource(): String {
+            return nodes.joinToString("\n") {
+                it.toSource()
+            }
+        }
+    }
+
+    sealed class LispNode : LispAst()
+    data class Atom(override val position: LispPosition, val label: String) : LispNode() {
+        override fun toSource(): String {
+            return ":$label"
+        }
+    }
+
+    data class Reference(override val position: LispPosition, val label: String) : LispNode() {
+        override fun toSource(): String {
+            return label
+        }
+    }
+
+    data class Parenthesis(override val position: LispPosition, val items: List<LispNode>) : LispNode() {
+        override fun toSource(): String {
+            return items.joinToString(" ", "(", ")") { it.toSource() }
+        }
+    }
+
+    data class StringLiteral(override val position: LispPosition, val parsedString: String) : LispNode() {
+        override fun toSource(): String {
+            return "\"${parsedString.replace("\\", "\\\\").replace("\"", "\\\"")}\"" // TODO: better escaping
+        }
+    }
+}
diff --git a/src/LispData.kt b/src/LispData.kt
new file mode 100644
index 0000000..1f13ad3
--- /dev/null
+++ b/src/LispData.kt
@@ -0,0 +1,105 @@
+package moe.nea.lisp
+
+sealed class LispData {
+
+    fun <T : Any> lispCastObject(lClass: LispClass<T>): LispObject<T>? {
+        if (this !is LispObject<*>) return null
+        if (this.handler != lClass) return null
+        return this as LispObject<T>
+    }
+
+    object LispNil : LispData()
+    data class Atom(val label: String) : LispData()
+    data class LispNode(val node: LispAst.LispNode) : LispData()
+    data class LispNumber(val number: Double) : LispData()
+    data class LispObject<T : Any>(val data: T, val handler: LispClass<T>) : LispData()
+    sealed class LispExecutable() : LispData() {
+        abstract fun execute(
+            executionContext: LispExecutionContext,
+            callsite: LispAst.LispNode,
+            stackFrame: StackFrame,
+            args: List<LispAst.LispNode>
+        ): LispData
+    }
+
+
+    abstract class JavaExecutable : LispExecutable() {
+    }
+
+    data class LispInterpretedCallable(
+        val declarationStackFrame: StackFrame,
+        val argNames: List<String>,
+        val body: LispAst.Parenthesis,
+        val name: String?,
+    ) : LispExecutable() {
+        override fun execute(
+            executionContext: LispExecutionContext,
+            callsite: LispAst.LispNode,
+            stackFrame: StackFrame,
+            args: List<LispAst.LispNode>
+        ): LispData {
+            if (argNames.size != args.size) {
+                TODO("ERROR")
+            }
+            val invocationFrame = declarationStackFrame.fork()
+
+            for ((name, value) in argNames.zip(args)) {
+                invocationFrame.setValueLocal(name, executionContext.resolveValue(stackFrame, value))
+            }
+            return executionContext.executeLisp(invocationFrame, body)
+        }
+    }
+
+    interface LispClass<T : Any> {
+        fun access(obj: T, name: String): LispData
+        fun instantiate(obj: T) = LispObject(obj, this)
+    }
+
+    object LispStringClass : LispClass<String> {
+        override fun access(obj: String, name: String): LispData {
+            return LispNil
+        }
+    }
+
+    companion object {
+        fun string(value: String): LispObject<String> =
+            LispStringClass.instantiate(value)
+
+        fun externalRawCall(callable: (context: LispExecutionContext, callsite: LispAst.LispNode, stackFrame: StackFrame, args: List<LispAst.LispNode>) -> LispData): LispExecutable {
+            return object : JavaExecutable() {
+                override fun execute(
+                    executionContext: LispExecutionContext,
+                    callsite: LispAst.LispNode,
+                    stackFrame: StackFrame,
+                    args: List<LispAst.LispNode>
+                ): LispData {
+                    return callable.invoke(executionContext, callsite, stackFrame, args)
+                }
+            }
+        }
+
+        fun externalCall(callable: (args: List<LispData>, reportError: (String) -> LispData) -> LispData): LispExecutable {
+            return object : JavaExecutable() {
+                override fun execute(
+                    executionContext: LispExecutionContext,
+                    callsite: LispAst.LispNode,
+                    stackFrame: StackFrame,
+                    args: List<LispAst.LispNode>
+                ): LispData {
+                    val mappedArgs = args.map { executionContext.resolveValue(stackFrame, it) }
+                    return callable.invoke(mappedArgs) { executionContext.reportError(it, callsite) }
+                }
+            }
+        }
+
+
+        fun createLambda(
+            declarationStackFrame: StackFrame,
+            args: List<String>,
+            body: LispAst.Parenthesis,
+            nameHint: String? = null,
+        ): LispExecutable {
+            return LispInterpretedCallable(declarationStackFrame, args, body, nameHint)
+        }
+    }
+}
diff --git a/src/LispErrorReporter.kt b/src/LispErrorReporter.kt
new file mode 100644
index 0000000..d9ad148
--- /dev/null
+++ b/src/LispErrorReporter.kt
@@ -0,0 +1,15 @@
+package moe.nea.lisp
+
+class LispErrorReporter {
+
+    data class LispError(val name: String, val position: LispPosition)
+
+
+    val errors = listOf<LispError>()
+
+    fun reportError(name: String, position: HasLispPosition) {
+        println("LISP ERROR: $name at ${position.position}")
+    }
+
+
+}
diff --git a/src/LispExecutionContext.kt b/src/LispExecutionContext.kt
new file mode 100644
index 0000000..f169ba9
--- /dev/null
+++ b/src/LispExecutionContext.kt
@@ -0,0 +1,61 @@
+package moe.nea.lisp
+
+class LispExecutionContext() {
+
+    private val errorReporter = LispErrorReporter()
+    private val rootStackFrame = StackFrame(null)
+
+
+    fun reportError(name: String, position: HasLispPosition): LispData.LispNil {
+        println("Error: $name ${position.position}")
+        return LispData.LispNil
+    }
+
+
+    fun genBindings(): StackFrame {
+        return StackFrame(rootStackFrame)
+    }
+
+    fun executeProgram(stackFrame: StackFrame, program: LispAst.Program) {
+        for (node in program.nodes) {
+            executeLisp(stackFrame, node)
+        }
+    }
+
+
+    fun executeLisp(stackFrame: StackFrame, node: LispAst.LispNode): LispData {
+        when (node) {
+            is LispAst.Parenthesis -> {
+                val first = node.items.firstOrNull()
+                    ?: return reportError("Cannot execute empty parenthesis ()", node)
+
+                val rest = node.items.drop(1)
+                return when (val resolvedValue = resolveValue(stackFrame, first)) {
+                    is LispData.Atom -> reportError("Cannot execute atom", node)
+                    LispData.LispNil -> reportError("Cannot execute nil", node)
+                    is LispData.LispNumber -> reportError("Cannot execute number", node)
+                    is LispData.LispNode -> reportError("Cannot execute node", node)
+                    is LispData.LispObject<*> -> reportError("Cannot execute object-value", node)
+                    is LispData.LispExecutable -> {
+                        resolvedValue.execute(this, node, stackFrame, rest)
+                    }
+                }
+
+            }
+
+            else -> return reportError("Expected invocation", node)
+        }
+    }
+
+    fun resolveValue(stackFrame: StackFrame, node: LispAst.LispNode): LispData {
+        return when (node) {
+            is LispAst.Atom -> LispData.Atom(node.label)
+            is LispAst.Parenthesis -> executeLisp(stackFrame, node)
+            is LispAst.Reference -> stackFrame.resolveReference(node.label)
+                ?: reportError("Could not resolve variable ${node.label}", node)
+
+            is LispAst.StringLiteral -> LispData.string(node.parsedString)
+        }
+    }
+}
+
diff --git a/src/LispParser.kt b/src/LispParser.kt
new file mode 100644
index 0000000..1117397
--- /dev/null
+++ b/src/LispParser.kt
@@ -0,0 +1,116 @@
+package moe.nea.lisp
+
+import java.io.File
+
+class LispParser private constructor(filename: String, string: String) {
+    val racer = StringRacer(filename, string)
+    val program = parseProgram()
+
+    companion object {
+        fun parse(filename: String, string: String): LispAst.Program {
+            return LispParser(filename, string).program
+        }
+        fun parse(file: File): LispAst.Program {
+            return parse(file.absolutePath, file.readText())
+        }
+
+        val digits = "1234567890"
+        val alphabet = "abcdefghijklmnopqrstuvwxyz"
+        val validStartingIdentifiers = "-.#+*'!$%&/=?_~|^" + alphabet + alphabet.uppercase()
+        val validIdentifiers = validStartingIdentifiers + digits
+        val parenthesisMatches = mapOf(
+            "(" to ")",
+            "[" to "]",
+            "{" to "}",
+            "<" to ">",
+        )
+    }
+
+    fun parseProgram(): LispAst.Program {
+        val start = racer.idx
+        val nodes = mutableListOf<LispAst.LispNode>()
+        while (true) {
+            racer.skipWhitespace()
+            if (racer.finished())
+                break
+            nodes.add(parseNode())
+        }
+        return LispAst.Program(racer.span(start), nodes)
+    }
+
+    private fun parseNode(): LispAst.LispNode {
+        val start = racer.idx
+        val paren = racer.peekReq(1) ?: racer.error("Expected start of expression")
+        val matchingParen = parenthesisMatches[paren]
+        if (matchingParen != null) {
+            val paren = parseParenthesis(paren, matchingParen)
+            return LispAst.Parenthesis(racer.span(start), paren)
+        }
+        if (paren == "\"") {
+            return parseString()
+        }
+        if (paren == ":") {
+            return parseAtom()
+        }
+        val ident = parseIdentifier()
+        return LispAst.Reference(racer.span(start), ident)
+    }
+
+
+    fun parseAtom(): LispAst.Atom {
+        val start = racer.idx
+        racer.expect(":", "Expected : at start of atom")
+        val ident = parseIdentifier()
+        return LispAst.Atom(racer.span(start), ident)
+    }
+
+
+    fun parseIdentifier(): String {
+        return racer.consumeWhile { it.first() in validStartingIdentifiers && it.last() in validIdentifiers }.also {
+            if (it.isEmpty()) racer.error("Expected identifier")
+        }
+    }
+
+    fun parseString(): LispAst.StringLiteral {
+        val start = racer.idx
+        val quoted = parseQuotedString()
+        return LispAst.StringLiteral(racer.span(start), quoted)
+    }
+
+    fun parseQuotedString(): String {
+        racer.expect("\"", "Expected '\"' at string start")
+        val sb = StringBuilder()
+        while (true) {
+            when (val peek = racer.consumeCountReq(1)) {
+                "\"" -> break
+                "\\" -> {
+                    val escaped = racer.consumeCountReq(1) ?: racer.error("Unfinished backslash escape")
+                    if (escaped != "\"" && escaped != "\\") {
+                        // Surprisingly i couldn't find unicode escapes to be generated by the original minecraft 1.8.9 implementation
+                        racer.idx--
+                        racer.error("Invalid backslash escape '$escaped'")
+                    }
+                    sb.append(escaped)
+                }
+
+                null -> racer.error("Unfinished string")
+                else -> {
+                    sb.append(peek)
+                }
+            }
+        }
+        return sb.toString()
+    }
+
+    private fun parseParenthesis(opening: String, closing: String): List<LispAst.LispNode> {
+        val l = mutableListOf<LispAst.LispNode>()
+        racer.expect(opening, "Expected $opening")
+        while (true) {
+            racer.skipWhitespace()
+            if (racer.tryConsume(closing)) {
+                return l
+            }
+            l.add(parseNode())
+        }
+    }
+}
diff --git a/src/LispParsingError.kt b/src/LispParsingError.kt
new file mode 100644
index 0000000..f6e76de
--- /dev/null
+++ b/src/LispParsingError.kt
@@ -0,0 +1,4 @@
+package moe.nea.lisp
+
+data class LispParsingError(val baseString: String, val offset: Int, val mes0: String) :
+    Exception("$mes0 at $offset in `$baseString`.")
\ No newline at end of file
diff --git a/src/LispPosition.kt b/src/LispPosition.kt
new file mode 100644
index 0000000..ea901a2
--- /dev/null
+++ b/src/LispPosition.kt
@@ -0,0 +1,21 @@
+package moe.nea.lisp
+
+data class LispPosition(
+    val start: Int,
+    val end: Int,
+    val fileName: String,
+    val fileContent: String,
+) : HasLispPosition {
+    val startLine by lazy { fileContent.substring(0, start).count { it == '\n' } + 1 }
+    val startColumn by lazy { start - fileContent.substring(0, start).indexOfLast { it == '\n' } }
+    val endLine by lazy { fileContent.substring(0, end).count { it == '\n' } + 1 }
+    val endColumn by lazy { end - fileContent.substring(0, end).indexOfLast { it == '\n' } }
+    override val position get() = this
+    override fun toString(): String {
+        return "at $fileName:$startLine:$startColumn until $endLine:$endColumn"
+    }
+}
+
+interface HasLispPosition {
+    val position: LispPosition
+}
diff --git a/src/StackFrame.kt b/src/StackFrame.kt
new file mode 100644
index 0000000..66d74b2
--- /dev/null
+++ b/src/StackFrame.kt
@@ -0,0 +1,32 @@
+package moe.nea.lisp
+
+class StackFrame(val parent: StackFrame?) {
+
+    val variables = mutableMapOf<String, LispData>()
+
+    interface MetaKey<T>
+
+    private val meta: MutableMap<MetaKey<*>, Any> = mutableMapOf()
+
+    fun <T : Any> getMeta(key: MetaKey<T>): T? {
+        return meta[key] as? T
+    }
+
+    fun <T : Any> setMeta(key: MetaKey<T>, value: T) {
+        meta[key] = value
+    }
+
+    fun resolveReference(label: String): LispData? =
+        variables[label] ?: parent?.resolveReference(label)
+
+    fun setValueLocal(label: String, value: LispData): LispData {
+        variables[label] = value
+        return value
+    }
+
+    fun fork(): StackFrame {
+        return StackFrame(this)
+    }
+
+
+}
diff --git a/src/StringRacer.kt b/src/StringRacer.kt
new file mode 100644
index 0000000..d0a4a15
--- /dev/null
+++ b/src/StringRacer.kt
@@ -0,0 +1,81 @@
+package moe.nea.lisp
+
+import java.util.*
+
+class StringRacer(val filename: String, val backing: String) {
+    var idx = 0
+    val stack = Stack<Int>()
+
+    fun pushState() {
+        stack.push(idx)
+    }
+
+    fun popState() {
+        idx = stack.pop()
+    }
+
+    fun span(start: Int) = LispPosition(start, idx, filename, backing)
+
+    fun discardState() {
+        stack.pop()
+    }
+
+    fun peek(count: Int): String {
+        return backing.substring(minOf(idx, backing.length), minOf(idx + count, backing.length))
+    }
+
+    fun finished(): Boolean {
+        return peek(1).isEmpty()
+    }
+
+    fun peekReq(count: Int): String? {
+        val p = peek(count)
+        if (p.length != count)
+            return null
+        return p
+    }
+
+    fun consumeCountReq(count: Int): String? {
+        val p = peekReq(count)
+        if (p != null)
+            idx += count
+        return p
+    }
+
+    fun tryConsume(string: String): Boolean {
+        val p = peek(string.length)
+        if (p != string)
+            return false
+        idx += p.length
+        return true
+    }
+
+    fun consumeWhile(shouldConsumeThisString: (String) -> Boolean): String {
+        var lastString: String = ""
+        while (true) {
+            val nextPart = peek(1)
+            if (nextPart.isEmpty()) break
+            val nextString = lastString + nextPart
+            if (!shouldConsumeThisString(nextString)) {
+                break
+            }
+            idx++
+            lastString = nextString
+        }
+        return lastString
+    }
+
+    fun expect(search: String, errorMessage: String) {
+        if (!tryConsume(search))
+            error(errorMessage)
+    }
+
+    fun error(errorMessage: String): Nothing {
+        throw LispParsingError(backing, idx, errorMessage)
+    }
+
+    fun skipWhitespace() {
+        consumeWhile { Character.isWhitespace(it.last()) }
+    }
+}
+