Initial commit

.envrc

@@ -0,0 +1 @@
+use flake

.gitignore

@@ -0,0 +1,4 @@
+/target
+/.direnv
+*.o
+*.out

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
+}

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;
+    });
+  };
+}

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)
+

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

modal

@@ -0,0 +1 @@
+Subproject commit 6541d85cff9ccb9fd7832b8bac2d210e843fee5b

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;
+}

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