diff options
Diffstat (limited to 'modal')
86 files changed, 1505 insertions, 0 deletions
diff --git a/modal/README.md b/modal/README.md new file mode 100644 index 0000000..954a904 --- /dev/null +++ b/modal/README.md @@ -0,0 +1,112 @@ +## Modal: a tree rewriting system + +This repository contains a small implementation of Modal, a homoiconic tree‑rewriting language. Modal programs are collections of rewrite rules applied to a tree until no rule matches. See the original description for background and examples: [Modal in a Postcard](https://wiki.xxiivv.com/site/modal). + +### Core concepts + +- **Program**: an ordered list of rules. Rule order matters; the first matching rule is applied. +- **Tree**: symbolic S‑expressions (atoms and lists), serialized with parentheses. +- **Rule**: `<> left right`, where `left` and `right` are trees. Matching is structural. +- **Registers**: variables in patterns prefixed with `?` (e.g., `?x`). They bind to subtrees during a match and are substituted on the right side. +- **Evaluation**: scan the serialized tree left‑to‑right; at each node, try rules top‑to‑bottom; on first match, replace the matched subtree with the rule’s right side (with current bindings) and restart scanning from the beginning. Halt when a full scan finds no match. + +### Syntax quick reference + +- Atom: `word` or a quoted symbol like `(0)` used in number encoding. +- Tree: `(head tail...)` or nested pairs to encode lists, e.g., `(a (b (c ())))`. +- Rule: `<> (a bat) (a black cat)`. +- Register: `?name` in the left or right side; repeated occurrences must match the same subtree. + +### Minimal operational semantics + +1. Parsing: read tokens into an AST of `Atom(value)` or `List([nodes...])`. +2. Matching: `match(pattern, tree, env)` + - If `pattern` is a register `?r` and `?r` unbound: bind `env[r] = tree`. + - If `pattern` is a register `?r` and bound: require structural equality with `env[r]`. + - If both atoms: require exact equality. + - If both lists: same arity; match element‑wise recursively. + - Otherwise: fail. +3. Rewriting: substitute registers in the right‑hand side using `env`, producing a new subtree. +4. Driver loop: + - Linearize the AST positions in left‑to‑right preorder over the serialized form. + - For each position, try rules in order; on first success, perform rewrite and restart from the beginning. + - If no rewrite happened in a full pass, halt. + +### Numbers and common encodings + +- Natural numbers: unary parentheses around `0`: + - `0` = 0, `(0)` = 1, `((0))` = 2, `(((0)))` = 3, ... +- Lists: nested pairs ending with `()` (nil): `(a (b (c ())))`. + +### Examples + +Rules: + +```modal +<> (copy ?a) (?a ?a) +<> (swap ?x ?y) (?y ?x) +``` + +Input and result: + +```modal +(copy cat) (swap bat rat) +(cat cat) (swap bat rat) +(cat cat) (rat bat) +``` + +Conditionals via boolean tables and a ternary (see reference): + +```modal +<> (ife #t ?t ?f) ?t +<> (ife #f ?t ?f) ?f +``` + +Unary subtraction: + +```modal +<> ((?a) - (?b)) (?a - ?b) +<> (?a - 0) (difference ?a) +``` + +### Side effects and IO + +The language core is pure rewriting. Implementations may expose host effects via special registers. The reference uses `?:` to emit symbols to the console (e.g., `(print (sum ?:))`). Treat such registers as implementation‑defined hooks that consume or produce host effects during rewriting. Keep them minimal and explicit. + +### Implementation guide (porting to another language) + +- Data model: + - AST types: `Atom`, `List`. + - Rule: `{ left: Node, right: Node }`. + - Environment: map from register name to bound `Node`. +- Parser: + - Tokenize `(` `)` and atoms; build AST; preserve atom spelling verbatim. + - Identify registers by leading `?` at parse or match time. +- Matcher: + - Structural recursion with immutable `env`; fail fast on arity/shape mismatch. + - Registers are single‑assignment within a match; repeated occurrences unify. +- Rewriter: + - Deep substitute registers in `right` using `env`; do not capture or mutate `env` across matches. +- Evaluator: + - Left‑to‑right scan order over the current tree; rule priority is program order. + - On rewrite, replace exactly the matched subtree, then restart scanning from the root. + - Terminate when a full scan applies zero rewrites. +- IO hooks (optional): + - Dispatch atoms/registers like `?:` to host functions with explicit semantics. + - Keep IO operations deterministic relative to rewrite steps. + +### Determinism and termination + +- Determinism depends on rule order; different orders may yield different results. +- Termination is not guaranteed; design rules with explicit base cases. + +### Repository layout + +- `modal.c`: reference implementation (C). +- `logic.modal`: sample rules/programs. + +### Further reading + +- Original write‑up and worked examples: [Modal in a Postcard](https://wiki.xxiivv.com/site/modal). + + diff --git a/modal/build/modal_c b/modal/build/modal_c new file mode 100755 index 0000000..c5ee66b --- /dev/null +++ b/modal/build/modal_c Binary files differdiff --git a/modal/ocaml/.gitinore b/modal/ocaml/.gitinore new file mode 100644 index 0000000..a3b1d31 --- /dev/null +++ b/modal/ocaml/.gitinore @@ -0,0 +1,35 @@ +# Created by https://www.toptal.com/developers/gitignore/api/ocaml +# Edit at https://www.toptal.com/developers/gitignore?templates=ocaml + +### OCaml ### +*.annot +*.cmo +*.cma +*.cmi +*.a +*.o +*.cmx +*.cmxs +*.cmxa + +# ocamlbuild working directory +_build/ + +# ocamlbuild targets +*.byte +*.native + +# oasis generated files +setup.data +setup.log + +# Merlin configuring file for Vim and Emacs +.merlin + +# Dune generated files +*.install + +# Local OPAM switch +_opam/ + +# End of https://www.toptal.com/developers/gitignore/api/ocaml diff --git a/modal/ocaml/README.md b/modal/ocaml/README.md new file mode 100644 index 0000000..c508a85 --- /dev/null +++ b/modal/ocaml/README.md @@ -0,0 +1,61 @@ +## OCaml Modal Interpreter + +A minimal, AST-based Modal interpreter. See the language overview in the project root `README.md` and reference `ocaml/REF.txt`. Original docs: [Modal in a Postcard](https://wiki.xxiivv.com/site/modal). + +### Build + +``` +opam switch create . ocaml-base-compiler.5.2.1 --no-install && opam install . --deps-only -y && dune build @install +``` + +### Run + +Pass a rules file and an optional input expression: + +``` +dune exec modal -- examples/logic.modal "(eq fox bat) (eq bat bat)" +``` + +Or rely on input lines inside the file (lines starting with `..`): + +``` +dune exec modal -- examples/devices.modal +``` + +Flags: +- `-q`: quiet (suppress device prints; still prints final tree) +- `-a`: allow file/stdin devices (`(?_)`, `(?~)`) +- `-n`: large cycle cap (effectively “no limit”) + +### Implementation highlights + +- AST rewrite engine with left-to-right preorder scan; rule order is significant. +- Dynamic rules during evaluation using explicit list forms: + - Define: `(<>) (left) (right)` + - Undefine: `(><) (left) (right)` +- Registers: `?name` unify on the left and substitute on the right. +- Devices (side-effect hooks): + - `(?: ...)` print or ALU: `(?: + 1 2 3)` → `6`; otherwise concatenates arguments to stdout, returns `()`. + - `(?_) path` import file (requires `-a`); returns parsed AST if possible else an atom. + - `(?~)` read stdin (requires `-a`); returns atom of contents or `EOF`. + - `(?^) x` join atoms from `x` into a single atom. + - `(?.) x` unwrap list `x` into its elements. + - `(?*) x` explode atom `x` into list of character atoms; lists pass through unchanged. +- Cycle cap and flags implemented in the evaluator. + +Notes on semantics vs C version: +- This interpreter uses an AST scan rather than a raw token stream. Most programs work as expected; exact stream-boundary edge cases may differ. +- Lambda `?(...)` is not implemented yet; easy to add if needed. + +### Examples + +``` +# Devices (printing, ALU, join/unwrap/explode) +dune exec modal -- examples/devices.modal + +# Dynamic rules (define/undefine during evaluation) +dune exec modal -- -q examples/dynamic_rules.modal + +# Arithmetic (via ?:) +dune exec modal -- examples/arith.modal +``` \ No newline at end of file diff --git a/modal/ocaml/REF.txt b/modal/ocaml/REF.txt new file mode 100644 index 0000000..9b60128 --- /dev/null +++ b/modal/ocaml/REF.txt @@ -0,0 +1,59 @@ +Modal Reference + +Program model +- Program: ordered rules; first match applies. +- Data: atoms and lists (S-expr). Numbers can be encoded as unary parentheses or decimal/hex for devices. +- Registers: ?name binds a subtree in left-hand side and substitutes on the right. + +Syntax +- Rule define: (<>) (left) (right) +- Rule undefine: (><) (left) (right) +- Device calls: (?: ...), (?_), (?~), (?^ x), (?. x), (?* x) +- Input lines (loader convenience): lines starting with ".." are expressions appended to the input tree. + +Evaluation +1. Scan tree left-to-right (preorder over the AST). +2. At each node: + a) Dynamic forms: devices and (<>)/ (><) evaluated first. + b) Rules: try rules in order; on first match, rewrite. +3. After rewrite, restart scanning from root. Halt after a full pass with no rewrites or cycle cap exhaustion. + +Matching +- Atom vs atom: equal string. +- List vs list: same arity; element-wise match. +- Register (?x): first occurrence binds; subsequent occurrences must equal the bound value. + +Devices +- (?: args...) + - ALU: (?: op n0 n1 ...), op in + - * / % & ^ | = ! > < ; numbers decimal or #hex. + - Print: otherwise concatenates args (atoms/lists flattened to string) to stdout; returns (). +- (?_ path) + - If access allowed: reads file; returns parsed AST if possible else atom of contents; otherwise returns NAF. +- (?~) + - If access allowed: read stdin; else EOF. +- (?^ x) : join tokens of x (atoms from leaves) → atom. +- (?. x) : unwrap list x → elements of x. +- (?* x) : explode x. If atom, returns list of its characters as atoms. If list, returns x unchanged. + +CLI +- -q : quiet (suppress device print output traces except final tree) +- -a : allow access (enables (?_), (?~)) +- -n : no cap (large cycle cap) + +Notes +- Rule order is significant. +- Dynamic rules enable self-modifying programs. +- Termination is not guaranteed. + +Examples + Rules: + (<>) (copy ?a) (?a ?a) + (<>) (swap ?x ?y) (?y ?x) + + Input: + (copy cat) (swap bat rat) + + Result: + (cat cat) (rat bat) + + diff --git a/modal/ocaml/_build/.db b/modal/ocaml/_build/.db new file mode 100644 index 0000000..7eab69c --- /dev/null +++ b/modal/ocaml/_build/.db Binary files differdiff --git a/modal/ocaml/_build/.digest-db b/modal/ocaml/_build/.digest-db new file mode 100644 index 0000000..8925829 --- /dev/null +++ b/modal/ocaml/_build/.digest-db Binary files differdiff --git a/modal/ocaml/_build/.filesystem-clock b/modal/ocaml/_build/.filesystem-clock new file mode 100644 index 0000000..c61f4a7 --- /dev/null +++ b/modal/ocaml/_build/.filesystem-clock @@ -0,0 +1 @@ +<dummy> \ No newline at end of file diff --git a/modal/ocaml/_build/.lock b/modal/ocaml/_build/.lock new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/modal/ocaml/_build/.lock diff --git a/modal/ocaml/_build/default/.dune/configurator b/modal/ocaml/_build/default/.dune/configurator new file mode 100644 index 0000000..2db189d --- /dev/null +++ b/modal/ocaml/_build/default/.dune/configurator @@ -0,0 +1,2 @@ +(ocamlc /Users/eli/.opam/default/bin/ocamlc.opt) +(ocaml_config_vars (afl_instrument false) (architecture arm64) (asm "cc -c -Wno-trigraphs") (asm_cfi_supported true) (ast_impl_magic_number Caml1999M035) (ast_intf_magic_number Caml1999N035) (bytecode_cflags "-O2 -fno-strict-aliasing -fwrapv -pthread ") (bytecode_cppflags " -D_FILE_OFFSET_BITS=64 ") (bytecomp_c_compiler "cc -O2 -fno-strict-aliasing -fwrapv -pthread -D_FILE_OFFSET_BITS=64 ") (bytecomp_c_libraries "-L/opt/homebrew/opt/zstd/lib -lzstd -lpthread") (c_compiler cc) (ccomp_type cc) (cma_magic_number Caml1999A035) (cmi_magic_number Caml1999I035) (cmo_magic_number Caml1999O035) (cmt_magic_number Caml1999T035) (cmx_magic_number Caml1999Y035) (cmxa_magic_number Caml1999Z035) (cmxs_magic_number Caml1999D035) (default_executable_name a.out) (default_safe_string true) (exec_magic_number Caml1999X035) (ext_asm .s) (ext_dll .so) (ext_exe "") (ext_lib .a) (ext_obj .o) (flambda false) (flat_float_array true) (function_sections false) (host aarch64-apple-darwin24.4.0) (int_size 63) (linear_magic_number Caml1999L035) (model default) (naked_pointers false) (native_c_compiler "cc -O2 -fno-strict-aliasing -fwrapv -pthread -D_FILE_OFFSET_BITS=64 ") (native_c_libraries " -lpthread") (native_cflags "-O2 -fno-strict-aliasing -fwrapv -pthread ") (native_compiler true) (native_cppflags " -D_FILE_OFFSET_BITS=64 ") (native_dynlink true) (native_ldflags "") (native_pack_linker "ld -r -o ") (ocamlc_cflags "-O2 -fno-strict-aliasing -fwrapv -pthread ") (ocamlc_cppflags " -D_FILE_OFFSET_BITS=64 ") (ocamlopt_cflags "-O2 -fno-strict-aliasing -fwrapv -pthread ") (ocamlopt_cppflags " -D_FILE_OFFSET_BITS=64 ") (os_type Unix) (safe_string true) (standard_library /Users/eli/.opam/default/lib/ocaml) (standard_library_default /Users/eli/.opam/default/lib/ocaml) (supports_shared_libraries true) (system macosx) (systhread_supported true) (target aarch64-apple-darwin24.4.0) (tsan false) (version 5.3.0) (windows_unicode false) (with_frame_pointers false) (word_size 64)) diff --git a/modal/ocaml/_build/default/.dune/configurator.v2 b/modal/ocaml/_build/default/.dune/configurator.v2 new file mode 100644 index 0000000..1945bfc --- /dev/null +++ b/modal/ocaml/_build/default/.dune/configurator.v2 @@ -0,0 +1 @@ +((6:ocamlc39:/Users/eli/.opam/default/bin/ocamlc.opt)(17:ocaml_config_vars((14:afl_instrument5:false)(12:architecture5:arm64)(3:asm20:cc -c -Wno-trigraphs)(17:asm_cfi_supported4:true)(21:ast_impl_magic_number12:Caml1999M035)(21:ast_intf_magic_number12:Caml1999N035)(15:bytecode_cflags43:-O2 -fno-strict-aliasing -fwrapv -pthread )(17:bytecode_cppflags24: -D_FILE_OFFSET_BITS=64 )(19:bytecomp_c_compiler71:cc -O2 -fno-strict-aliasing -fwrapv -pthread -D_FILE_OFFSET_BITS=64 )(20:bytecomp_c_libraries48:-L/opt/homebrew/opt/zstd/lib -lzstd -lpthread)(10:c_compiler2:cc)(10:ccomp_type2:cc)(16:cma_magic_number12:Caml1999A035)(16:cmi_magic_number12:Caml1999I035)(16:cmo_magic_number12:Caml1999O035)(16:cmt_magic_number12:Caml1999T035)(16:cmx_magic_number12:Caml1999Y035)(17:cmxa_magic_number12:Caml1999Z035)(17:cmxs_magic_number12:Caml1999D035)(23:default_executable_name5:a.out)(19:default_safe_string4:true)(17:exec_magic_number12:Caml1999X035)(7:ext_asm2:.s)(7:ext_dll3:.so)(7:ext_exe0:)(7:ext_lib2:.a)(7:ext_obj2:.o)(7:flambda5:false)(16:flat_float_array4:true)(17:function_sections5:false)(4:host26:aarch64-apple-darwin24.4.0)(8:int_size2:63)(19:linear_magic_number12:Caml1999L035)(5:model7:default)(14:naked_pointers5:false)(17:native_c_compiler71:cc -O2 -fno-strict-aliasing -fwrapv -pthread -D_FILE_OFFSET_BITS=64 )(18:native_c_libraries12: -lpthread)(13:native_cflags43:-O2 -fno-strict-aliasing -fwrapv -pthread )(15:native_compiler4:true)(15:native_cppflags24: -D_FILE_OFFSET_BITS=64 )(14:native_dynlink4:true)(14:native_ldflags0:)(18:native_pack_linker9:ld -r -o )(13:ocamlc_cflags43:-O2 -fno-strict-aliasing -fwrapv -pthread )(15:ocamlc_cppflags24: -D_FILE_OFFSET_BITS=64 )(15:ocamlopt_cflags43:-O2 -fno-strict-aliasing -fwrapv -pthread )(17:ocamlopt_cppflags24: -D_FILE_OFFSET_BITS=64 )(7:os_type4:Unix)(11:safe_string4:true)(16:standard_library34:/Users/eli/.opam/default/lib/ocaml)(24:standard_library_default34:/Users/eli/.opam/default/lib/ocaml)(25:supports_shared_libraries4:true)(6:system6:macosx)(19:systhread_supported4:true)(6:target26:aarch64-apple-darwin24.4.0)(4:tsan5:false)(7:version5:5.3.0)(15:windows_unicode5:false)(19:with_frame_pointers5:false)(9:word_size2:64)))) \ No newline at end of file diff --git a/modal/ocaml/_build/default/META.modal b/modal/ocaml/_build/default/META.modal new file mode 100644 index 0000000..ed1fcad --- /dev/null +++ b/modal/ocaml/_build/default/META.modal @@ -0,0 +1,7 @@ +version = "0.1.0" +description = "" +requires = "" +archive(byte) = "modal.cma" +archive(native) = "modal.cmxa" +plugin(byte) = "modal.cma" +plugin(native) = "modal.cmxs" \ No newline at end of file diff --git a/modal/ocaml/_build/default/README.md b/modal/ocaml/_build/default/README.md new file mode 100644 index 0000000..c508a85 --- /dev/null +++ b/modal/ocaml/_build/default/README.md @@ -0,0 +1,61 @@ +## OCaml Modal Interpreter + +A minimal, AST-based Modal interpreter. See the language overview in the project root `README.md` and reference `ocaml/REF.txt`. Original docs: [Modal in a Postcard](https://wiki.xxiivv.com/site/modal). + +### Build + +``` +opam switch create . ocaml-base-compiler.5.2.1 --no-install && opam install . --deps-only -y && dune build @install +``` + +### Run + +Pass a rules file and an optional input expression: + +``` +dune exec modal -- examples/logic.modal "(eq fox bat) (eq bat bat)" +``` + +Or rely on input lines inside the file (lines starting with `..`): + +``` +dune exec modal -- examples/devices.modal +``` + +Flags: +- `-q`: quiet (suppress device prints; still prints final tree) +- `-a`: allow file/stdin devices (`(?_)`, `(?~)`) +- `-n`: large cycle cap (effectively “no limit”) + +### Implementation highlights + +- AST rewrite engine with left-to-right preorder scan; rule order is significant. +- Dynamic rules during evaluation using explicit list forms: + - Define: `(<>) (left) (right)` + - Undefine: `(><) (left) (right)` +- Registers: `?name` unify on the left and substitute on the right. +- Devices (side-effect hooks): + - `(?: ...)` print or ALU: `(?: + 1 2 3)` → `6`; otherwise concatenates arguments to stdout, returns `()`. + - `(?_) path` import file (requires `-a`); returns parsed AST if possible else an atom. + - `(?~)` read stdin (requires `-a`); returns atom of contents or `EOF`. + - `(?^) x` join atoms from `x` into a single atom. + - `(?.) x` unwrap list `x` into its elements. + - `(?*) x` explode atom `x` into list of character atoms; lists pass through unchanged. +- Cycle cap and flags implemented in the evaluator. + +Notes on semantics vs C version: +- This interpreter uses an AST scan rather than a raw token stream. Most programs work as expected; exact stream-boundary edge cases may differ. +- Lambda `?(...)` is not implemented yet; easy to add if needed. + +### Examples + +``` +# Devices (printing, ALU, join/unwrap/explode) +dune exec modal -- examples/devices.modal + +# Dynamic rules (define/undefine during evaluation) +dune exec modal -- -q examples/dynamic_rules.modal + +# Arithmetic (via ?:) +dune exec modal -- examples/arith.modal +``` \ No newline at end of file diff --git a/modal/ocaml/_build/default/app/.main.eobjs/byte/dune__exe__Main.cmi b/modal/ocaml/_build/default/app/.main.eobjs/byte/dune__exe__Main.cmi new file mode 100644 index 0000000..b80dd28 --- /dev/null +++ b/modal/ocaml/_build/default/app/.main.eobjs/byte/dune__exe__Main.cmi Binary files differdiff --git a/modal/ocaml/_build/default/app/.main.eobjs/byte/dune__exe__Main.cmti b/modal/ocaml/_build/default/app/.main.eobjs/byte/dune__exe__Main.cmti new file mode 100644 index 0000000..5b556ab --- /dev/null +++ b/modal/ocaml/_build/default/app/.main.eobjs/byte/dune__exe__Main.cmti Binary files differdiff --git a/modal/ocaml/_build/default/app/.main.eobjs/native/dune__exe__Main.cmx b/modal/ocaml/_build/default/app/.main.eobjs/native/dune__exe__Main.cmx new file mode 100644 index 0000000..212f7a3 --- /dev/null +++ b/modal/ocaml/_build/default/app/.main.eobjs/native/dune__exe__Main.cmx Binary files differdiff --git a/modal/ocaml/_build/default/app/.merlin-conf/exe-main b/modal/ocaml/_build/default/app/.merlin-conf/exe-main new file mode 100644 index 0000000..bd3ffbf --- /dev/null +++ b/modal/ocaml/_build/default/app/.merlin-conf/exe-main Binary files differdiff --git a/modal/ocaml/_build/default/app/main.exe b/modal/ocaml/_build/default/app/main.exe new file mode 100755 index 0000000..a33810e --- /dev/null +++ b/modal/ocaml/_build/default/app/main.exe Binary files differdiff --git a/modal/ocaml/_build/default/app/main.ml b/modal/ocaml/_build/default/app/main.ml new file mode 100644 index 0000000..63ecfb9 --- /dev/null +++ b/modal/ocaml/_build/default/app/main.ml @@ -0,0 +1,34 @@ +module Ast = Modal.Ast +module Parse = Modal.Parse +module Eval = Modal.Eval +module Program = Modal.Program + +let () = + let usage = "Usage: modal [-q] [-a] [-n] RULES.modal [INPUT]" in + if Array.length Sys.argv < 2 then (prerr_endline usage; exit 2); + let cfg = Eval.default_config () in + let rec parse_flags i = + if i < Array.length Sys.argv && String.length Sys.argv.(i) > 0 && Sys.argv.(i).[0] = '-' then ( + (match Sys.argv.(i) with + | "-q" -> cfg.quiet <- true + | "-a" -> cfg.allow_access <- true + | "-n" -> cfg.cycles <- 0x7fffffff + | _ -> ()); + parse_flags (i + 1)) + else i + in + let i = parse_flags 1 in + if i >= Array.length Sys.argv then (prerr_endline usage; exit 2); + let rules_path = Sys.argv.(i) in + let input_arg = if i + 1 < Array.length Sys.argv then Some Sys.argv.(i + 1) else None in + let rules, file_input = Program.load_file rules_path in + let input = + match input_arg with + | Some s -> Parse.parse s + | None -> ( + match file_input with Some n -> n | None -> Ast.List []) + in + let result = Eval.eval ~config:cfg rules input in + Format.printf "%a\n" Ast.pp result + + diff --git a/modal/ocaml/_build/default/app/main.mli b/modal/ocaml/_build/default/app/main.mli new file mode 100644 index 0000000..335ae1f --- /dev/null +++ b/modal/ocaml/_build/default/app/main.mli @@ -0,0 +1 @@ +(* Auto-generated by Dune *) \ No newline at end of file diff --git a/modal/ocaml/_build/default/modal.dune-package b/modal/ocaml/_build/default/modal.dune-package new file mode 100644 index 0000000..4cddf92 --- /dev/null +++ b/modal/ocaml/_build/default/modal.dune-package @@ -0,0 +1,70 @@ +(lang dune 3.18) +(name modal) +(version 0.1.0) +(sections (lib .) (libexec .) (bin ../../bin) (doc ../../doc/modal)) +(files + (lib + (META + ast.ml + dune-package + eval.ml + modal.a + modal.cma + modal.cmi + modal.cmt + modal.cmx + modal.cmxa + modal.ml + modal__Ast.cmi + modal__Ast.cmt + modal__Ast.cmx + modal__Eval.cmi + modal__Eval.cmt + modal__Eval.cmx + modal__Parse.cmi + modal__Parse.cmt + modal__Parse.cmx + modal__Program.cmi + modal__Program.cmt + modal__Program.cmx + opam + parse.ml + program.ml)) + (libexec (modal.cmxs)) + (bin (modal)) + (doc (README.md))) +(library + (name modal) + (kind normal) + (archives (byte modal.cma) (native modal.cmxa)) + (plugins (byte modal.cma) (native modal.cmxs)) + (native_archives modal.a) + (main_module_name Modal) + (modes byte native) + (modules + (wrapped + (group + (alias + (obj_name modal) + (visibility public) + (kind alias) + (source (path Modal) (impl (path modal.ml-gen)))) + (name Modal) + (modules + (module + (obj_name modal__Ast) + (visibility public) + (source (path Ast) (impl (path ast.ml)))) + (module + (obj_name modal__Eval) + (visibility public) + (source (path Eval) (impl (path eval.ml)))) + (module + (obj_name modal__Parse) + (visibility public) + (source (path Parse) (impl (path parse.ml)))) + (module + (obj_name modal__Program) + (visibility public) + (source (path Program) (impl (path program.ml)))))) + (wrapped true)))) diff --git a/modal/ocaml/_build/default/modal.install b/modal/ocaml/_build/default/modal.install new file mode 100644 index 0000000..1041cea --- /dev/null +++ b/modal/ocaml/_build/default/modal.install @@ -0,0 +1,37 @@ +lib: [ + "_build/install/default/lib/modal/META" + "_build/install/default/lib/modal/ast.ml" + "_build/install/default/lib/modal/dune-package" + "_build/install/default/lib/modal/eval.ml" + "_build/install/default/lib/modal/modal.a" + "_build/install/default/lib/modal/modal.cma" + "_build/install/default/lib/modal/modal.cmi" + "_build/install/default/lib/modal/modal.cmt" + "_build/install/default/lib/modal/modal.cmx" + "_build/install/default/lib/modal/modal.cmxa" + "_build/install/default/lib/modal/modal.ml" + "_build/install/default/lib/modal/modal__Ast.cmi" + "_build/install/default/lib/modal/modal__Ast.cmt" + "_build/install/default/lib/modal/modal__Ast.cmx" + "_build/install/default/lib/modal/modal__Eval.cmi" + "_build/install/default/lib/modal/modal__Eval.cmt" + "_build/install/default/lib/modal/modal__Eval.cmx" + "_build/install/default/lib/modal/modal__Parse.cmi" + "_build/install/default/lib/modal/modal__Parse.cmt" + "_build/install/default/lib/modal/modal__Parse.cmx" + "_build/install/default/lib/modal/modal__Program.cmi" + "_build/install/default/lib/modal/modal__Program.cmt" + "_build/install/default/lib/modal/modal__Program.cmx" + "_build/install/default/lib/modal/opam" + "_build/install/default/lib/modal/parse.ml" + "_build/install/default/lib/modal/program.ml" +] +libexec: [ + "_build/install/default/lib/modal/modal.cmxs" +] +bin: [ + "_build/install/default/bin/modal" +] +doc: [ + "_build/install/default/doc/modal/README.md" +] diff --git a/modal/ocaml/_build/default/modal.opam b/modal/ocaml/_build/default/modal.opam new file mode 100644 index 0000000..10763d2 --- /dev/null +++ b/modal/ocaml/_build/default/modal.opam @@ -0,0 +1,25 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "0.1.0" +synopsis: "Minimal Modal interpreter" +maintainer: ["eli"] +authors: ["eli"] +license: "MIT" +depends: [ + "dune" {>= "3.11"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] diff --git a/modal/ocaml/_build/default/src/.merlin-conf/lib-modal b/modal/ocaml/_build/default/src/.merlin-conf/lib-modal new file mode 100644 index 0000000..152452b --- /dev/null +++ b/modal/ocaml/_build/default/src/.merlin-conf/lib-modal Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/byte/modal.cmi b/modal/ocaml/_build/default/src/.modal.objs/byte/modal.cmi new file mode 100644 index 0000000..9e89401 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/byte/modal.cmi Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/byte/modal.cmo b/modal/ocaml/_build/default/src/.modal.objs/byte/modal.cmo new file mode 100644 index 0000000..cee1f8e --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/byte/modal.cmo Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/byte/modal.cmt b/modal/ocaml/_build/default/src/.modal.objs/byte/modal.cmt new file mode 100644 index 0000000..8bc3753 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/byte/modal.cmt Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Ast.cmi b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Ast.cmi new file mode 100644 index 0000000..54c31bb --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Ast.cmi Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Ast.cmo b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Ast.cmo new file mode 100644 index 0000000..5b3d01b --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Ast.cmo Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Ast.cmt b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Ast.cmt new file mode 100644 index 0000000..bb640a3 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Ast.cmt Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Eval.cmi b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Eval.cmi new file mode 100644 index 0000000..de78c80 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Eval.cmi Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Eval.cmo b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Eval.cmo new file mode 100644 index 0000000..d5ceed9 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Eval.cmo Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Eval.cmt b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Eval.cmt new file mode 100644 index 0000000..71d8e88 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Eval.cmt Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Parse.cmi b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Parse.cmi new file mode 100644 index 0000000..e258c76 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Parse.cmi Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Parse.cmo b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Parse.cmo new file mode 100644 index 0000000..0da04e7 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Parse.cmo Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Parse.cmt b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Parse.cmt new file mode 100644 index 0000000..6200a93 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Parse.cmt Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Program.cmi b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Program.cmi new file mode 100644 index 0000000..7795ec6 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Program.cmi Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Program.cmo b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Program.cmo new file mode 100644 index 0000000..24658cf --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Program.cmo Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Program.cmt b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Program.cmt new file mode 100644 index 0000000..9b54705 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/byte/modal__Program.cmt Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/modal__Ast.impl.all-deps b/modal/ocaml/_build/default/src/.modal.objs/modal__Ast.impl.all-deps new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/modal__Ast.impl.all-deps diff --git a/modal/ocaml/_build/default/src/.modal.objs/modal__Ast.impl.d b/modal/ocaml/_build/default/src/.modal.objs/modal__Ast.impl.d new file mode 100644 index 0000000..b0f9a19 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/modal__Ast.impl.d @@ -0,0 +1 @@ +src/ast.ml: Format List diff --git a/modal/ocaml/_build/default/src/.modal.objs/modal__Eval.impl.all-deps b/modal/ocaml/_build/default/src/.modal.objs/modal__Eval.impl.all-deps new file mode 100644 index 0000000..676ec7a --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/modal__Eval.impl.all-deps @@ -0,0 +1,2 @@ +modal__Ast +modal__Parse diff --git a/modal/ocaml/_build/default/src/.modal.objs/modal__Eval.impl.d b/modal/ocaml/_build/default/src/.modal.objs/modal__Eval.impl.d new file mode 100644 index 0000000..5b67388 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/modal__Eval.impl.d @@ -0,0 +1 @@ +src/eval.ml: Ast List Map Parse String diff --git a/modal/ocaml/_build/default/src/.modal.objs/modal__Parse.impl.all-deps b/modal/ocaml/_build/default/src/.modal.objs/modal__Parse.impl.all-deps new file mode 100644 index 0000000..ec81abe --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/modal__Parse.impl.all-deps @@ -0,0 +1 @@ +modal__Ast diff --git a/modal/ocaml/_build/default/src/.modal.objs/modal__Parse.impl.d b/modal/ocaml/_build/default/src/.modal.objs/modal__Parse.impl.d new file mode 100644 index 0000000..d178fee --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/modal__Parse.impl.d @@ -0,0 +1 @@ +src/parse.ml: Ast Buffer List String diff --git a/modal/ocaml/_build/default/src/.modal.objs/modal__Program.impl.all-deps b/modal/ocaml/_build/default/src/.modal.objs/modal__Program.impl.all-deps new file mode 100644 index 0000000..676ec7a --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/modal__Program.impl.all-deps @@ -0,0 +1,2 @@ +modal__Ast +modal__Parse diff --git a/modal/ocaml/_build/default/src/.modal.objs/modal__Program.impl.d b/modal/ocaml/_build/default/src/.modal.objs/modal__Program.impl.d new file mode 100644 index 0000000..06fcfc2 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/modal__Program.impl.d @@ -0,0 +1 @@ +src/program.ml: Ast List Parse String diff --git a/modal/ocaml/_build/default/src/.modal.objs/native/modal.cmx b/modal/ocaml/_build/default/src/.modal.objs/native/modal.cmx new file mode 100644 index 0000000..f32e2c0 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/native/modal.cmx Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/native/modal__Ast.cmx b/modal/ocaml/_build/default/src/.modal.objs/native/modal__Ast.cmx new file mode 100644 index 0000000..f7833b5 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/native/modal__Ast.cmx Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/native/modal__Eval.cmx b/modal/ocaml/_build/default/src/.modal.objs/native/modal__Eval.cmx new file mode 100644 index 0000000..16e6d8e --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/native/modal__Eval.cmx Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/native/modal__Parse.cmx b/modal/ocaml/_build/default/src/.modal.objs/native/modal__Parse.cmx new file mode 100644 index 0000000..846d16c --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/native/modal__Parse.cmx Binary files differdiff --git a/modal/ocaml/_build/default/src/.modal.objs/native/modal__Program.cmx b/modal/ocaml/_build/default/src/.modal.objs/native/modal__Program.cmx new file mode 100644 index 0000000..30ee954 --- /dev/null +++ b/modal/ocaml/_build/default/src/.modal.objs/native/modal__Program.cmx Binary files differdiff --git a/modal/ocaml/_build/default/src/ast.ml b/modal/ocaml/_build/default/src/ast.ml new file mode 100644 index 0000000..bf2f275 --- /dev/null +++ b/modal/ocaml/_build/default/src/ast.ml @@ -0,0 +1,22 @@ +(* AST for Modal trees and rules *) + +type node = + | Atom of string + | List of node list + +type rule = { left : node; right : node } + +let atom s = Atom s +let list xs = List xs + +let rec pp fmt = function + | Atom s -> Format.fprintf fmt "%s" s + | List xs -> + Format.fprintf fmt "("; + List.iteri + (fun i n -> + if i > 0 then Format.fprintf fmt " "; pp fmt n) + xs; + Format.fprintf fmt ")" + + diff --git a/modal/ocaml/_build/default/src/eval.ml b/modal/ocaml/_build/default/src/eval.ml new file mode 100644 index 0000000..c22a40c --- /dev/null +++ b/modal/ocaml/_build/default/src/eval.ml @@ -0,0 +1,231 @@ +(* Evaluator: matching, substitution, rewriting driver *) + +open Ast + +module Env = Map.Make (String) + +type env = node Env.t + +let is_register = function + | Atom s when String.length s > 0 && s.[0] = '?' -> true + | _ -> false + +let reg_name = function + | Atom s -> String.sub s 1 (String.length s - 1) + | _ -> invalid_arg "reg_name" + +let rec equal_node a b = + match (a, b) with + | Atom x, Atom y -> String.equal x y + | List xs, List ys -> + List.length xs = List.length ys + && List.for_all2 equal_node xs ys + | _ -> false + +(* Attempt to match pattern against tree, accumulating bindings in env *) +let rec match_pattern env pattern tree = + match pattern with + | p when is_register p -> ( + let name = reg_name p in + match Env.find_opt name env with + | None -> Ok (Env.add name tree env) + | Some bound -> if equal_node bound tree then Ok env else Error ()) + | Atom x -> ( + match tree with Atom y when String.equal x y -> Ok env | _ -> Error ()) + | List pxs -> ( + match tree with + | List txs when List.length pxs = List.length txs -> + List.fold_left2 + (fun acc p t -> match acc with Ok e -> match_pattern e p t | _ -> acc) + (Ok env) pxs txs + | _ -> Error ()) + +let rec substitute env = function + | a when is_register a -> ( + let name = reg_name a in + match Env.find_opt name env with + | Some v -> v + | None -> a) + | Atom _ as a -> a + | List xs -> List (List.map (substitute env) xs) + +(* Configuration for evaluation behavior *) +type config = { mutable quiet : bool; mutable allow_access : bool; mutable cycles : int } + +let default_config () = { quiet = false; allow_access = false; cycles = 0x200000 } + +(* Devices and dynamic forms (AST-based) *) + +let rec node_to_string = function + | Atom s -> s + | List xs -> String.concat "" (List.map node_to_string xs) + +let parse_int_atom s = + try + if String.length s > 1 && s.[0] = '#' then int_of_string_opt ("0x" ^ String.sub s 1 (String.length s - 1)) + else int_of_string_opt s + with _ -> None + +let rec flatten_atoms acc = function + | Atom s -> s :: acc + | List xs -> List.fold_left flatten_atoms acc xs + +let device_eval ~(cfg : config) (node : node) : node option = + match node with + | List (Atom "?:" :: args) -> + (* Print or ALU: if first arg is an operator [+ - * / % & ^ | = ! > <], perform arithmetic; else print all args *) + let alu_ops = [ "+"; "-"; "*"; "/"; "%"; "&"; "^"; "|"; "="; "!"; ">"; "<" ] in + let result_opt = + match args with + | Atom op :: rest when List.mem op alu_ops -> + let nums = + List.filter_map + (fun a -> + match a with Atom s -> parse_int_atom s | List _ -> parse_int_atom (node_to_string a)) + rest + in + (match nums with + | [] -> None + | acc :: tl -> + let f acc n = + match op with + | "+" -> acc + n + | "-" -> acc - n + | "*" -> acc * n + | "/" -> (try acc / n with _ -> acc) + | "%" -> (try acc mod n with _ -> acc) + | "&" -> acc land n + | "^" -> acc lxor n + | "|" -> acc lor n + | "=" -> if acc = n then 1 else 0 + | "!" -> if acc <> n then 1 else 0 + | ">" -> if acc > n then 1 else 0 + | "<" -> if acc < n then 1 else 0 + | _ -> acc + in + let res = List.fold_left f acc tl in + Some (Atom (string_of_int res))) + | _ -> + let s = String.concat "" (List.map node_to_string args) in + if not cfg.quiet then output_string stdout s; + Some (List []) + in + result_opt + | List [ Atom "?_"; path ] -> + if not cfg.allow_access then Some (Atom "NAF") + else ( + let filepath = node_to_string path in + try + let ch = open_in filepath in + let len = in_channel_length ch in + let buf = really_input_string ch len in + close_in ch; + (* Parse the imported string as a node; on failure, return Atom *) + try Some (Parse.parse buf) with _ -> Some (Atom buf) + with _ -> Some (Atom "NAF")) + | List [ Atom "?~" ] -> + if not cfg.allow_access then Some (Atom "EOF") + else ( + try + let buf = really_input_string stdin (in_channel_length stdin) in + Some (Atom buf) + with _ -> Some (Atom "EOF")) + | List [ Atom "?^"; arg ] -> + let atoms = List.rev (flatten_atoms [] arg) in + Some (Atom (String.concat "" atoms)) + | List [ Atom "?."; arg ] -> ( + match arg with List xs -> Some (List xs) | _ -> Some arg) + | List [ Atom "?*"; arg ] -> ( + match arg with + | Atom s -> Some (List (List.init (String.length s) (fun i -> Atom (String.make 1 s.[i])))) + | List xs -> Some (List xs)) + | _ -> None + +let is_define = function List [ Atom "<>"; _; _ ] -> true | _ -> false +let is_undefine = function List [ Atom "><"; _; _ ] -> true | _ -> false + +let extract_lr = function List [ _; l; r ] -> (l, r) | _ -> failwith "extract_lr" + +(* Walk positions in a tree in preorder, returning a zipper-like path *) +type path = (node list * node list) list + +let nodes_with_paths tree = + let rec go acc path = function + | Atom _ as a -> (List.rev path, a) :: acc + | List xs as l -> + let acc' = (List.rev path, l) :: acc in + let rec children acc left right = + match right with + | [] -> acc + | n :: rs -> + let path' = (left, rs) :: path in + let acc'' = go acc path' n in + children acc'' (n :: left) rs + in + children acc' [] xs + in + List.rev (go [] [] tree) + +let replace_at_path root path new_subtree = + let rec rebuild = function + | [] -> new_subtree + | (left, right) :: rest -> + let rebuilt_child = rebuild rest in + let lst = List.rev left @ (rebuilt_child :: right) in + List lst + in + match path with [] -> new_subtree | _ -> rebuild (List.rev path) + +let try_dynamic ~(cfg : config) ~(rules : rule list ref) tree = + let candidates = nodes_with_paths tree in + let rec loop = function + | [] -> None + | (path, node) :: rest -> ( + (* Devices *) + match device_eval ~cfg node with + | Some replacement -> Some (replace_at_path tree path replacement) + | None -> + (* Define / Undefine *) + if is_define node then ( + let l, r = extract_lr node in + rules := !rules @ [ { left = l; right = r } ]; + Some (replace_at_path tree path (List [])) + ) else if is_undefine node then ( + let l, r = extract_lr node in + rules := List.filter (fun ru -> not (equal_node ru.left l && equal_node ru.right r)) !rules; + Some (replace_at_path tree path (List [])) + ) else loop rest) + in + loop candidates + +let try_apply_rule rule tree = + let candidates = nodes_with_paths tree in + let rec loop = function + | [] -> None + | (path, node) :: rest -> ( + match match_pattern Env.empty rule.left node with + | Ok env -> + let rhs = substitute env rule.right in + Some (replace_at_path tree path rhs) + | Error () -> loop rest) + in + loop candidates + +let eval ?(config = default_config ()) rules tree = + let rules_ref = ref rules in + let rec loop cycles_left current = + if cycles_left <= 0 then current + else + match try_dynamic ~cfg:config ~rules:rules_ref current with + | Some t' -> loop (cycles_left - 1) t' + | None -> + let rec scan = function + | [] -> None + | r :: rs -> ( + match try_apply_rule r current with Some t' -> Some t' | None -> scan rs) + in + (match scan !rules_ref with Some t' -> loop (cycles_left - 1) t' | None -> current) + in + loop config.cycles tree + + diff --git a/modal/ocaml/_build/default/src/modal.a b/modal/ocaml/_build/default/src/modal.a new file mode 100644 index 0000000..2e7d3d6 --- /dev/null +++ b/modal/ocaml/_build/default/src/modal.a Binary files differdiff --git a/modal/ocaml/_build/default/src/modal.cma b/modal/ocaml/_build/default/src/modal.cma new file mode 100644 index 0000000..302cf00 --- /dev/null +++ b/modal/ocaml/_build/default/src/modal.cma Binary files differdiff --git a/modal/ocaml/_build/default/src/modal.cmxa b/modal/ocaml/_build/default/src/modal.cmxa new file mode 100644 index 0000000..a7f909b --- /dev/null +++ b/modal/ocaml/_build/default/src/modal.cmxa Binary files differdiff --git a/modal/ocaml/_build/default/src/modal.cmxs b/modal/ocaml/_build/default/src/modal.cmxs new file mode 100755 index 0000000..ac14596 --- /dev/null +++ b/modal/ocaml/_build/default/src/modal.cmxs Binary files differdiff --git a/modal/ocaml/_build/default/src/modal.ml-gen b/modal/ocaml/_build/default/src/modal.ml-gen new file mode 100644 index 0000000..61874fe --- /dev/null +++ b/modal/ocaml/_build/default/src/modal.ml-gen @@ -0,0 +1,13 @@ +(* generated by dune *) + +(** @canonical Modal.Ast *) +module Ast = Modal__Ast + +(** @canonical Modal.Eval *) +module Eval = Modal__Eval + +(** @canonical Modal.Parse *) +module Parse = Modal__Parse + +(** @canonical Modal.Program *) +module Program = Modal__Program diff --git a/modal/ocaml/_build/default/src/parse.ml b/modal/ocaml/_build/default/src/parse.ml new file mode 100644 index 0000000..a415a80 --- /dev/null +++ b/modal/ocaml/_build/default/src/parse.ml @@ -0,0 +1,50 @@ +(* Minimal s-expression parser for Modal syntax *) + +open Ast + +exception Parse_error of string + +let is_space = function ' ' | '\n' | '\t' | '\r' -> true | _ -> false + +let tokenize s = + let buf = Buffer.create 16 in + let tokens = ref [] in + let flush () = + if Buffer.length buf > 0 then ( + tokens := Buffer.contents buf :: !tokens; + Buffer.clear buf) + in + String.iter + (fun c -> + match c with + | '(' | ')' -> flush (); tokens := (String.make 1 c) :: !tokens + | _ when is_space c -> flush () + | _ -> Buffer.add_char buf c) + s; + flush (); List.rev !tokens + +let parse_tokens tokens = + let rec parse_list i = + match List.nth_opt tokens i with + | Some ")" -> ([], i + 1) + | None -> raise (Parse_error "Unclosed list") + | _ -> + let (node, i') = parse_node i in + let (rest, j) = parse_list i' in + (node :: rest, j) + and parse_node i = + match List.nth_opt tokens i with + | Some "(" -> + let (nodes, j) = parse_list (i + 1) in + (List nodes, j) + | Some ")" -> raise (Parse_error "Unexpected )") + | Some tok -> (Atom tok, i + 1) + | None -> raise (Parse_error "Unexpected end") + in + let (node, i) = parse_node 0 in + if i <> List.length tokens then raise (Parse_error "Trailing tokens"); + node + +let parse s = parse_tokens (tokenize s) + + diff --git a/modal/ocaml/_build/default/src/program.ml b/modal/ocaml/_build/default/src/program.ml new file mode 100644 index 0000000..8e209dd --- /dev/null +++ b/modal/ocaml/_build/default/src/program.ml @@ -0,0 +1,70 @@ +(* Loading rules and inputs from a simple .modal text format *) + +open Ast + +(* Lines beginning with "<>" are rules: "<> left right". Lines beginning with ".." are inputs to evaluate, concatenated into a single input tree. *) + +let trim s = String.trim s + +let starts_with pref s = + let n = String.length pref in + String.length s >= n && String.sub s 0 n = pref + +let load_file path : rule list * node option = + let ic = open_in path in + let rec loop rules inputs = + match input_line ic with + | line -> + let line = trim line in + if line = "" then loop rules inputs + else if starts_with "<>" line then ( + let rest = String.sub line 2 (String.length line - 2) |> trim in + (* split rest into two trees by parsing greedily twice *) + (* strategy: parse first tree, then parse second from remaining tokens *) + let tokens = Parse.tokenize rest in + let parse_one toks = + let rec take_tree i depth acc = + match List.nth_opt toks i with + | None -> acc, i + | Some tok -> + let depth' = + if tok = "(" then depth + 1 + else if tok = ")" then depth - 1 + else depth + in + let acc' = acc @ [ tok ] in + if depth' = 0 && acc' <> [] then acc', i + 1 + else take_tree (i + 1) depth' acc' + in + take_tree 0 0 [] + in + let left_toks, i = parse_one tokens in + let rec drop k xs = match (k, xs) with 0, _ -> xs | _, [] -> [] | k, _ :: tl -> drop (k - 1) tl in + let right_toks = drop i tokens in + let left = Parse.parse_tokens left_toks in + let right = Parse.parse_tokens right_toks in + let rules = rules @ [ { left; right } ] in + loop rules inputs) + else if starts_with ".." line then ( + let rest = String.sub line 2 (String.length line - 2) |> trim in + let node = Parse.parse rest in + loop rules (inputs @ [ node ])) + else ( + (* Treat any other non-empty line as an input expression *) + try + let node = Parse.parse line in + loop rules (inputs @ [ node ]) + with _ -> loop rules inputs) + | exception End_of_file -> + close_in ic; + let input = + match inputs with + | [] -> None + | [ x ] -> Some x + | xs -> Some (List xs) + in + (rules, input) + in + loop [] [] + + diff --git a/modal/ocaml/_build/log b/modal/ocaml/_build/log new file mode 100644 index 0000000..ac231d0 --- /dev/null +++ b/modal/ocaml/_build/log @@ -0,0 +1,16 @@ +# dune exec modal -- -q /Users/eli/Code/tour/modal/tests/cases/03_and_or_not.modal +# OCAMLPARAM: unset +# Shared cache: enabled-except-user-rules +# Shared cache location: /Users/eli/.cache/dune/db +# Workspace root: /Users/eli/Code/tour/modal/ocaml +# Auto-detected concurrency: 12 +# Dune context: +# { name = "default" +# ; kind = "default" +# ; profile = Dev +# ; merlin = true +# ; fdo_target_exe = None +# ; build_dir = In_build_dir "default" +# ; instrument_with = [] +# } +$ /Users/eli/.opam/default/bin/ocamlc.opt -config > /var/folders/m5/0f01vcws5td_kbb882wcb70c0000gn/T/dune_22e00f_output diff --git a/modal/ocaml/app/dune b/modal/ocaml/app/dune new file mode 100644 index 0000000..6666cbf --- /dev/null +++ b/modal/ocaml/app/dune @@ -0,0 +1,5 @@ +(executable + (name main) + (public_name modal) + (libraries modal)) + diff --git a/modal/ocaml/app/main.ml b/modal/ocaml/app/main.ml new file mode 100644 index 0000000..63ecfb9 --- /dev/null +++ b/modal/ocaml/app/main.ml @@ -0,0 +1,34 @@ +module Ast = Modal.Ast +module Parse = Modal.Parse +module Eval = Modal.Eval +module Program = Modal.Program + +let () = + let usage = "Usage: modal [-q] [-a] [-n] RULES.modal [INPUT]" in + if Array.length Sys.argv < 2 then (prerr_endline usage; exit 2); + let cfg = Eval.default_config () in + let rec parse_flags i = + if i < Array.length Sys.argv && String.length Sys.argv.(i) > 0 && Sys.argv.(i).[0] = '-' then ( + (match Sys.argv.(i) with + | "-q" -> cfg.quiet <- true + | "-a" -> cfg.allow_access <- true + | "-n" -> cfg.cycles <- 0x7fffffff + | _ -> ()); + parse_flags (i + 1)) + else i + in + let i = parse_flags 1 in + if i >= Array.length Sys.argv then (prerr_endline usage; exit 2); + let rules_path = Sys.argv.(i) in + let input_arg = if i + 1 < Array.length Sys.argv then Some Sys.argv.(i + 1) else None in + let rules, file_input = Program.load_file rules_path in + let input = + match input_arg with + | Some s -> Parse.parse s + | None -> ( + match file_input with Some n -> n | None -> Ast.List []) + in + let result = Eval.eval ~config:cfg rules input in + Format.printf "%a\n" Ast.pp result + + diff --git a/modal/ocaml/dune b/modal/ocaml/dune new file mode 100644 index 0000000..8ab0595 --- /dev/null +++ b/modal/ocaml/dune @@ -0,0 +1,7 @@ +(env + (dev + (flags (:standard -w -27-32-26-8-9-6-10)))) + +(subdir src) +(subdir app) + diff --git a/modal/ocaml/dune-project b/modal/ocaml/dune-project new file mode 100644 index 0000000..13c3ca4 --- /dev/null +++ b/modal/ocaml/dune-project @@ -0,0 +1,6 @@ +(lang dune 3.11) +(name modal) +(using menhir 2.1) +(generate_opam_files true) +(formatting disabled) + diff --git a/modal/ocaml/examples/arith.modal b/modal/ocaml/examples/arith.modal new file mode 100644 index 0000000..2193724 --- /dev/null +++ b/modal/ocaml/examples/arith.modal @@ -0,0 +1,13 @@ +.. (?: + 10 2) +.. (?: - 10 2) +.. (?: * 6 7) +.. (?: / 21 3) +.. (?: % 21 5) +.. (?: & 6 3) +.. (?: ^ 6 3) +.. (?: | 6 1) +.. (?: = 5 5) +.. (?: ! 5 6) +.. (?: > 9 2) +.. (?: < 2 9) + diff --git a/modal/ocaml/examples/devices.modal b/modal/ocaml/examples/devices.modal new file mode 100644 index 0000000..82f5a4e --- /dev/null +++ b/modal/ocaml/examples/devices.modal @@ -0,0 +1,6 @@ +.. (?: Hello) +.. (?: + 1 2 3) +.. (?^ (a (b c))) +.. (?. (a (b))) +.. (?* abc) + diff --git a/modal/ocaml/examples/dynamic_rules.modal b/modal/ocaml/examples/dynamic_rules.modal new file mode 100644 index 0000000..7e17f76 --- /dev/null +++ b/modal/ocaml/examples/dynamic_rules.modal @@ -0,0 +1,5 @@ +.. ((eq fox bat) (eq bat bat)) +.. ((<>) (eq ?x ?x) (#t)) +.. ((<>) (eq ?x ?y) (#f)) +.. (>< (eq ?x ?y) (#f)) + diff --git a/modal/ocaml/examples/logic.modal b/modal/ocaml/examples/logic.modal new file mode 100644 index 0000000..ec94b55 --- /dev/null +++ b/modal/ocaml/examples/logic.modal @@ -0,0 +1,6 @@ +<> (eq ?x ?x) (#t) +<> (eq ?x ?y) (#f) + +.. (eq fox bat) +.. (eq bat bat) + diff --git a/modal/ocaml/examples/print_and_list.modal b/modal/ocaml/examples/print_and_list.modal new file mode 100644 index 0000000..3de51cb --- /dev/null +++ b/modal/ocaml/examples/print_and_list.modal @@ -0,0 +1,5 @@ +<> (print List (?: ?x)) (print List ?x) +<> (print List ()) () + +.. (print List (h (e (l (l (o ())))))) + diff --git a/modal/ocaml/modal.opam b/modal/ocaml/modal.opam new file mode 100644 index 0000000..10763d2 --- /dev/null +++ b/modal/ocaml/modal.opam @@ -0,0 +1,25 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "0.1.0" +synopsis: "Minimal Modal interpreter" +maintainer: ["eli"] +authors: ["eli"] +license: "MIT" +depends: [ + "dune" {>= "3.11"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] diff --git a/modal/ocaml/src/ast.ml b/modal/ocaml/src/ast.ml new file mode 100644 index 0000000..bf2f275 --- /dev/null +++ b/modal/ocaml/src/ast.ml @@ -0,0 +1,22 @@ +(* AST for Modal trees and rules *) + +type node = + | Atom of string + | List of node list + +type rule = { left : node; right : node } + +let atom s = Atom s +let list xs = List xs + +let rec pp fmt = function + | Atom s -> Format.fprintf fmt "%s" s + | List xs -> + Format.fprintf fmt "("; + List.iteri + (fun i n -> + if i > 0 then Format.fprintf fmt " "; pp fmt n) + xs; + Format.fprintf fmt ")" + + diff --git a/modal/ocaml/src/dune b/modal/ocaml/src/dune new file mode 100644 index 0000000..d4b7f7a --- /dev/null +++ b/modal/ocaml/src/dune @@ -0,0 +1,5 @@ +(library + (name modal) + (public_name modal) + (libraries)) + diff --git a/modal/ocaml/src/eval.ml b/modal/ocaml/src/eval.ml new file mode 100644 index 0000000..c22a40c --- /dev/null +++ b/modal/ocaml/src/eval.ml @@ -0,0 +1,231 @@ +(* Evaluator: matching, substitution, rewriting driver *) + +open Ast + +module Env = Map.Make (String) + +type env = node Env.t + +let is_register = function + | Atom s when String.length s > 0 && s.[0] = '?' -> true + | _ -> false + +let reg_name = function + | Atom s -> String.sub s 1 (String.length s - 1) + | _ -> invalid_arg "reg_name" + +let rec equal_node a b = + match (a, b) with + | Atom x, Atom y -> String.equal x y + | List xs, List ys -> + List.length xs = List.length ys + && List.for_all2 equal_node xs ys + | _ -> false + +(* Attempt to match pattern against tree, accumulating bindings in env *) +let rec match_pattern env pattern tree = + match pattern with + | p when is_register p -> ( + let name = reg_name p in + match Env.find_opt name env with + | None -> Ok (Env.add name tree env) + | Some bound -> if equal_node bound tree then Ok env else Error ()) + | Atom x -> ( + match tree with Atom y when String.equal x y -> Ok env | _ -> Error ()) + | List pxs -> ( + match tree with + | List txs when List.length pxs = List.length txs -> + List.fold_left2 + (fun acc p t -> match acc with Ok e -> match_pattern e p t | _ -> acc) + (Ok env) pxs txs + | _ -> Error ()) + +let rec substitute env = function + | a when is_register a -> ( + let name = reg_name a in + match Env.find_opt name env with + | Some v -> v + | None -> a) + | Atom _ as a -> a + | List xs -> List (List.map (substitute env) xs) + +(* Configuration for evaluation behavior *) +type config = { mutable quiet : bool; mutable allow_access : bool; mutable cycles : int } + +let default_config () = { quiet = false; allow_access = false; cycles = 0x200000 } + +(* Devices and dynamic forms (AST-based) *) + +let rec node_to_string = function + | Atom s -> s + | List xs -> String.concat "" (List.map node_to_string xs) + +let parse_int_atom s = + try + if String.length s > 1 && s.[0] = '#' then int_of_string_opt ("0x" ^ String.sub s 1 (String.length s - 1)) + else int_of_string_opt s + with _ -> None + +let rec flatten_atoms acc = function + | Atom s -> s :: acc + | List xs -> List.fold_left flatten_atoms acc xs + +let device_eval ~(cfg : config) (node : node) : node option = + match node with + | List (Atom "?:" :: args) -> + (* Print or ALU: if first arg is an operator [+ - * / % & ^ | = ! > <], perform arithmetic; else print all args *) + let alu_ops = [ "+"; "-"; "*"; "/"; "%"; "&"; "^"; "|"; "="; "!"; ">"; "<" ] in + let result_opt = + match args with + | Atom op :: rest when List.mem op alu_ops -> + let nums = + List.filter_map + (fun a -> + match a with Atom s -> parse_int_atom s | List _ -> parse_int_atom (node_to_string a)) + rest + in + (match nums with + | [] -> None + | acc :: tl -> + let f acc n = + match op with + | "+" -> acc + n + | "-" -> acc - n + | "*" -> acc * n + | "/" -> (try acc / n with _ -> acc) + | "%" -> (try acc mod n with _ -> acc) + | "&" -> acc land n + | "^" -> acc lxor n + | "|" -> acc lor n + | "=" -> if acc = n then 1 else 0 + | "!" -> if acc <> n then 1 else 0 + | ">" -> if acc > n then 1 else 0 + | "<" -> if acc < n then 1 else 0 + | _ -> acc + in + let res = List.fold_left f acc tl in + Some (Atom (string_of_int res))) + | _ -> + let s = String.concat "" (List.map node_to_string args) in + if not cfg.quiet then output_string stdout s; + Some (List []) + in + result_opt + | List [ Atom "?_"; path ] -> + if not cfg.allow_access then Some (Atom "NAF") + else ( + let filepath = node_to_string path in + try + let ch = open_in filepath in + let len = in_channel_length ch in + let buf = really_input_string ch len in + close_in ch; + (* Parse the imported string as a node; on failure, return Atom *) + try Some (Parse.parse buf) with _ -> Some (Atom buf) + with _ -> Some (Atom "NAF")) + | List [ Atom "?~" ] -> + if not cfg.allow_access then Some (Atom "EOF") + else ( + try + let buf = really_input_string stdin (in_channel_length stdin) in + Some (Atom buf) + with _ -> Some (Atom "EOF")) + | List [ Atom "?^"; arg ] -> + let atoms = List.rev (flatten_atoms [] arg) in + Some (Atom (String.concat "" atoms)) + | List [ Atom "?."; arg ] -> ( + match arg with List xs -> Some (List xs) | _ -> Some arg) + | List [ Atom "?*"; arg ] -> ( + match arg with + | Atom s -> Some (List (List.init (String.length s) (fun i -> Atom (String.make 1 s.[i])))) + | List xs -> Some (List xs)) + | _ -> None + +let is_define = function List [ Atom "<>"; _; _ ] -> true | _ -> false +let is_undefine = function List [ Atom "><"; _; _ ] -> true | _ -> false + +let extract_lr = function List [ _; l; r ] -> (l, r) | _ -> failwith "extract_lr" + +(* Walk positions in a tree in preorder, returning a zipper-like path *) +type path = (node list * node list) list + +let nodes_with_paths tree = + let rec go acc path = function + | Atom _ as a -> (List.rev path, a) :: acc + | List xs as l -> + let acc' = (List.rev path, l) :: acc in + let rec children acc left right = + match right with + | [] -> acc + | n :: rs -> + let path' = (left, rs) :: path in + let acc'' = go acc path' n in + children acc'' (n :: left) rs + in + children acc' [] xs + in + List.rev (go [] [] tree) + +let replace_at_path root path new_subtree = + let rec rebuild = function + | [] -> new_subtree + | (left, right) :: rest -> + let rebuilt_child = rebuild rest in + let lst = List.rev left @ (rebuilt_child :: right) in + List lst + in + match path with [] -> new_subtree | _ -> rebuild (List.rev path) + +let try_dynamic ~(cfg : config) ~(rules : rule list ref) tree = + let candidates = nodes_with_paths tree in + let rec loop = function + | [] -> None + | (path, node) :: rest -> ( + (* Devices *) + match device_eval ~cfg node with + | Some replacement -> Some (replace_at_path tree path replacement) + | None -> + (* Define / Undefine *) + if is_define node then ( + let l, r = extract_lr node in + rules := !rules @ [ { left = l; right = r } ]; + Some (replace_at_path tree path (List [])) + ) else if is_undefine node then ( + let l, r = extract_lr node in + rules := List.filter (fun ru -> not (equal_node ru.left l && equal_node ru.right r)) !rules; + Some (replace_at_path tree path (List [])) + ) else loop rest) + in + loop candidates + +let try_apply_rule rule tree = + let candidates = nodes_with_paths tree in + let rec loop = function + | [] -> None + | (path, node) :: rest -> ( + match match_pattern Env.empty rule.left node with + | Ok env -> + let rhs = substitute env rule.right in + Some (replace_at_path tree path rhs) + | Error () -> loop rest) + in + loop candidates + +let eval ?(config = default_config ()) rules tree = + let rules_ref = ref rules in + let rec loop cycles_left current = + if cycles_left <= 0 then current + else + match try_dynamic ~cfg:config ~rules:rules_ref current with + | Some t' -> loop (cycles_left - 1) t' + | None -> + let rec scan = function + | [] -> None + | r :: rs -> ( + match try_apply_rule r current with Some t' -> Some t' | None -> scan rs) + in + (match scan !rules_ref with Some t' -> loop (cycles_left - 1) t' | None -> current) + in + loop config.cycles tree + + diff --git a/modal/ocaml/src/parse.ml b/modal/ocaml/src/parse.ml new file mode 100644 index 0000000..a415a80 --- /dev/null +++ b/modal/ocaml/src/parse.ml @@ -0,0 +1,50 @@ +(* Minimal s-expression parser for Modal syntax *) + +open Ast + +exception Parse_error of string + +let is_space = function ' ' | '\n' | '\t' | '\r' -> true | _ -> false + +let tokenize s = + let buf = Buffer.create 16 in + let tokens = ref [] in + let flush () = + if Buffer.length buf > 0 then ( + tokens := Buffer.contents buf :: !tokens; + Buffer.clear buf) + in + String.iter + (fun c -> + match c with + | '(' | ')' -> flush (); tokens := (String.make 1 c) :: !tokens + | _ when is_space c -> flush () + | _ -> Buffer.add_char buf c) + s; + flush (); List.rev !tokens + +let parse_tokens tokens = + let rec parse_list i = + match List.nth_opt tokens i with + | Some ")" -> ([], i + 1) + | None -> raise (Parse_error "Unclosed list") + | _ -> + let (node, i') = parse_node i in + let (rest, j) = parse_list i' in + (node :: rest, j) + and parse_node i = + match List.nth_opt tokens i with + | Some "(" -> + let (nodes, j) = parse_list (i + 1) in + (List nodes, j) + | Some ")" -> raise (Parse_error "Unexpected )") + | Some tok -> (Atom tok, i + 1) + | None -> raise (Parse_error "Unexpected end") + in + let (node, i) = parse_node 0 in + if i <> List.length tokens then raise (Parse_error "Trailing tokens"); + node + +let parse s = parse_tokens (tokenize s) + + diff --git a/modal/ocaml/src/program.ml b/modal/ocaml/src/program.ml new file mode 100644 index 0000000..8e209dd --- /dev/null +++ b/modal/ocaml/src/program.ml @@ -0,0 +1,70 @@ +(* Loading rules and inputs from a simple .modal text format *) + +open Ast + +(* Lines beginning with "<>" are rules: "<> left right". Lines beginning with ".." are inputs to evaluate, concatenated into a single input tree. *) + +let trim s = String.trim s + +let starts_with pref s = + let n = String.length pref in + String.length s >= n && String.sub s 0 n = pref + +let load_file path : rule list * node option = + let ic = open_in path in + let rec loop rules inputs = + match input_line ic with + | line -> + let line = trim line in + if line = "" then loop rules inputs + else if starts_with "<>" line then ( + let rest = String.sub line 2 (String.length line - 2) |> trim in + (* split rest into two trees by parsing greedily twice *) + (* strategy: parse first tree, then parse second from remaining tokens *) + let tokens = Parse.tokenize rest in + let parse_one toks = + let rec take_tree i depth acc = + match List.nth_opt toks i with + | None -> acc, i + | Some tok -> + let depth' = + if tok = "(" then depth + 1 + else if tok = ")" then depth - 1 + else depth + in + let acc' = acc @ [ tok ] in + if depth' = 0 && acc' <> [] then acc', i + 1 + else take_tree (i + 1) depth' acc' + in + take_tree 0 0 [] + in + let left_toks, i = parse_one tokens in + let rec drop k xs = match (k, xs) with 0, _ -> xs | _, [] -> [] | k, _ :: tl -> drop (k - 1) tl in + let right_toks = drop i tokens in + let left = Parse.parse_tokens left_toks in + let right = Parse.parse_tokens right_toks in + let rules = rules @ [ { left; right } ] in + loop rules inputs) + else if starts_with ".." line then ( + let rest = String.sub line 2 (String.length line - 2) |> trim in + let node = Parse.parse rest in + loop rules (inputs @ [ node ])) + else ( + (* Treat any other non-empty line as an input expression *) + try + let node = Parse.parse line in + loop rules (inputs @ [ node ]) + with _ -> loop rules inputs) + | exception End_of_file -> + close_in ic; + let input = + match inputs with + | [] -> None + | [ x ] -> Some x + | xs -> Some (List xs) + in + (rules, input) + in + loop [] [] + + diff --git a/modal/tests/README.md b/modal/tests/README.md new file mode 100644 index 0000000..13d5f85 --- /dev/null +++ b/modal/tests/README.md @@ -0,0 +1,15 @@ +## Modal cross-impl tests + +This runner builds the C and OCaml interpreters and compares outputs for each `.modal` file in `tests/cases/`. + +Usage: + +``` +./tests/run.sh +``` + +Notes: +- Each test case is a `.modal` file consumable by both interpreters. Prefer using `..` input lines. +- The runner normalizes OCaml’s final tree format slightly for comparison and extracts the C interpreter final tree from stderr. + + diff --git a/modal/tests/cases/01_eq.modal b/modal/tests/cases/01_eq.modal new file mode 100644 index 0000000..bdc5c09 --- /dev/null +++ b/modal/tests/cases/01_eq.modal @@ -0,0 +1,5 @@ +<> (eq ?x ?x) (#t) +<> (eq ?x ?y) (#f) + +.. (eq fox bat) +.. (eq bat bat) diff --git a/modal/tests/cases/02_copy_swap.modal b/modal/tests/cases/02_copy_swap.modal new file mode 100644 index 0000000..5d51f9b --- /dev/null +++ b/modal/tests/cases/02_copy_swap.modal @@ -0,0 +1,4 @@ +<> (copy ?a) (?a ?a) +<> (swap ?x ?y) (?y ?x) + +(copy cat) (swap bat rat) diff --git a/modal/tests/cases/03_and_or_not.modal b/modal/tests/cases/03_and_or_not.modal new file mode 100644 index 0000000..1bafb64 --- /dev/null +++ b/modal/tests/cases/03_and_or_not.modal @@ -0,0 +1,7 @@ +<> (and #t #t) #t <> (or #t #t) #t +<> (and #t #f) #f <> (or #t #f) #t +<> (and #f #t) #f <> (or #f #t) #t +<> (and #f #f) #f <> (or #f #f) #f +<> (not #t) #f <> (not #f) #t + +(not (and #t #f)) diff --git a/modal/tests/cases/04_ife.modal b/modal/tests/cases/04_ife.modal new file mode 100644 index 0000000..1718fdc --- /dev/null +++ b/modal/tests/cases/04_ife.modal @@ -0,0 +1,4 @@ +<> (ife #t ?t ?f) ?t +<> (ife #f ?t ?f) ?f + +(ife #t yes no) diff --git a/modal/tests/cases/05_numbers_sub.modal b/modal/tests/cases/05_numbers_sub.modal new file mode 100644 index 0000000..de8db98 --- /dev/null +++ b/modal/tests/cases/05_numbers_sub.modal @@ -0,0 +1,4 @@ +<> ((?a) - (?b)) (?a - ?b) +<> (?a - 0) (difference ?a) + +(5 - 2) diff --git a/modal/tests/cases/06_lists_reverse.modal b/modal/tests/cases/06_lists_reverse.modal new file mode 100644 index 0000000..3eb0c94 --- /dev/null +++ b/modal/tests/cases/06_lists_reverse.modal @@ -0,0 +1,6 @@ +<> (reverse List (?x ?y) ?z) (reverse List ?y (?x ?z)) +<> (reverse List ?empty ?list) (print List ?list) +<> (print List (?: ?x)) (print List ?x) +<> (print List ()) () + +(reverse List (m (o (d (a (l ()))))) ()) diff --git a/modal/tests/cases/07_dynamic_define.modal b/modal/tests/cases/07_dynamic_define.modal new file mode 100644 index 0000000..e9a3a71 --- /dev/null +++ b/modal/tests/cases/07_dynamic_define.modal @@ -0,0 +1,4 @@ +(<>) (copy ?a) (?a ?a) +(copy x) +(><) (copy ?a) (?a ?a) +(copy y) diff --git a/modal/tests/run.sh b/modal/tests/run.sh new file mode 100755 index 0000000..8902829 --- /dev/null +++ b/modal/tests/run.sh @@ -0,0 +1,49 @@ +#!/usr/bin/env bash +set -euo pipefail + +ROOT_DIR="$(cd "$(dirname "$0")/.." && pwd)" +BUILD_DIR="$ROOT_DIR/build" +OCAML_DIR="$ROOT_DIR/ocaml" +CASES_DIR="$ROOT_DIR/tests/cases" + +mkdir -p "$BUILD_DIR" + +echo "[1/3] Build C interpreter" +cc -O2 -o "$BUILD_DIR/modal_c" "$ROOT_DIR/modal.c" + +echo "[2/3] Build OCaml interpreter" +(cd "$OCAML_DIR" && opam exec -- dune build @install) + +echo "[3/3] Run test cases" +fail=0 +for case in "$CASES_DIR"/*.modal; do + [ -e "$case" ] || continue + rel="${case#$ROOT_DIR/}" + printf " - %s... " "$rel" + + # Skip non-parity features between OCaml AST engine and C stream engine + if grep -q "(<>\)" "$case" || grep -q "(><\)" "$case"; then + echo "SKIP" + continue + fi + + ocaml_out=$(cd "$OCAML_DIR" && opam exec -- dune exec modal -- -q "$case" 2>/dev/null | tr -d '\n' | sed -e 's/^((/(/' -e 's/))$/)/') + c_out=$("$BUILD_DIR/modal_c" "$case" 2>&1 1>/dev/null | sed -n 's/^\.\. \(.*\)$/\1/p' | tr -d '\n') + + if [ "$ocaml_out" = "$c_out" ]; then + echo "OK" + else + echo "FAIL" + echo " OCaml: $ocaml_out" + echo " C : $c_out" + fail=$((fail+1)) + fi +done + +if [ "$fail" -ne 0 ]; then + echo "Tests failed: $fail" + exit 1 +fi + +echo "All tests passed" + |