From c838cb7aad6fcc5957b07f173e8269a539ea43a9 Mon Sep 17 00:00:00 2001
From: Daniel Flanagan <daniel@lyte.dev>
Date: Sat, 13 Apr 2024 10:31:24 -0500
Subject: [PATCH] Initial commit

---
 .envrc       |   1 +
 .gitignore   |   4 +
 flake.lock   |  27 ++++++
 flake.nix    |  42 ++++++++++
 ifelse.modal |   7 ++
 mimic.modal  |  11 +++
 modal        |   1 +
 modal.c      | 228 +++++++++++++++++++++++++++++++++++++++++++++++++++
 readme.md    |  10 +++
 9 files changed, 331 insertions(+)
 create mode 100644 .envrc
 create mode 100644 .gitignore
 create mode 100644 flake.lock
 create mode 100644 flake.nix
 create mode 100644 ifelse.modal
 create mode 100644 mimic.modal
 create mode 160000 modal
 create mode 100644 modal.c
 create mode 100644 readme.md

diff --git a/.envrc b/.envrc
new file mode 100644
index 0000000..3550a30
--- /dev/null
+++ b/.envrc
@@ -0,0 +1 @@
+use flake
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..83f5fcc
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,4 @@
+/target
+/.direnv
+*.o
+*.out
diff --git a/flake.lock b/flake.lock
new file mode 100644
index 0000000..6294073
--- /dev/null
+++ b/flake.lock
@@ -0,0 +1,27 @@
+{
+  "nodes": {
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1712791164,
+        "narHash": "sha256-3sbWO1mbpWsLepZGbWaMovSO7ndZeFqDSdX0hZ9nVyw=",
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "1042fd8b148a9105f3c0aca3a6177fd1d9360ba5",
+        "type": "github"
+      },
+      "original": {
+        "owner": "NixOS",
+        "ref": "nixos-unstable",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "root": {
+      "inputs": {
+        "nixpkgs": "nixpkgs"
+      }
+    }
+  },
+  "root": "root",
+  "version": 7
+}
diff --git a/flake.nix b/flake.nix
new file mode 100644
index 0000000..829d2c3
--- /dev/null
+++ b/flake.nix
@@ -0,0 +1,42 @@
+{
+  inputs.nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable";
+  outputs = {
+    self,
+    nixpkgs,
+  }: let
+    inherit (self) outputs;
+    supportedSystems = [
+      "x86_64-linux"
+      "aarch64-linux"
+
+      "x86_64-darwin"
+      "aarch64-darwin"
+    ];
+    forEachSupportedSystem = nixpkgs.lib.genAttrs supportedSystems;
+  in {
+    packages = forEachSupportedSystem (system: let
+      pkgs = import nixpkgs {inherit system;};
+    in {
+      modal = pkgs.stdenv.mkDerivation {
+        srcs = [./modal.c];
+        name = "myenv";
+        buildInputs = with pkgs; [clang];
+      };
+
+      default = outputs.packages.${system}.modal;
+    });
+
+    devShells = forEachSupportedSystem (system: let
+      pkgs = import nixpkgs {inherit system;};
+    in {
+      c-dev = pkgs.mkShell {
+        buildInputs = with pkgs; [
+          clang
+          lldb
+        ];
+      };
+
+      default = outputs.devShells.${system}.c-dev;
+    });
+  };
+}
diff --git a/ifelse.modal b/ifelse.modal
new file mode 100644
index 0000000..3de4cb8
--- /dev/null
+++ b/ifelse.modal
@@ -0,0 +1,7 @@
+<> (ifelse (#t) ?t ?f) (?t)
+<> (ifelse (#f) ?t ?f) (?f)
+
+.. (ifelse (eq cat fox) on-equal on-unequal)
+03 (ifelse (#f) on-equal on-unequal)
+01 (on-unequal)
+
diff --git a/mimic.modal b/mimic.modal
new file mode 100644
index 0000000..27aa393
--- /dev/null
+++ b/mimic.modal
@@ -0,0 +1,11 @@
+<> (M ?x) (?x ?x)
+<> (KI ?x ?y) (?y)
+<> (T ?x ?y) (?y ?y)
+<> (W ?x ?y) (?x ?y ?y)
+<> (K ?x ?y) (?x)
+<> (C ?x ?y ?z) (?x ?z ?y)
+<> (B ?x ?y ?z) (?x (?y ?z))
+<> (I ?x) (?x)
+<> (S ?x ?y ?z) (?x ?z (?y ?z))
+
+.. C KI x y z
diff --git a/modal b/modal
new file mode 160000
index 0000000..6541d85
--- /dev/null
+++ b/modal
@@ -0,0 +1 @@
+Subproject commit 6541d85cff9ccb9fd7832b8bac2d210e843fee5b
diff --git a/modal.c b/modal.c
new file mode 100644
index 0000000..ece45ac
--- /dev/null
+++ b/modal.c
@@ -0,0 +1,228 @@
+#include <stdio.h>
+
+typedef struct {
+	int id;
+	char *a, *b;
+} Rule;
+
+static int dst;
+static Rule rules[0x1000], lambda, *rules_ = rules;
+static char dict[0x8000], *dict_ = dict;
+static char bank_a[0x4000], *prog_ = bank_a;
+static char bank_b[0x4000], *outp_ = bank_b;
+static char *regs[0x100];
+
+#define spacer(c) (c <= ' ' || c == '(' || c == ')')
+
+static char *
+walk(char *s)
+{
+	char c;
+	int depth = 0;
+	if(*s == '(') {
+		while((c = *s++)) {
+			if(c == '(') depth++;
+			if(c == ')') --depth;
+			if(!depth) return s;
+		}
+	}
+	while((c = *s) && !spacer(c)) s++;
+	return s;
+}
+
+static char *
+plode(char *s)
+{
+	int i, depth = 0;
+	char c, *ss;
+	/* implode */
+	if(*s == '(') {
+		ss = walk(s);
+		while(s < ss && (c = *s++))
+			if(!spacer(c)) *outp_++ = c;
+	}
+	/* explode */
+	else {
+		while((c = *s++) && !spacer(c))
+			*outp_++ = c, *outp_++ = ' ', *outp_++ = '(', depth++;
+		for(i = 0; i < depth; i++)
+			*outp_++ = ')';
+	}
+	return s;
+}
+
+static int
+set_reg(int r, char *b)
+{
+	if(regs[r]) {
+		char *a = regs[r], *aa = walk(a), *bb = walk(b);
+		while(a < aa && b < bb)
+			if(*a++ != *b++) return 0;
+	} else
+		regs[r] = b;
+	return 1;
+}
+
+static void
+put_reg(char r)
+{
+	char *s = regs[(int)r];
+	if(r == '*')
+		s = plode(s);
+	else if(r == '~') {
+		char buf;
+		while(fread(&buf, 1, 1, stdin) && buf >= ' ')
+			*outp_++ = buf;
+	} else if(s) {
+		char *ss = walk(s);
+		if(r == ':') {
+			if(*s == '(') s++, --ss;
+			while(s < ss) {
+				char c = *s++;
+				if(c == '\\') {
+					switch(*s++) {
+					case 't': putc(0x09, stdout); break;
+					case 'n': putc(0x0a, stdout); break;
+					case 's': putc(0x20, stdout); break;
+					}
+				} else
+					putc(c, stdout);
+			}
+		} else
+			while(s < ss) *outp_++ = *s++;
+	} else
+		*outp_++ = '?', *outp_++ = r;
+}
+
+static char *
+match_rule(Rule *r, char *p)
+{
+	int i;
+	char c, last = 0, *a = r->a, *b = p;
+	for(i = 0x21; i < 0x7f; i++)
+		regs[i] = 0;
+	while((c = *a)) {
+		if(spacer(last) && c == '?') {
+			if(!set_reg(*(++a), b)) return NULL;
+			a++, b = walk(b);
+			continue;
+		}
+		if(*a != *b) return NULL;
+		a++, b++, last = c;
+	}
+	c = *b;
+	return spacer(c) ? b : NULL;
+}
+
+static int
+commit_rule(Rule *r, char *s, int create)
+{
+	while((*outp_++ = *s++))
+		;
+	*outp_++ = 0;
+	if((dst = !dst))
+		prog_ = bank_b, outp_ = bank_a;
+	else
+		prog_ = bank_a, outp_ = bank_b;
+	if(create)
+		fprintf(stderr, "<> (%s) (%s)\n", r->a, r->b);
+	else
+		fprintf(stderr, "%02d %s\n", r->id, prog_);
+	return 1;
+}
+
+static int
+write_rule(Rule *r, char last, char *res)
+{
+	char c, *b = r->b, *origin = outp_;
+	while((c = *b++))
+		if(spacer(last) && c == '?')
+			put_reg(*b++);
+		else
+			*outp_++ = c, last = c;
+	if(last == ' ' && outp_ - origin == 0) outp_--;
+	return commit_rule(r, res, 0);
+}
+
+static char *
+parse_frag(char *s)
+{
+	char c, *ss;
+	while((c = *s) && c <= ' ') s++;
+	if(*s != ')' && *s != '<' && s[1] != '>') {
+		ss = walk(s);
+		if(*s == '(') s++, ss--;
+		while(s < ss) *dict_++ = *s++;
+		s++;
+	}
+	*dict_++ = 0;
+	return s;
+}
+
+static char *
+create_rule(Rule *r, int id, char *s)
+{
+	r->id = id, s += 2;
+	r->a = dict_, s = parse_frag(s);
+	r->b = dict_, s = parse_frag(s);
+	return s;
+}
+
+static int
+rewrite(void)
+{
+	char c, last = 0, *cap, *s = dst ? bank_b : bank_a, *res;
+	while((c = *s) && c <= ' ') s++;
+	while((c = *s)) {
+		if(spacer(last)) {
+			Rule *r;
+			if(*s == '<' && s[1] == '>') {
+				r = rules_++;
+				s = create_rule(r, rules_ - rules - 1, s);
+				while((c = *s) && c <= ' ') s++;
+				return commit_rule(r, s, 1);
+			}
+			if(*s == '?' && s[1] == '(') {
+				r = &lambda, cap = walk(s + 1);
+				create_rule(&lambda, -1, s), s = cap;
+				while((c = *s) && c <= ' ') s++;
+				if((res = match_rule(&lambda, s)) != NULL)
+					return write_rule(&lambda, last, res);
+			}
+			for(r = rules; r < rules_; r++)
+				if((res = match_rule(r, s)) != NULL)
+					return write_rule(r, last, res);
+		}
+		*outp_++ = last = c;
+		s++;
+	}
+	*outp_++ = 0;
+	return 0;
+}
+
+int
+main(int argc, char **argv)
+{
+	FILE *f;
+	char c, *w = bank_a;
+	if(argc < 2)
+		return !printf("usage: modal [-v] source.modal\n");
+	if(argc < 3 && argv[1][0] == '-' && argv[1][1] == 'v')
+		return !printf("Modal Interpreter, 12 Apr 2024.\n");
+	if(!(f = fopen(argv[1], "r")))
+		return !printf("Invalid Modal file: %s.\n", argv[1]);
+	while(fread(&c, 1, 1, f)) {
+		c = c <= 0x20 ? 0x20 : c;
+		if(w > bank_a) {
+			if(c == ' ' && *(w - 1) == '(') continue;
+			if(c == ')' && *(w - 1) == ' ') w--;
+			if(c == ' ' && *(w - 1) == ' ') w--;
+		}
+		*w++ = c;
+	}
+	while(*(--w) <= ' ') *w = 0;
+	fclose(f);
+	while(rewrite())
+		;
+	return 0;
+}
diff --git a/readme.md b/readme.md
new file mode 100644
index 0000000..5220259
--- /dev/null
+++ b/readme.md
@@ -0,0 +1,10 @@
+# Modal
+
+Playing around with the [Modal][0] concatenative language.
+
+Current source for the language is at [git.sr.ht/~rabbits/modal][1] and original
+source is at [gitlab.com/wryl/modal][2].
+
+[0]: https://wiki.xxiivv.com/site/modal
+[1]: https://git.sr.ht/~rabbits/modal
+[2]: https://gitlab.com/wryl/modal