From 3fad8cb4e08ff7b925064c8ecb4e7cde2fabfd0a Mon Sep 17 00:00:00 2001 From: Cursor Agent Date: Fri, 28 Aug 2026 09:35:17 +0000 Subject: [PATCH] Add Kotoba binding for node types and fixture tree walk Kotoba cannot FFI libtree-sitter. This adds lib/binding_kotoba as a host-facing node/tree/cursor API plus EDN node-types and a vendored CST fixture that compiles to Wasm with kotoba v0.7.2. Co-authored-by: Jun Kawasaki <04.feasts_minded@icloud.com> --- .github/workflows/kotoba.yml | 41 +++ README.md | 1 + docs/src/index.md | 1 + lib/README.md | 1 + lib/binding_kotoba/README.md | 58 ++++ .../examples/walk_fixture.kotoba | 2 + lib/binding_kotoba/fixtures/node-types.edn | 23 ++ lib/binding_kotoba/fixtures/tree.edn | 20 ++ lib/binding_kotoba/scripts/bundle.sh | 13 + lib/binding_kotoba/scripts/ci.sh | 53 +++ lib/binding_kotoba/scripts/run-fixtures.mjs | 45 +++ lib/binding_kotoba/src/tree_sitter.kotoba | 320 ++++++++++++++++++ lib/binding_kotoba/test/fixtures.kotoba | 171 ++++++++++ 13 files changed, 749 insertions(+) create mode 100644 .github/workflows/kotoba.yml create mode 100644 lib/binding_kotoba/README.md create mode 100644 lib/binding_kotoba/examples/walk_fixture.kotoba create mode 100644 lib/binding_kotoba/fixtures/node-types.edn create mode 100644 lib/binding_kotoba/fixtures/tree.edn create mode 100755 lib/binding_kotoba/scripts/bundle.sh create mode 100755 lib/binding_kotoba/scripts/ci.sh create mode 100644 lib/binding_kotoba/scripts/run-fixtures.mjs create mode 100644 lib/binding_kotoba/src/tree_sitter.kotoba create mode 100644 lib/binding_kotoba/test/fixtures.kotoba diff --git a/.github/workflows/kotoba.yml b/.github/workflows/kotoba.yml new file mode 100644 index 000000000..6c03abd4c --- /dev/null +++ b/.github/workflows/kotoba.yml @@ -0,0 +1,41 @@ +name: Kotoba binding + +on: + push: + paths: + - lib/binding_kotoba/** + - .github/workflows/kotoba.yml + pull_request: + paths: + - lib/binding_kotoba/** + - .github/workflows/kotoba.yml + +permissions: + contents: read + +jobs: + kotoba: + name: kotoba compile + fixtures + runs-on: ubuntu-24.04 + steps: + - uses: actions/checkout@v4 + + - name: Install kotoba v0.7.2 + shell: bash + run: | + set -euo pipefail + release_dir="$RUNNER_TEMP/kotoba-v0.7.2" + cli_dir="$RUNNER_TEMP/kotoba-cli" + mkdir -p "$release_dir" "$cli_dir" + curl -L --fail --silent --show-error \ + -o "$release_dir/kotoba-linux-amd64.tar.gz" \ + https://github.com/kotoba-lang/kotoba/releases/download/v0.7.2/kotoba-linux-amd64.tar.gz + curl -L --fail --silent --show-error \ + -o "$release_dir/kotoba-linux-amd64.tar.gz.sha256" \ + https://github.com/kotoba-lang/kotoba/releases/download/v0.7.2/kotoba-linux-amd64.tar.gz.sha256 + (cd "$release_dir" && sha256sum -c kotoba-linux-amd64.tar.gz.sha256) + tar -xzf "$release_dir/kotoba-linux-amd64.tar.gz" -C "$cli_dir" + echo "$cli_dir" >> "$GITHUB_PATH" + + - name: Compile wasm and run fixtures + run: lib/binding_kotoba/scripts/ci.sh diff --git a/README.md b/README.md index b347c880c..ba6c339e2 100644 --- a/README.md +++ b/README.md @@ -15,6 +15,7 @@ Tree-sitter is a parser generator tool and an incremental parsing library. It ca - [Documentation](https://tree-sitter.github.io) - [Rust binding](lib/binding_rust/README.md) - [Wasm binding](lib/binding_web/README.md) +- [Kotoba binding](lib/binding_kotoba/README.md) - [Command-line interface](crates/cli/README.md) [discord]: https://img.shields.io/discord/1063097320771698699?logo=discord&label=discord diff --git a/docs/src/index.md b/docs/src/index.md index ee92966a5..eb5e1fea7 100644 --- a/docs/src/index.md +++ b/docs/src/index.md @@ -26,6 +26,7 @@ There are bindings that allow Tree-sitter to be used from the following language - [JavaScript (Node.js)](https://github.com/tree-sitter/node-tree-sitter) - [JavaScript (Wasm)](https://github.com/tree-sitter/tree-sitter/tree/master/lib/binding_web) - [Kotlin](https://github.com/tree-sitter/kotlin-tree-sitter) +- [Kotoba (Wasm fixture)](https://github.com/tree-sitter/tree-sitter/tree/master/lib/binding_kotoba) - [Python](https://github.com/tree-sitter/py-tree-sitter) - [Rust](https://github.com/tree-sitter/tree-sitter/tree/master/lib/binding_rust) - [Swift](https://github.com/tree-sitter/swift-tree-sitter) diff --git a/lib/README.md b/lib/README.md index 231fe2abb..8db699517 100644 --- a/lib/README.md +++ b/lib/README.md @@ -4,3 +4,4 @@ * [`include`](./include) - C headers for the Tree-sitter library * [`binding_rust`](./binding_rust) - Rust bindings to the Tree-sitter library * [`binding_web`](./binding_web) - JavaScript bindings to the Tree-sitter library, using WebAssembly +* [`binding_kotoba`](./binding_kotoba) - Kotoba host-facing node/tree/cursor API (Wasm fixture; no C FFI) diff --git a/lib/binding_kotoba/README.md b/lib/binding_kotoba/README.md new file mode 100644 index 000000000..f886da794 --- /dev/null +++ b/lib/binding_kotoba/README.md @@ -0,0 +1,58 @@ +# Kotoba Tree-sitter + +Kotoba bindings for the host-facing Tree-sitter **node / tree / cursor** +shape. They compile with [kotoba](https://github.com/kotoba-lang/kotoba) +v0.7.2 to Wasm. + +## What this is + +Kotoba cannot FFI `libtree-sitter`. This tree does **not** rewrite the C +parser and does **not** pretend to parse source. v1 is: + +1. A host-facing API (`node-*`, `tree-*`, `cursor-*`) whose documents match + the C/Rust/Web accessors (`type`, `named`, byte/point span, children, + field names, S-expression). +2. An EDN encoding of [static node types](../../docs/src/using-parsers/6-static-node-types.md) + (`fixtures/node-types.edn`). +3. A walk over a **vendored** CST fixture (`fixtures/tree.edn`) for + `x = 1`. + +A host that *can* call the C library may inject a tree document with the +same keys. `host-can-parse?` returns `0` until that capability exists. + +## Build + +Requires kotoba **v0.7.2**. + +```sh +kotoba compile lib/binding_kotoba/src/tree_sitter.kotoba --target wasm --output tree_sitter.wasm --json +``` + +Accept `kotoba.cli/ok?` true and `kotoba.cli/code` `emitted`. The artifact +must start with Wasm magic `\0asm`. + +```sh +lib/binding_kotoba/scripts/ci.sh +``` + +`require` is not admitted, so examples and tests are bundled onto the +single compilation unit. + +## Fixture + +Source: `x = 1` + +``` +(source_file (assignment (identifier) "=" (number))) +``` + +| id | type | named | field | span | +|----|------|-------|-------|------| +| 0 | source_file | yes | | 0–5 | +| 1 | assignment | yes | | 0–5 | +| 2 | identifier | yes | left | 0–1 | +| 3 | `=` | no | | 2–3 | +| 4 | number | yes | right | 4–5 | + +Walk with `cursor-goto-first-child` / `cursor-goto-next-sibling` / +`cursor-goto-parent`, or with `node-child` / `node-child-by-field-name`. diff --git a/lib/binding_kotoba/examples/walk_fixture.kotoba b/lib/binding_kotoba/examples/walk_fixture.kotoba new file mode 100644 index 000000000..2fda85772 --- /dev/null +++ b/lib/binding_kotoba/examples/walk_fixture.kotoba @@ -0,0 +1,2 @@ +(defn main [] :string + (node-sexp (fixture-tree) (tree-root (fixture-tree)))) diff --git a/lib/binding_kotoba/fixtures/node-types.edn b/lib/binding_kotoba/fixtures/node-types.edn new file mode 100644 index 000000000..881d68213 --- /dev/null +++ b/lib/binding_kotoba/fixtures/node-types.edn @@ -0,0 +1,23 @@ +;; Static node types for the vendored fixture grammar. +;; Shape matches tree-sitter node-types.json (type, named, fields, children, types). +;; This is a catalog, not a parser. +[{:type "source_file" + :named true + :fields {} + :children {:multiple true + :required true + :types [{:type "assignment" :named true}]}} + {:type "assignment" + :named true + :fields {:left {:multiple false + :required true + :types [{:type "identifier" :named true}]} + :right {:multiple false + :required true + :types [{:type "number" :named true}]}} + :children {:multiple true + :required false + :types [{:type "=" :named false}]}} + {:type "identifier" :named true} + {:type "number" :named true} + {:type "=" :named false}] diff --git a/lib/binding_kotoba/fixtures/tree.edn b/lib/binding_kotoba/fixtures/tree.edn new file mode 100644 index 000000000..a043a98de --- /dev/null +++ b/lib/binding_kotoba/fixtures/tree.edn @@ -0,0 +1,20 @@ +;; Vendored CST for source "x = 1". Not produced by libtree-sitter. +;; Node ids are vector indices. parent -1 is the root. +{:source "x = 1" + :root-id 0 + :nodes + [{:id 0 :parent -1 :type "source_file" :named 1 + :start-byte 0 :end-byte 5 :start-row 0 :start-column 0 + :end-row 0 :end-column 5 :field "" :children [1]} + {:id 1 :parent 0 :type "assignment" :named 1 + :start-byte 0 :end-byte 5 :start-row 0 :start-column 0 + :end-row 0 :end-column 5 :field "" :children [2 3 4]} + {:id 2 :parent 1 :type "identifier" :named 1 + :start-byte 0 :end-byte 1 :start-row 0 :start-column 0 + :end-row 0 :end-column 1 :field "left" :children []} + {:id 3 :parent 1 :type "=" :named 0 + :start-byte 2 :end-byte 3 :start-row 0 :start-column 2 + :end-row 0 :end-column 3 :field "" :children []} + {:id 4 :parent 1 :type "number" :named 1 + :start-byte 4 :end-byte 5 :start-row 0 :start-column 4 + :end-row 0 :end-column 5 :field "right" :children []}]} diff --git a/lib/binding_kotoba/scripts/bundle.sh b/lib/binding_kotoba/scripts/bundle.sh new file mode 100755 index 000000000..54668bddc --- /dev/null +++ b/lib/binding_kotoba/scripts/bundle.sh @@ -0,0 +1,13 @@ +#!/bin/sh +# Concatenate tree_sitter.kotoba with a guest file. Kotoba admits one ns per +# unit and has no require, so examples/tests are guests appended to the library. +set -eu +root=$(CDPATH= cd -- "$(dirname "$0")/.." && pwd) +out=${1:?"usage: bundle.sh "} +guest=${2:?"usage: bundle.sh "} +extra=$(grep -E '^\(defn ' "$guest" | sed -E 's/^\(defn ([^ ]+).*/\1/' | tr '\n' ' ' | sed 's/[[:space:]]*$//') +{ + sed -E "s/\\(:export \\[/(:export [${extra} /" "$root/src/tree_sitter.kotoba" + printf '\n;; ---- guest ----\n' + cat "$guest" +} >"$out" diff --git a/lib/binding_kotoba/scripts/ci.sh b/lib/binding_kotoba/scripts/ci.sh new file mode 100755 index 000000000..7b2f64bda --- /dev/null +++ b/lib/binding_kotoba/scripts/ci.sh @@ -0,0 +1,53 @@ +#!/bin/sh +# Compile the Kotoba binding to wasm and run fixture tests on the web target. +set -eu +root=$(CDPATH= cd -- "$(dirname "$0")/.." && pwd) +cd "$root" + +if ! command -v kotoba >/dev/null 2>&1; then + echo "kotoba CLI is required (kotoba-lang/kotoba v0.7.2)" >&2 + exit 1 +fi + +compile_wasm() { + src=$1 + out=$2 + json=$(kotoba compile "$src" --target wasm --output "$out" --json) + echo "$json" | python3 -c ' +import json,sys +d=json.load(sys.stdin) +ok=d.get("kotoba.cli/ok?") +code=d.get("kotoba.cli/code") +print(sys.argv[1], ok, code, d.get("kotoba.cli/message") or "") +if not ok or code != "emitted": + sys.exit(1) +' "$src" + python3 -c ' +import sys +b=open(sys.argv[1],"rb").read() +if b[:4] != b"\x00asm": + print("not wasm magic", sys.argv[1], file=sys.stderr) + sys.exit(1) +' "$out" +} + +mkdir -p /tmp/binding-kotoba-ci +compile_wasm src/tree_sitter.kotoba /tmp/binding-kotoba-ci/tree_sitter.wasm + +for guest in examples/walk_fixture.kotoba test/fixtures.kotoba; do + bundled=/tmp/binding-kotoba-ci/$(basename "$guest") + scripts/bundle.sh "$bundled" "$guest" + compile_wasm "$bundled" "/tmp/binding-kotoba-ci/$(basename "$guest" .kotoba).wasm" +done + +scripts/bundle.sh /tmp/binding-kotoba-ci/fixtures.kotoba test/fixtures.kotoba +web_json=$(kotoba compile /tmp/binding-kotoba-ci/fixtures.kotoba --target web --output /tmp/binding-kotoba-ci/fixtures.mjs --json) +echo "$web_json" | python3 -c ' +import json,sys +d=json.load(sys.stdin) +print("fixtures web", d.get("kotoba.cli/ok?"), d.get("kotoba.cli/code"), d.get("kotoba.cli/message") or "") +if not d.get("kotoba.cli/ok?") or d.get("kotoba.cli/code") != "emitted": + sys.exit(1) +' + +node scripts/run-fixtures.mjs /tmp/binding-kotoba-ci/fixtures.mjs diff --git a/lib/binding_kotoba/scripts/run-fixtures.mjs b/lib/binding_kotoba/scripts/run-fixtures.mjs new file mode 100644 index 000000000..10cb82dfb --- /dev/null +++ b/lib/binding_kotoba/scripts/run-fixtures.mjs @@ -0,0 +1,45 @@ +import { pathToFileURL } from "node:url"; +import { readFileSync } from "node:fs"; + +const artifact = process.argv[2]; +if (!artifact) { + console.error("usage: node scripts/run-fixtures.mjs "); + process.exit(2); +} + +const source = readFileSync(artifact, "utf8"); +const generated = await import(pathToFileURL(artifact).href); +const names = Object.keys(generated.instantiateKotoba({})).filter((n) => + n.startsWith("test-") +); +if (names.length === 0) { + console.error("no test-* exports"); + process.exit(1); +} + +let failed = 0; +for (const name of names.sort()) { + const api = generated.instantiateKotoba({}); + let value; + try { + value = api[name](); + } catch (err) { + console.log(`FAIL ${name} threw ${err.message}`); + failed += 1; + continue; + } + if (value === 1n) { + console.log(`PASS ${name}`); + } else { + console.log(`FAIL ${name} => ${value}`); + failed += 1; + } +} + +if (!source.includes("kotobaArtifact")) { + console.error("compiled artifact missing kotobaArtifact"); + process.exit(1); +} + +console.log(`${names.length - failed}/${names.length} passed`); +process.exit(failed === 0 ? 0 : 1); diff --git a/lib/binding_kotoba/src/tree_sitter.kotoba b/lib/binding_kotoba/src/tree_sitter.kotoba new file mode 100644 index 000000000..f121ecaca --- /dev/null +++ b/lib/binding_kotoba/src/tree_sitter.kotoba @@ -0,0 +1,320 @@ +(ns tree-sitter.kotoba + (:export [host-can-parse? + node-types fixture-tree fixture-source + tree-root tree-source tree-node + node-type node-named? node-is-null? node-id node-field-name + node-start-byte node-end-byte + node-start-row node-start-column node-end-row node-end-column + node-child-count node-child node-named-child-count node-named-child + node-child-by-field-name node-parent node-next-sibling node-prev-sibling + node-eq? node-sexp + cursor-new cursor-id cursor-ok? cursor-current-node cursor-current-field-name + cursor-goto-first-child cursor-goto-next-sibling cursor-goto-parent + node-type-entry node-type-named? node-type-has-field?])) + +;; Kotoba cannot FFI libtree-sitter. This unit is the host-facing node / tree / +;; cursor shape plus a walk over a vendored CST fixture. It is not a parser. +;; A host that can call C may inject a tree document with the same keys. + +(defn box-i64 [n :i64] :document + (document-edn-read (string-from-i64 n))) + +(defn box-str [s :string] :document + (document-edn-read (string-join "" "\"" s "\""))) + +(defn doc-get [m :document k :keyword] :document + (option-or (document-get m k) (document nil))) + +(defn is-kind? [d :document k :string] :bool + (string=? (keyword-name (document-kind d)) k)) + +(defn doc-str [d :document] :string + (let [p (document-edn-print d) + n (string-length p)] + (cond + (is-kind? d "string") (if (< n 2) "" (string-substring p 1 (- n 1))) + (is-kind? d "keyword") (string-substring p 1 n) + :else ""))) + +(defn parse-i64 [s :string i :i64 acc :i64 sign :i64] :i64 + (if (>= i (string-length s)) + (* acc sign) + (let [c (string-code-point-at s i)] + (if (and (>= c 48) (<= c 57)) + (parse-i64 s (+ i 1) (+ (* acc 10) (- c 48)) sign) + (* acc sign))))) + +(defn doc-i64 [d :document] :i64 + (if (is-kind? d "i64") + (let [p (document-edn-print d)] + (if (and (> (string-length p) 0) (= (string-code-point-at p 0) 45)) + (parse-i64 p 1 0 -1) + (parse-i64 p 0 0 1))) + 0)) + +(defn doc-true? [d :document] :bool + (or (string=? (document-edn-print d) "true") + (= (doc-i64 d) 1))) + +(defn null-node [] :document + (document-assoc (document {}) :null (box-i64 1))) + +(defn node-is-null? [n :document] :bool + (= (doc-i64 (doc-get n :null)) 1)) + +(defn host-can-parse? [] :i64 + 0) + +(defn node-types-edn [] :string + "[{:type \"source_file\" :named true :fields {} :children {:multiple true :required true :types [{:type \"assignment\" :named true}]}} {:type \"assignment\" :named true :fields {:left {:multiple false :required true :types [{:type \"identifier\" :named true}]} :right {:multiple false :required true :types [{:type \"number\" :named true}]}} :children {:multiple true :required false :types [{:type \"=\" :named false}]}} {:type \"identifier\" :named true} {:type \"number\" :named true} {:type \"=\" :named false}]") + +(defn fixture-tree-edn [] :string + "{:source \"x = 1\" :root-id 0 :nodes [{:id 0 :parent -1 :type \"source_file\" :named 1 :start-byte 0 :end-byte 5 :start-row 0 :start-column 0 :end-row 0 :end-column 5 :field \"\" :children [1]} {:id 1 :parent 0 :type \"assignment\" :named 1 :start-byte 0 :end-byte 5 :start-row 0 :start-column 0 :end-row 0 :end-column 5 :field \"\" :children [2 3 4]} {:id 2 :parent 1 :type \"identifier\" :named 1 :start-byte 0 :end-byte 1 :start-row 0 :start-column 0 :end-row 0 :end-column 1 :field \"left\" :children []} {:id 3 :parent 1 :type \"=\" :named 0 :start-byte 2 :end-byte 3 :start-row 0 :start-column 2 :end-row 0 :end-column 3 :field \"\" :children []} {:id 4 :parent 1 :type \"number\" :named 1 :start-byte 4 :end-byte 5 :start-row 0 :start-column 4 :end-row 0 :end-column 5 :field \"right\" :children []}]}") + +(defn node-types [] :document + (document-edn-read (node-types-edn))) + +(defn fixture-tree [] :document + (document-edn-read (fixture-tree-edn))) + +(defn fixture-source [] :string + "x = 1") + +(defn tree-source [tree :document] :string + (doc-str (doc-get tree :source))) + +(defn tree-node [tree :document id :i64] :document + (if (< id 0) + (null-node) + (let [nodes (option-or (document-get tree :nodes) (document [])) + n (document-count nodes)] + (if (>= id n) + (null-node) + (option-or (document-vector-at nodes id) (null-node)))))) + +(defn tree-root [tree :document] :document + (tree-node tree (doc-i64 (doc-get tree :root-id)))) + +(defn node-type [n :document] :string + (doc-str (doc-get n :type))) + +(defn node-named? [n :document] :bool + (doc-true? (doc-get n :named))) + +(defn node-id [n :document] :i64 + (doc-i64 (doc-get n :id))) + +(defn node-field-name [n :document] :string + (doc-str (doc-get n :field))) + +(defn node-start-byte [n :document] :i64 + (doc-i64 (doc-get n :start-byte))) + +(defn node-end-byte [n :document] :i64 + (doc-i64 (doc-get n :end-byte))) + +(defn node-start-row [n :document] :i64 + (doc-i64 (doc-get n :start-row))) + +(defn node-start-column [n :document] :i64 + (doc-i64 (doc-get n :start-column))) + +(defn node-end-row [n :document] :i64 + (doc-i64 (doc-get n :end-row))) + +(defn node-end-column [n :document] :i64 + (doc-i64 (doc-get n :end-column))) + +(defn node-children [n :document] :document + (option-or (document-get n :children) (document []))) + +(defn node-child-count [n :document] :i64 + (document-count (node-children n))) + +(defn child-id-at [n :document i :i64] :i64 + (let [kids (node-children n)] + (if (or (< i 0) (>= i (document-count kids))) + -1 + (doc-i64 (option-or (document-vector-at kids i) (document -1)))))) + +(defn node-child [tree :document n :document i :i64] :document + (tree-node tree (child-id-at n i))) + +(defn count-named [tree :document kids :document i :i64 acc :i64] :i64 + (if (>= i (document-count kids)) + acc + (let [id (doc-i64 (option-or (document-vector-at kids i) (document -1))) + child (tree-node tree id) + next (if (and (not (node-is-null? child)) (node-named? child)) + (+ acc 1) + acc)] + (count-named tree kids (+ i 1) next)))) + +(defn node-named-child-count [tree :document n :document] :i64 + (count-named tree (node-children n) 0 0)) + +(defn scan-st [want :i64 seen :i64] :document + (document-assoc (document-assoc (document {}) :want (box-i64 want)) :seen (box-i64 seen))) + +(defn scan-named [tree :document kids :document i :i64 st :document] :i64 + (if (>= i (document-count kids)) + -1 + (let [want (doc-i64 (doc-get st :want)) + seen (doc-i64 (doc-get st :seen)) + id (doc-i64 (option-or (document-vector-at kids i) (document -1))) + child (tree-node tree id)] + (if (and (not (node-is-null? child)) (node-named? child)) + (if (= seen want) + id + (scan-named tree kids (+ i 1) (scan-st want (+ seen 1)))) + (scan-named tree kids (+ i 1) st))))) + +(defn node-named-child [tree :document n :document i :i64] :document + (tree-node tree (scan-named tree (node-children n) 0 (scan-st i 0)))) + +(defn scan-field [tree :document kids :document field :string i :i64] :i64 + (if (>= i (document-count kids)) + -1 + (let [id (doc-i64 (option-or (document-vector-at kids i) (document -1))) + child (tree-node tree id)] + (if (string=? (node-field-name child) field) + id + (scan-field tree kids field (+ i 1)))))) + +(defn node-child-by-field-name [tree :document n :document field :string] :document + (tree-node tree (scan-field tree (node-children n) field 0))) + +(defn node-parent [tree :document n :document] :document + (tree-node tree (doc-i64 (doc-get n :parent)))) + +(defn find-index [kids :document id :i64 i :i64] :i64 + (if (>= i (document-count kids)) + -1 + (if (= (doc-i64 (option-or (document-vector-at kids i) (document -1))) id) + i + (find-index kids id (+ i 1))))) + +(defn node-next-sibling [tree :document n :document] :document + (let [p (node-parent tree n)] + (if (node-is-null? p) + (null-node) + (let [kids (node-children p) + idx (find-index kids (node-id n) 0)] + (if (< idx 0) + (null-node) + (node-child tree p (+ idx 1))))))) + +(defn node-prev-sibling [tree :document n :document] :document + (let [p (node-parent tree n)] + (if (node-is-null? p) + (null-node) + (let [kids (node-children p) + idx (find-index kids (node-id n) 0)] + (if (<= idx 0) + (null-node) + (node-child tree p (- idx 1))))))) + +(defn node-eq? [a :document b :document] :bool + (and (not (node-is-null? a)) + (and (not (node-is-null? b)) + (= (node-id a) (node-id b))))) + +(defn sexp-piece [tree :document n :document acc :string] :string + (if (node-is-null? n) + (string-concat acc "()") + (let [typ (node-type n) + kids (node-children n)] + (if (node-named? n) + (if (= (document-count kids) 0) + (string-join "" acc "(" typ ")") + (string-join "" acc "(" typ " " (sexp-kids tree kids 0 "") ")")) + (string-join "" acc "\"" typ "\""))))) + +(defn sexp-kids [tree :document kids :document i :i64 acc :string] :string + (if (>= i (document-count kids)) + acc + (let [id (doc-i64 (option-or (document-vector-at kids i) (document -1))) + sep (if (= i 0) "" " ") + piece (sexp-piece tree (tree-node tree id) "")] + (sexp-kids tree kids (+ i 1) (string-concat acc (string-concat sep piece)))))) + +(defn node-sexp [tree :document n :document] :string + (sexp-piece tree n "")) + +(defn cursor-new [id :i64] :document + (document-assoc (document-assoc (document {}) :id (box-i64 id)) :ok (box-i64 1))) + +(defn cursor-fail [c :document] :document + (document-assoc c :ok (box-i64 0))) + +(defn cursor-id [c :document] :i64 + (doc-i64 (doc-get c :id))) + +(defn cursor-ok? [c :document] :bool + (= (doc-i64 (doc-get c :ok)) 1)) + +(defn cursor-current-node [tree :document c :document] :document + (tree-node tree (cursor-id c))) + +(defn cursor-current-field-name [tree :document c :document] :string + (node-field-name (cursor-current-node tree c))) + +(defn cursor-goto-first-child [tree :document c :document] :document + (let [n (cursor-current-node tree c) + kids (node-children n)] + (if (= (document-count kids) 0) + (cursor-fail c) + (cursor-new (doc-i64 (option-or (document-vector-at kids 0) (document -1))))))) + +(defn cursor-goto-parent [tree :document c :document] :document + (let [n (cursor-current-node tree c) + p (doc-i64 (doc-get n :parent))] + (if (< p 0) + (cursor-fail c) + (cursor-new p)))) + +(defn cursor-goto-next-sibling [tree :document c :document] :document + (let [n (cursor-current-node tree c) + p (node-parent tree n)] + (if (node-is-null? p) + (cursor-fail c) + (let [kids (node-children p) + idx (find-index kids (node-id n) 0)] + (if (or (< idx 0) (>= (+ idx 1) (document-count kids))) + (cursor-fail c) + (cursor-new (child-id-at p (+ idx 1)))))))) + +(defn find-type [types :document name :string i :i64] :document + (if (>= i (document-count types)) + (null-node) + (let [e (option-or (document-vector-at types i) (document {}))] + (if (string=? (doc-str (doc-get e :type)) name) + e + (find-type types name (+ i 1)))))) + +(defn node-type-entry [types :document name :string] :document + (find-type types name 0)) + +(defn node-type-named? [types :document name :string] :bool + (let [e (node-type-entry types name)] + (if (node-is-null? e) + false + (doc-true? (doc-get e :named))))) + +(defn scan-map-key [m :document name :string i :i64] :bool + (if (>= i (document-count m)) + false + (let [e (option-or (document-map-entry-at m i) (document [])) + k (option-or (document-vector-at e 0) (document nil))] + (if (string=? (doc-str k) name) + true + (scan-map-key m name (+ i 1)))))) + +(defn node-type-has-field? [types :document name :string field :string] :bool + (let [e (node-type-entry types name)] + (if (node-is-null? e) + false + (let [fields (doc-get e :fields)] + (if (is-kind? fields "map") + (scan-map-key fields field 0) + false))))) diff --git a/lib/binding_kotoba/test/fixtures.kotoba b/lib/binding_kotoba/test/fixtures.kotoba new file mode 100644 index 000000000..19110aa6d --- /dev/null +++ b/lib/binding_kotoba/test/fixtures.kotoba @@ -0,0 +1,171 @@ +;; Walk / node-type fixtures over the vendored CST. Each test_* is 1 pass / 0 fail. +;; Fresh instantiateKotoba per export so fuel stays at 512. + +(defn test-host-cannot-parse [] :i64 + (if (= (host-can-parse?) 0) + 1 + 0)) + +(defn test-fixture-source [] :i64 + (if (string=? (tree-source (fixture-tree)) (fixture-source)) + 1 + 0)) + +(defn test-root-type [] :i64 + (if (string=? (node-type (tree-root (fixture-tree))) "source_file") + 1 + 0)) + +(defn test-root-named [] :i64 + (if (node-named? (tree-root (fixture-tree))) + 1 + 0)) + +(defn test-root-span [] :i64 + (let [n (tree-root (fixture-tree))] + (if (and (= (node-start-byte n) 0) (= (node-end-byte n) 5)) + 1 + 0))) + +(defn test-root-child-count [] :i64 + (if (= (node-child-count (tree-root (fixture-tree))) 1) + 1 + 0)) + +(defn test-assignment-children [] :i64 + (let [tree (fixture-tree) + assign (node-child tree (tree-root tree) 0)] + (if (and (string=? (node-type assign) "assignment") + (= (node-child-count assign) 3)) + 1 + 0))) + +(defn test-named-child-count [] :i64 + (let [tree (fixture-tree) + assign (node-child tree (tree-root tree) 0)] + (if (= (node-named-child-count tree assign) 2) + 1 + 0))) + +(defn test-field-left [] :i64 + (let [tree (fixture-tree) + assign (node-child tree (tree-root tree) 0) + left (node-child-by-field-name tree assign "left")] + (if (and (string=? (node-type left) "identifier") + (= (node-end-byte left) 1)) + 1 + 0))) + +(defn test-field-right [] :i64 + (let [tree (fixture-tree) + assign (node-child tree (tree-root tree) 0) + right (node-child-by-field-name tree assign "right")] + (if (and (string=? (node-type right) "number") + (= (node-start-byte right) 4)) + 1 + 0))) + +(defn test-anonymous-eq [] :i64 + (let [tree (fixture-tree) + assign (node-child tree (tree-root tree) 0) + eq (node-child tree assign 1)] + (if (and (string=? (node-type eq) "=") + (not (node-named? eq))) + 1 + 0))) + +(defn test-named-child-index [] :i64 + (let [tree (fixture-tree) + assign (node-child tree (tree-root tree) 0) + first (node-named-child tree assign 0) + second (node-named-child tree assign 1)] + (if (and (string=? (node-type first) "identifier") + (string=? (node-type second) "number")) + 1 + 0))) + +(defn test-parent [] :i64 + (let [tree (fixture-tree) + assign (node-child tree (tree-root tree) 0) + left (node-child tree assign 0)] + (if (node-eq? (node-parent tree left) assign) + 1 + 0))) + +(defn test-siblings [] :i64 + (let [tree (fixture-tree) + assign (node-child tree (tree-root tree) 0) + left (node-child tree assign 0) + eq (node-next-sibling tree left) + num (node-next-sibling tree eq) + back (node-prev-sibling tree num)] + (if (and (string=? (node-type eq) "=") + (and (string=? (node-type num) "number") + (node-eq? back eq))) + 1 + 0))) + +(defn test-out-of-range-null [] :i64 + (let [tree (fixture-tree) + root (tree-root tree)] + (if (and (node-is-null? (node-child tree root 9)) + (node-is-null? (node-parent tree root))) + 1 + 0))) + +(defn test-sexp [] :i64 + (let [tree (fixture-tree)] + (if (string=? (node-sexp tree (tree-root tree)) + "(source_file (assignment (identifier) \"=\" (number)))") + 1 + 0))) + +(defn test-cursor-walk [] :i64 + (let [tree (fixture-tree) + c0 (cursor-new 0) + c1 (cursor-goto-first-child tree c0) + c2 (cursor-goto-first-child tree c1) + c3 (cursor-goto-next-sibling tree c2) + c4 (cursor-goto-next-sibling tree c3) + c5 (cursor-goto-parent tree c4)] + (if (and (and (cursor-ok? c1) (string=? (node-type (cursor-current-node tree c1)) "assignment")) + (and (and (string=? (node-type (cursor-current-node tree c2)) "identifier") + (string=? (cursor-current-field-name tree c2) "left")) + (and (and (string=? (node-type (cursor-current-node tree c3)) "=") + (string=? (node-type (cursor-current-node tree c4)) "number")) + (and (cursor-ok? c5) + (string=? (node-type (cursor-current-node tree c5)) "assignment"))))) + 1 + 0))) + +(defn test-cursor-root-parent-fails [] :i64 + (let [tree (fixture-tree) + c (cursor-goto-parent tree (cursor-new 0))] + (if (not (cursor-ok? c)) + 1 + 0))) + +(defn test-node-types-count [] :i64 + (if (= (document-count (node-types)) 5) + 1 + 0)) + +(defn test-node-type-named-catalog [] :i64 + (let [types (node-types)] + (if (and (node-type-named? types "assignment") + (not (node-type-named? types "="))) + 1 + 0))) + +(defn test-node-type-fields [] :i64 + (let [types (node-types)] + (if (and (node-type-has-field? types "assignment" "left") + (and (node-type-has-field? types "assignment" "right") + (not (node-type-has-field? types "identifier" "left")))) + 1 + 0))) + +(defn test-node-type-missing [] :i64 + (if (node-is-null? (node-type-entry (node-types) "missing")) + 1 + 0))