├── src ├── parser_context.ml ├── expr_err.ml ├── dune ├── sgen_ast.ml ├── parser.mly ├── unification.ml ├── lsc_pretty.ml ├── web_interface.ml ├── lexer.ml ├── parse_error.ml ├── lsc_ast.ml ├── sgen_parsing.ml └── sgen_eval.ml ├── test ├── errors │ ├── unclosed_paren.sg │ ├── mismatched_bracket.sg │ ├── mismatched_paren.sg │ ├── invalid_declaration.sg │ ├── unknown_escape.sg │ ├── invalid_string_char.sg │ ├── unterminated_string.sg │ └── multiple_errors.sg ├── syntax.t ├── syntax │ ├── records.sg │ ├── linear.sg │ └── prolog.sg ├── dune ├── README.md ├── errors.t └── examples.t ├── exercises ├── README.md ├── 02-registers.sg ├── 01-paths.sg ├── 00-unification.sg ├── solutions │ ├── 01-paths.sg │ ├── 00-unification.sg │ ├── 02-registers.sg │ └── 03-boolean.sg └── 03-boolean.sg ├── .ocamlformat-ignore ├── nvim ├── README.md ├── ftdetect │ └── stellogen.vim └── syntax │ └── stellogen.vim ├── .gitignore ├── bin ├── dune └── sgen.ml ├── web ├── dune ├── build.sh ├── playground.ml ├── README.md └── build-examples.js ├── examples ├── proofnets │ ├── mall.sg │ ├── fomll.sg │ └── mll.sg ├── sumtypes.sg ├── naive_nat.sg ├── stack.sg ├── hello.sg ├── lambda │ ├── lambda.sg │ └── linear_lambda.sg ├── macro_demo.sg ├── milkyway │ └── prelude.sg ├── states │ ├── nfa.sg │ ├── npda.sg │ └── turing.sg ├── prolog │ ├── family.sg │ └── arithmetic.sg ├── circuits.sg ├── binary4.sg └── syntax.sg ├── default.nix ├── dune-project ├── stellogen.opam ├── .ocamlformat ├── flake.nix ├── .github └── workflows │ └── build.yml ├── docs ├── incremental_parsing_implementation.md ├── error_recovery_demo.md ├── error_recovery.md ├── error_recovery_implementation.md ├── incremental_parsing.md └── unification_and_term_rewriting.md ├── README.md ├── BASICS.md └── CLAUDE.md /src/parser_context.ml: -------------------------------------------------------------------------------- 1 | let current_filename = ref "" 2 | -------------------------------------------------------------------------------- /test/errors/unclosed_paren.sg: -------------------------------------------------------------------------------- 1 | ' Test unclosed parenthesis 2 | (def test (foo bar) -------------------------------------------------------------------------------- /test/errors/mismatched_bracket.sg: -------------------------------------------------------------------------------- 1 | ' Test mismatched brackets 2 | (def test [foo bar}) -------------------------------------------------------------------------------- /test/errors/mismatched_paren.sg: -------------------------------------------------------------------------------- 1 | ' Test mismatched parentheses 2 | (def test (foo bar] -------------------------------------------------------------------------------- /test/errors/invalid_declaration.sg: -------------------------------------------------------------------------------- 1 | ' Test invalid declaration syntax 2 | (invalid-op foo bar) -------------------------------------------------------------------------------- /test/errors/unknown_escape.sg: -------------------------------------------------------------------------------- 1 | ' Test unknown escape sequence 2 | (def test "hello\xworld") -------------------------------------------------------------------------------- /test/errors/invalid_string_char.sg: -------------------------------------------------------------------------------- 1 | ' Test invalid escape in string 2 | (def test "valid\qinvalid") -------------------------------------------------------------------------------- /test/errors/unterminated_string.sg: -------------------------------------------------------------------------------- 1 | ' Test unterminated string literal 2 | (def test "unterminated -------------------------------------------------------------------------------- /exercises/README.md: -------------------------------------------------------------------------------- 1 | # Stellogen exercises 2 | 3 | Make the programs compile by following the instructions. 4 | -------------------------------------------------------------------------------- /.ocamlformat-ignore: -------------------------------------------------------------------------------- 1 | src/stellogen/lsc_ast.ml 2 | src/stellogen/lsc_parser.mly 3 | src/stellogen/unification.ml 4 | -------------------------------------------------------------------------------- /test/errors/multiple_errors.sg: -------------------------------------------------------------------------------- 1 | ' Test multiple syntax errors 2 | (def test1 "unterminated 3 | (def test2 [foo bar}) 4 | -------------------------------------------------------------------------------- /nvim/README.md: -------------------------------------------------------------------------------- 1 | # Stellogen for neovim 2 | 3 | Add the content of the `nvim` folder in your neovim configuration folder 4 | (usually `~/.config/nvim`). 5 | -------------------------------------------------------------------------------- /nvim/ftdetect/stellogen.vim: -------------------------------------------------------------------------------- 1 | autocmd BufNewFile,BufRead *.sg setfiletype stellogen 2 | autocmd FileType stellogen setlocal shiftwidth=2 softtabstop=2 expandtab commentstring='\ %s 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build/* 2 | *.cmi 3 | *.cmo 4 | _opam/ 5 | 6 | # Web playground deployment directory 7 | web_deploy/ 8 | web/examples.js 9 | 10 | # Deployment script 11 | deploy.sh 12 | -------------------------------------------------------------------------------- /src/expr_err.ml: -------------------------------------------------------------------------------- 1 | type expr_err = 2 | | EmptyRay 3 | | NonConstantRayHeader of string 4 | | InvalidBan of string 5 | | InvalidRaylist of string 6 | | InvalidDeclaration of string 7 | -------------------------------------------------------------------------------- /bin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (public_name sgen) 3 | (name sgen) 4 | (libraries stellogen base cmdliner unix)) 5 | 6 | (env 7 | (dev 8 | (flags 9 | (:standard -warn-error -A)))) 10 | -------------------------------------------------------------------------------- /web/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name playground) 3 | (modes js) 4 | (libraries stellogen js_of_ocaml) 5 | (preprocess 6 | (pps js_of_ocaml-ppx))) 7 | 8 | (rule 9 | (target playground.js) 10 | (deps playground.bc.js) 11 | (action 12 | (copy %{deps} %{target}))) 13 | -------------------------------------------------------------------------------- /test/syntax.t: -------------------------------------------------------------------------------- 1 | Test syntax - basic syntax tests 2 | ================================== 3 | 4 | Linear execution test: 5 | $ sgen run syntax/linear.sg 6 | 7 | Prolog-style test: 8 | $ sgen run syntax/prolog.sg 9 | 10 | Records test: 11 | $ sgen run syntax/records.sg 12 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name stellogen) 3 | (libraries base menhirLib) 4 | (preprocess 5 | (pps sedlex.ppx ppx_deriving.show ppx_deriving.ord ppx_deriving.eq))) 6 | 7 | (env 8 | (dev 9 | (flags 10 | (:standard -warn-error -A)))) 11 | 12 | (menhir 13 | (modules parser) 14 | (flags --table --dump --explain)) 15 | -------------------------------------------------------------------------------- /examples/proofnets/mall.sg: -------------------------------------------------------------------------------- 1 | (use-macros "../milkyway/prelude.sg") 2 | 3 | (def left [(+5 [l l|X]) (+5 [l r|X]) || (slice c a)]) 4 | (def right [(+5 [r l|X]) (+5 [r r|X]) || (slice c b)]) 5 | 6 | (def with { #left #right }) 7 | 8 | (def plus { 9 | [(+3 [l l|X]) (c X)] 10 | [(+3 [l r|X]) (d X)]}) 11 | 12 | (def cut [(-5 X) (-3 X)]) 13 | 14 | (stack show exec (process 15 | #with 16 | { #plus #cut })) 17 | -------------------------------------------------------------------------------- /test/syntax/records.sg: -------------------------------------------------------------------------------- 1 | (def g { 2 | [(+field test1) 1] 3 | [(+field test2) { 4 | [(+field test21) 2] 5 | [(+field test22) { 6 | [(+field test3) 3]}]}]}) 7 | 8 | (def (get G X) (exec #G @[(-field X)])) 9 | 10 | (def test1 #(get g test1)) 11 | (== #test1 1) 12 | 13 | (def test2 #(get g test2)) 14 | (== #(get test2 test21) 2) 15 | 16 | (def test22 #(get test2 test22)) 17 | (== #(get test22 test3) 3) 18 | -------------------------------------------------------------------------------- /examples/sumtypes.sg: -------------------------------------------------------------------------------- 1 | (use-macros "milkyway/prelude.sg") 2 | 3 | (spec direction { 4 | [-north ok] 5 | [-south ok] 6 | [-west ok] 7 | [-east ok]}) 8 | 9 | (def n +north) (:: n direction) 10 | 11 | (spec result { [(-ok X) ok] [(-error X) ok]}) 12 | 13 | (def x (+ok a)) (:: x result) 14 | 15 | 'pattern matching 16 | (def get_ok { 17 | [(-ok X) X] 18 | [(-error X) (+error X)]}) 19 | 20 | (show (exec #get_ok @#x)) 21 | -------------------------------------------------------------------------------- /examples/naive_nat.sg: -------------------------------------------------------------------------------- 1 | (use-macros "milkyway/prelude.sg") 2 | 3 | (spec nat { 4 | [(-nat 0) ok] 5 | [(-nat (s N)) (+nat N)]}) 6 | 7 | (def 0 (+nat 0)) (:: 0 nat) 8 | (def 1 (+nat (s 0))) (:: 1 nat) 9 | (def 2 (stack +nat s s 0)) (:: 2 nat) 10 | 11 | (def add1 [(-nat X) (+nat (s X))]) 12 | 13 | (def is_empty { 14 | [(-nat 0) (res 1)] 15 | [(-nat (s _)) (res 0)]}) 16 | 17 | (show (exec @#add1 #2)) 18 | (show (exec #is_empty @#0)) 19 | (show (exec #is_empty @#1)) 20 | -------------------------------------------------------------------------------- /test/syntax/linear.sg: -------------------------------------------------------------------------------- 1 | (macro (spec X Y) (def X Y)) 2 | (macro (stack A B) (A B)) 3 | (macro (stack A B C ...) (A (stack B C ...))) 4 | 5 | (def 1 (+nat (s 0))) 6 | (def 2 (+nat (stack s s 0))) 7 | (def 3 (+nat (stack s s s 0))) 8 | 9 | (spec nat [(-nat (s X)) (+nat X)]) 10 | 11 | (def tested @(fire @#1 #nat)) 12 | (== #tested (+nat 0)) 13 | 14 | (def tested @(fire @#2 #nat)) 15 | (== #tested (+nat (s 0))) 16 | 17 | (def tested @(fire @#3 #nat)) 18 | (== #tested (+nat (stack s s 0))) 19 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | # This file provides backward compatibility to nix < 2.4 clients 2 | { system ? builtins.currentSystem }: 3 | let 4 | lock = builtins.fromJSON (builtins.readFile ./flake.lock); 5 | 6 | inherit (lock.nodes.flake-compat.locked) owner repo rev narHash; 7 | 8 | flake-compat = fetchTarball { 9 | url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; 10 | sha256 = narHash; 11 | }; 12 | 13 | flake = import flake-compat { inherit system; src = ./.; }; 14 | in 15 | flake.defaultNix 16 | 17 | -------------------------------------------------------------------------------- /examples/stack.sg: -------------------------------------------------------------------------------- 1 | (use-macros "milkyway/prelude.sg") 2 | 3 | (def (init C) (+stack 0 [])) 4 | 5 | (stack show exec (process 6 | #(init 0) 7 | 'push 1 then 0 8 | [(-stack 0 X) (+stack 1 [1|X])] 9 | [(-stack 1 X) (+stack 2 [0|X])] 10 | 11 | 'pop & save 12 | [(-stack 2 [C|X]) (+stack 3 X) (+save C)] 13 | 14 | 'conditional duplication 15 | [(-stack 3 [0|X]) (+stack 4 [0 0|X])] 16 | [(-stack 3 [1|X]) (+stack 4 [1 1|X])] 17 | 18 | 'freeze information 19 | [(-save C) (save C)] 20 | 21 | 'clean 22 | [(-stack 4 _)] 23 | )) 24 | -------------------------------------------------------------------------------- /examples/hello.sg: -------------------------------------------------------------------------------- 1 | ''' 2 | Terms 3 | ''' 4 | X ' variable (uppercase) 5 | a ' constant (lowercase & symbols) 6 | $ ' another constant 7 | (f X a) ' function (constant) with terms as arguments 8 | (+f X) ' function with positive polarity 9 | (-f X) ' function with negative polarity 10 | (-f (+f X) Y) ' nested functions 11 | ' Every Stellogen expression have these shapes (directly or indirectly) 12 | 13 | ''' 14 | Term with effect: display terms 15 | ''' 16 | (show hello) 17 | (show hello world !) 18 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | ; Cram tests for Stellogen examples and syntax 2 | 3 | (cram 4 | (deps 5 | (glob_files ./syntax/*.sg) 6 | (glob_files ./errors/*.sg) 7 | (glob_files ../examples/*.sg) 8 | (glob_files ../examples/lambda/*.sg) 9 | (glob_files ../examples/proofnets/*.sg) 10 | (glob_files ../examples/prolog/*.sg) 11 | (glob_files ../examples/states/*.sg) 12 | (glob_files ../examples/milkyway/*.sg) 13 | (glob_files ../exercises/solutions/*.sg) 14 | (package stellogen))) 15 | 16 | (env 17 | (dev 18 | (flags 19 | (:standard -warn-error -A)))) 20 | -------------------------------------------------------------------------------- /examples/lambda/lambda.sg: -------------------------------------------------------------------------------- 1 | ' id id 2 | (def id [(+id (exp [l|X] d)) (+id [r|X])]) 3 | 4 | (def id_arg [(ida (exp [l|X] Y)) (+arg (exp [l r|X] Y))]) 5 | 6 | (def linker { 7 | [(-id X) (-arg X)] 8 | @[(+arg [r|X]) (out X)]}) 9 | 10 | (show (exec #id #id_arg #linker)) 11 | 12 | ' id x 13 | (def var_x [(x (exp X Y)) (+arg (exp [l|X] Y))]) 14 | 15 | (def linker { 16 | [(-id X) (-arg X)] 17 | @[(+arg [r|X]) (out X)]}) 18 | 19 | (show (exec #id #var_x #linker)) 20 | 21 | ' lproj x 22 | (def lproj { 23 | [(+lproj [l|X])] 'weakening 24 | [(lproj (exp [r l|X] d)) (+lproj [r r|X])]}) 25 | 26 | (def linker { 27 | [(-lproj X) (-arg X)] 28 | @[(+arg [r|X]) (out X)]}) 29 | -------------------------------------------------------------------------------- /exercises/02-registers.sg: -------------------------------------------------------------------------------- 1 | (show-exec (process 2 | 'represents a register with value 0 3 | (const (star (+r0 0))) 4 | 5 | 'update the value to 1 6 | #your_answer 7 | #your_answer 8 | 9 | 'duplicate the register into two registers r1 and r2 10 | #your_answer 11 | 12 | 'update r1 to 0 13 | #your_answer 14 | #your_answer 15 | 16 | 'swap the value of r1 and r2 17 | #your_answer 18 | #your_answer 19 | 20 | 'duplicate r1 and add a copy identifier as first argument 21 | #your_answer 22 | 23 | 'update the two copies to 5 at once 24 | #your_answer 25 | #your_answer 26 | 27 | 'duplicate each copy of r1 again with the same method 28 | #your_answer)) 29 | -------------------------------------------------------------------------------- /examples/macro_demo.sg: -------------------------------------------------------------------------------- 1 | ' Define some utility macros 2 | (macro (double X) (add X X)) 3 | (macro (triple X) (add X (double X))) 4 | (macro (deftype Name Body) (def Name Body)) 5 | 6 | ' 1. Macros in definitions 7 | (def two (double 1)) 8 | (def six (triple 2)) 9 | 10 | ' 2. Nested macro calls (triple uses double internally) 11 | (show (triple 5)) 12 | 13 | ' 3. Macros in constellations 14 | (def compute { 15 | [(+calc X) (result (double X))] 16 | [(-calc Y) (output (triple Y))] 17 | }) 18 | 19 | ' 4. Macros expanding to declarations 20 | (deftype mytype { 21 | [(-check 0) ok] 22 | [(-check (s N)) (+check N)] 23 | }) 24 | 25 | ' 5. Multiple levels of nesting 26 | (def nested (exec { 27 | [(+init) (def inner (double 42))] 28 | [(-init) (triple 3)] 29 | })) 30 | -------------------------------------------------------------------------------- /exercises/01-paths.sg: -------------------------------------------------------------------------------- 1 | 'fill the 'your_answer' holes to replace #1 in the constellations 2 | 'below such that the result of execution is { ok } 3 | 4 | (== x1 (const (star ok))) 5 | (def x1 6 | (union (const (@star -1 ok)) #1) 7 | [#1=>#your_answer]) 8 | 9 | (== x2 (const (star ok))) 10 | (def x2 11 | (union (const (@star -1) (star +2)) #1) 12 | [#1=>#your_answer]) 13 | 14 | (== x3 (const (star ok))) 15 | (def x3 16 | (union (const (@star -1 ok) (star -2 +3)) #1) 17 | [#1=>#your_answer]) 18 | 19 | (== x4 (const (star ok))) 20 | (def x4 21 | (union (const (@star (-f (+g X)) ok)) #1) 22 | [#1=>#your_answer]) 23 | 24 | (== x5 (const (star ok))) 25 | (def x5 26 | (union 27 | (const 28 | (star (+f a) (+f b)) 29 | (star (+g a)) 30 | (@star (+g b) ok)) 31 | #1) 32 | [#1=>#your_answer]) 33 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.7) 2 | 3 | (name stellogen) 4 | 5 | (generate_opam_files true) 6 | 7 | (source 8 | (github engboris/stellogen)) 9 | 10 | (authors "Boris Eng") 11 | 12 | (maintainers "Boris Eng") 13 | 14 | (license GPL-3.0-only) 15 | 16 | (documentation https://github.com/engboris/stellogen/blob/main/README.md) 17 | 18 | (package 19 | (name stellogen) 20 | (synopsis "Stellogen is a minimalistic and logic-agnostic programming 21 | language based on term unification.") 22 | (depends base menhir sedlex ppx_deriving js_of_ocaml js_of_ocaml-ppx) 23 | (tags 24 | ("transcendental syntax" "logic programming" "constraint programming" "resolution logic" "unification" "self-assembly"))) 25 | 26 | (using menhir 2.1) 27 | 28 | ; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project 29 | -------------------------------------------------------------------------------- /examples/milkyway/prelude.sg: -------------------------------------------------------------------------------- 1 | ' Stellogen Prelude 2 | ' Common macros for type system and testing 3 | 4 | ' Macro for type specification 5 | (macro (spec X Y) (def X Y)) 6 | 7 | ' Macro for type assertion 8 | (macro (:: Tested Test) 9 | (== @(exec @#Tested #Test) ok)) 10 | 11 | ' Generic folding macros 12 | 13 | (macro (stack A B) 14 | (A B)) 15 | 16 | (macro (stack A B C ...) 17 | (A (stack B C ...))) 18 | 19 | (macro (chain Op A B) 20 | (Op A B)) 21 | 22 | (macro (chain Op A B C ...) 23 | (chain Op (Op A B) C ...)) 24 | 25 | ' Process as sequential execution with state threading 26 | ' Expressed as left-associative chaining of process-step 27 | (macro (process-step Acc Next) 28 | @(exec Next @Acc)) 29 | 30 | (macro (process A B) 31 | (process-step A B)) 32 | 33 | (macro (process A B C ...) 34 | (chain process-step A B C ...)) 35 | -------------------------------------------------------------------------------- /test/syntax/prolog.sg: -------------------------------------------------------------------------------- 1 | (macro (stack A B) (A B)) 2 | (macro (stack A B C ...) (A (stack B C ...))) 3 | 4 | (def add { 5 | [(+add 0 Y Y)] 6 | [(-add X Y Z) (+add (s X) Y (s Z))]}) 7 | 8 | (def tested (exec { #add @[(-add 0 0 R) R] })) 9 | (== #tested 0) 10 | 11 | (def tested (exec { #add @[(-add (s 0) 0 R) R] })) 12 | (== #tested (s 0)) 13 | 14 | (def tested (exec { #add @[(-add 0 (s 0) R) R] })) 15 | (== #tested (s 0)) 16 | 17 | (def tested (exec { #add @[(-add (stack s s 0) (stack s s 0) R) R] })) 18 | (== #tested (stack s s s s 0)) 19 | 20 | (def tested (exec { #add @[(-add (stack s s 0) R (stack s s 0)) R] })) 21 | (== #tested 0) 22 | 23 | (def tested (exec { #add @[(-add (stack s s 0) R (stack s s s 0)) R] })) 24 | (== #tested (stack s 0)) 25 | 26 | (def tested (exec { #add @[(-add (stack s s 0) R (stack s s s s 0)) R] })) 27 | (== #tested (stack s s 0)) 28 | -------------------------------------------------------------------------------- /exercises/00-unification.sg: -------------------------------------------------------------------------------- 1 | 'fill the #your_answer holes with the correct result of execution 2 | 3 | (== x1 #your_answer) 4 | (def x1 5 | (const 6 | (@star (+f X) X) 7 | (star (-f a)))) 8 | 9 | (== x2 #your_answer) 10 | (def x2 11 | (const 12 | (@star (+f X)) 13 | (star (-f Y) a))) 14 | 15 | (== x3 #your_answer) 16 | (def x3 17 | (const 18 | (@star (+f X) X) 19 | (star (-f a)) 20 | (star (-f b)))) 21 | 22 | (== x4 #your_answer) 23 | (def x4 24 | (const 25 | (@star +1 -2) 26 | (star -2 +3))) 27 | 28 | (== x5 #your_answer) 29 | (def x5 30 | (const 31 | (@star -1 +2) 32 | (star -2 +1))) 33 | 34 | (== x6 #your_answer) 35 | (def x6 36 | (const 37 | (@star -1 +2) 38 | (star -2 +1))) 39 | 40 | (== x7 #your_answer) 41 | (def x7 42 | (const 43 | (@star (-f X) X) 44 | (star (+f (+g a))) 45 | (star (-g X) X))) 46 | -------------------------------------------------------------------------------- /examples/lambda/linear_lambda.sg: -------------------------------------------------------------------------------- 1 | (use-macros "../milkyway/prelude.sg") 2 | 3 | ' identity function (\x -> x) 4 | (def id [(+id [l|X]) (+id [r|X])]) 5 | 6 | ' id id 7 | (def id_arg [(ida [l|X]) (+arg [l r|X])]) 8 | 9 | (def linker [ 10 | [(-id X) (-arg X)] 11 | @[(+arg [r|X]) (out X)]]) 12 | 13 | (show (exec #id #id_arg #linker)) 14 | 15 | ' id x 16 | (def x_arg [(x X) (+arg [l X])]) 17 | 18 | (def linker [ 19 | [(-id X) (-arg X)] 20 | @[(+arg [r|X]) (out X)]]) 21 | 22 | (show (exec #id #x_arg #linker)) 23 | 24 | ' linear types 25 | (spec (larrow a a) { 26 | [+test1 [ 27 | [(-x X) (+parxy X)] 28 | [(-y X)] 29 | @[(-parxy X) ok]]] 30 | [+test2 [ 31 | [(-x X)] 32 | [(-y X) (+parxy X)] 33 | @[(-parxy X) ok]]]}) 34 | 35 | (def adapter { 36 | [(-id [l|X]) (+x X)] 37 | [(-id [r|X]) (+y X)]}) 38 | 39 | (def vehicle { #id #adapter }) 40 | 'TODO (:: vehicle (larrow a a)) 41 | -------------------------------------------------------------------------------- /exercises/solutions/01-paths.sg: -------------------------------------------------------------------------------- 1 | 'fill the 'your_answer' holes to replace #1 in the constellations 2 | 'below such that the result of execution is { ok } 3 | 4 | (== x1 (const (star ok))) 5 | (def x1 6 | (union (const (@star -1 ok)) #1) 7 | [#1=>(const (star +1))]) 8 | 9 | (== x2 (const (star ok))) 10 | (def x2 11 | (union (const (@star -1) (star +2)) #1) 12 | [#1=>(const (star +1 -2 ok))]) 13 | 14 | (== x3 (const (star ok))) 15 | (def x3 16 | (union (const (@star -1 ok) (star -2 +3)) #1) 17 | [#1=>(const (star +1 +2) (star -3))]) 18 | 19 | (== x4 (const (star ok))) 20 | (def x4 21 | (union (const (@star (-f (+g X)) ok)) #1) 22 | [#1=>(const (star (+f (-g X))))]) 23 | 24 | (== x5 (const (star ok))) 25 | (def x5 26 | (union 27 | (const 28 | (star (+f a) (+f b)) 29 | (star (+g a)) 30 | (@star (+g b) ok)) 31 | #1) 32 | [#1=>(const (star (-f a)) (star (-f b) (-g a) (-g b)))]) 33 | -------------------------------------------------------------------------------- /exercises/solutions/00-unification.sg: -------------------------------------------------------------------------------- 1 | 'fill the #your_answer holes with the correct result of execution 2 | 3 | (== x1 (const (star a))) 4 | (def x1 5 | (const 6 | (@star (+f X) X) 7 | (star (-f a)))) 8 | 9 | (== x2 (const (star a))) 10 | (def x2 11 | (const 12 | (@star (+f X)) 13 | (star (-f Y) a))) 14 | 15 | (== x3 (const (star b) (star a))) 16 | (def x3 17 | (const 18 | (@star (+f X) X) 19 | (star (-f a)) 20 | (star (-f b)))) 21 | 22 | (== x4 (const (star +1 -2))) 23 | (def x4 24 | (const 25 | (@star +1 -2) 26 | (star -2 +3))) 27 | 28 | (== x5 (const (star -2 +1))) 29 | (def x5 30 | (const 31 | (@star -1 +2) 32 | (star -2 +1))) 33 | 34 | (== x6 (const (star -2 +1))) 35 | (def x6 36 | (const 37 | (@star -1 +2) 38 | (star -2 +1))) 39 | 40 | (== x7 (const (star a))) 41 | (def x7 42 | (const 43 | (@star (-f X) X) 44 | (star (+f (+g a))) 45 | (star (-g X) X))) 46 | -------------------------------------------------------------------------------- /examples/states/nfa.sg: -------------------------------------------------------------------------------- 1 | (use-macros "../milkyway/prelude.sg") 2 | 3 | (spec binary { 4 | [(-i []) ok] 5 | [(-i [0|X]) (+i X)] 6 | [(-i [1|X]) (+i X)]}) 7 | 8 | 'input words 9 | (def e (+i [])) (:: e binary) 10 | (def 0 (+i [0])) (:: 0 binary) 11 | (def 000 (+i [0 0 0])) (:: 000 binary) 12 | (def 010 (+i [0 1 0])) (:: 010 binary) 13 | (def 110 (+i [1 1 0])) (:: 110 binary) 14 | 15 | (def (initial Q) [(-i W) (+a W Q)]) 16 | (def (accept Q) [(-a [] Q) accept]) 17 | (def (if read C1 on Q1 then Q2) [(-a [C1|W] Q1) (+a W Q2)]) 18 | 19 | ''' 20 | automaton accepting words ending with 00 21 | ''' 22 | (def a1 { 23 | #(initial q0) 24 | #(accept q2) 25 | #(if read 0 on q0 then q0) 26 | #(if read 0 on q0 then q1) 27 | #(if read 1 on q0 then q0) 28 | #(if read 0 on q1 then q2)}) 29 | 30 | (def kill (-a _ _)) 31 | 32 | (show (process (exec @#e #a1) #kill)) 33 | (show (process (exec @#000 #a1) #kill)) 34 | (show (process (exec @#010 #a1) #kill)) 35 | (show (process (exec @#110 #a1) #kill)) 36 | -------------------------------------------------------------------------------- /exercises/solutions/02-registers.sg: -------------------------------------------------------------------------------- 1 | (show-exec (process 2 | 'represents a register with value 0 3 | (const (star (+r0 0))) 4 | 5 | 'update the value to 1 6 | (const (star (-r0 X) (+tmp0 X))) 7 | (const (star (-tmp0 X) (+r0 1))) 8 | 9 | 'duplicate the register into two registers r1 and r2 10 | (const 11 | (star (-r0 X) (+r1 X)) 12 | (star (-r0 X) (+r2 X))) 13 | 14 | 'update r1 to 0 15 | (const (star (-r1 X) (+tmp0 X))) 16 | (const (star (-tmp0 X) (+r1 0))) 17 | 18 | 'swap the value of r1 and r2 19 | (const (star (-r1 X) (+s1 X))) 20 | (const (star (-r2 X) (+s2 X))) 21 | (const (star (-s1 X) (+r2 X))) 22 | (const (star (-s2 X) (+r1 X))) 23 | 24 | 'duplicate r1 and add a copy identifier as first argument 25 | (const (star (-r1 X) (+r1 l X))) 26 | (const (star (-r1 X) (+r1 r X))) 27 | 28 | 'update the two copies to 5 at once 29 | (const (star (-r1 A X) (+tmp0 A X))) 30 | (const (star (-tmp0 A X) (+r1 A 5))) 31 | 32 | 'duplicate each copy of r1 again with the same method 33 | (const (star (-r1 A X) (+r1 l A X))) 34 | (const (star (-r1 A X) (+r1 r A X))))) 35 | -------------------------------------------------------------------------------- /stellogen.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: """ 4 | Stellogen is a minimalistic and logic-agnostic programming 5 | language based on term unification.""" 6 | maintainer: ["Boris Eng"] 7 | authors: ["Boris Eng"] 8 | license: "GPL-3.0-only" 9 | tags: [ 10 | "transcendental syntax" 11 | "logic programming" 12 | "constraint programming" 13 | "resolution logic" 14 | "unification" 15 | "self-assembly" 16 | ] 17 | homepage: "https://github.com/engboris/stellogen" 18 | doc: "https://github.com/engboris/stellogen/blob/main/README.md" 19 | bug-reports: "https://github.com/engboris/stellogen/issues" 20 | depends: [ 21 | "dune" {>= "3.7"} 22 | "base" 23 | "menhir" 24 | "sedlex" 25 | "ppx_deriving" 26 | "js_of_ocaml" 27 | "js_of_ocaml-ppx" 28 | "odoc" {with-doc} 29 | ] 30 | build: [ 31 | ["dune" "subst"] {dev} 32 | [ 33 | "dune" 34 | "build" 35 | "-p" 36 | name 37 | "-j" 38 | jobs 39 | "@install" 40 | "@runtest" {with-test} 41 | "@doc" {with-doc} 42 | ] 43 | ] 44 | dev-repo: "git+https://github.com/engboris/stellogen.git" 45 | -------------------------------------------------------------------------------- /examples/states/npda.sg: -------------------------------------------------------------------------------- 1 | (use-macros "../milkyway/prelude.sg") 2 | 3 | (spec binary { 4 | [(-i []) ok] 5 | [(-i [0|X]) (+i X)] 6 | [(-i [1|X]) (+i X)]}) 7 | 8 | 'input words 9 | (def e (+i [])) (:: e binary) 10 | (def 0000 (+i [0 0 0 0])) (:: 0000 binary) 11 | (def 0110 (+i [0 1 1 0])) (:: 0110 binary) 12 | (def 1110 (+i [1 1 1 0])) (:: 1110 binary) 13 | 14 | (def (initial Q) [(-i W) (+a W [] Q)]) 15 | (def (accept Q) [(-a [] [] Q) accept]) 16 | (def (if read C1 on Q1 then Q2 and push C2) [(-a [C1|W] S Q1) (+a W [C2|S] Q2)]) 17 | (def (if read C1 with C2 on Q1 then Q2) [(-a [C1|W] [C2|S] Q1) (+a W S Q2)]) 18 | (def (if on Q1 then Q2) [(-a W S Q1) (+a W S Q2)]) 19 | 20 | (def a1 { 21 | #(initial q0) 22 | #(accept q0) 23 | #(accept q1) 24 | #(if read 0 on q0 then q0 and push 0) 25 | #(if read 1 on q0 then q0 and push 1) 26 | #(if on q0 then q1) 27 | #(if read 0 with 0 on q1 then q1) 28 | #(if read 1 with 1 on q1 then q1)}) 29 | 30 | (def kill (-a _ _ _)) 31 | 32 | (show (process (exec @#e #a1) #kill)) 33 | (show (process (exec @#0000 #a1) #kill)) 34 | (show (process (exec @#0110 #a1) #kill)) 35 | (show (process (exec @#1110 #a1) #kill)) 36 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.28.1 2 | assignment-operator=end-line 3 | break-cases=fit 4 | break-fun-decl=wrap 5 | break-fun-sig=wrap 6 | break-infix=wrap 7 | break-infix-before-func=false 8 | break-separators=before 9 | break-sequences=true 10 | cases-exp-indent=2 11 | cases-matching-exp-indent=normal 12 | doc-comments=before 13 | doc-comments-padding=2 14 | doc-comments-tag-only=default 15 | dock-collection-brackets=false 16 | exp-grouping=preserve 17 | field-space=loose 18 | if-then-else=compact 19 | indicate-multiline-delimiters=space 20 | indicate-nested-or-patterns=unsafe-no 21 | infix-precedence=indent 22 | leading-nested-match-parens=false 23 | let-and=sparse 24 | let-binding-spacing=compact 25 | let-module=compact 26 | margin=80 27 | max-indent=2 28 | module-item-spacing=sparse 29 | ocaml-version=4.14.0 30 | ocp-indent-compat=false 31 | parens-ite=false 32 | parens-tuple=always 33 | parse-docstrings=true 34 | sequence-blank-line=preserve-one 35 | sequence-style=terminator 36 | single-case=compact 37 | space-around-arrays=true 38 | space-around-lists=true 39 | space-around-records=true 40 | space-around-variants=true 41 | type-decl=sparse 42 | wrap-comments=false 43 | wrap-fun-args=true 44 | -------------------------------------------------------------------------------- /web/build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # Build script for Stellogen Web Playground 3 | 4 | set -e 5 | 6 | echo "Building Stellogen Web Playground..." 7 | echo 8 | 9 | # Generate examples from source files 10 | echo "Step 1: Generating examples from .sg files..." 11 | node web/build-examples.js 12 | 13 | # Build the JavaScript 14 | echo "Step 2: Compiling OCaml to JavaScript..." 15 | dune build web/playground.bc.js 16 | 17 | # Create deploy directory 18 | echo "Step 3: Creating deployment directory..." 19 | mkdir -p web_deploy 20 | 21 | # Copy files 22 | echo "Step 4: Copying files..." 23 | cp _build/default/web/playground.bc.js web_deploy/playground.js 24 | cp web/index.html web_deploy/ 25 | cp web/examples.js web_deploy/ 26 | 27 | # Get file size 28 | JS_SIZE=$(du -h web_deploy/playground.js | cut -f1) 29 | 30 | echo 31 | echo "✅ Build complete!" 32 | echo 33 | echo "Generated files:" 34 | echo " - web_deploy/playground.js ($JS_SIZE)" 35 | echo " - web_deploy/index.html" 36 | echo " - web_deploy/examples.js (auto-generated from examples/*.sg)" 37 | echo 38 | echo "To test locally:" 39 | echo " cd web_deploy && python3 -m http.server 8000" 40 | echo " Then open http://localhost:8000" 41 | echo 42 | -------------------------------------------------------------------------------- /examples/prolog/family.sg: -------------------------------------------------------------------------------- 1 | ''' 2 | Note: Stellogen is NOT clause-based so it does not work like 3 | Datalog or Prolog although it can reproduce some programs 4 | (for instance, programs with single recursive argument or 5 | multiple non-recursive arguments). 6 | 7 | Having mechanisms to simulate the behavior of Prolog are needed. 8 | ''' 9 | 10 | ''' 11 | FAMILY RELATIONSHIPS 12 | ''' 13 | 14 | (def family { 15 | [(+parent tom of bob)] 16 | [(+parent tom of liz)] 17 | [(+parent bob of ann)] 18 | [(+parent bob of pat)] 19 | [(+parent pat of jim)]}) 20 | 21 | ' grandparent relationship 22 | (def grandparent { 23 | [(+grandparent X of Z) (-parent X of Y) (+parent Y of Z)]}) 24 | 25 | (def knowledge { #family #grandparent }) 26 | 27 | ' who are ann's parents? 28 | (show (exec #family @[(-parent P of ann) P])) 29 | ' Note: using #knowledge instead of #family would create a clash 30 | ' with the +parent argument of #grandparent 31 | 32 | ' who are bob's children? 33 | (show (exec #family @[(-parent bob of C) C])) 34 | 35 | ' who is tom's grandchild? 36 | ' (show (exec #knowledge @[(-grandparent tom of Z) Z])) 37 | ' Does not work because subgoal can mistakenly interact with 38 | ' arguments of #grandparent 39 | -------------------------------------------------------------------------------- /examples/circuits.sg: -------------------------------------------------------------------------------- 1 | ' FIXME 2 | 3 | (def bool_semantics { 4 | [(+1 1)] 5 | [(+0 0)] 6 | [(+s X X X)] 7 | [(+not 1 0)] [(+not 0 1)] 8 | [(+and 0 0 0)] [(+and 0 1 0)] [(+and 1 0 0)] [(+and 1 1 1)] 9 | }) 10 | 11 | ''' 12 | (def c1 { 13 | ' sharing 14 | [ (-c0 X) 15 | (-s X Y Z) 16 | ' / \ 17 | (+c1 Y) (+c2 Z) || (! X)] 18 | ' | | 19 | ' | | 20 | ' not | 21 | [(-c1 X) ' | 22 | (-not X R) ' | 23 | (+c3 R) || (! X)] 24 | ' | | 25 | ' | | 26 | ' and | 27 | [(-c3 X) (-c2 Y) 28 | ' \ / 29 | (-and X Y R) 30 | (+c4 R) || (! X) (! Y)] 31 | ' | 32 | ' | 33 | ' output 34 | [(-c4 R) R] 35 | }) 36 | 37 | (show (exec @(+c0 1) #c1 #bool_semantics)) 38 | ''' 39 | 40 | ''' 41 | (def c2 { 42 | 'inputs 43 | { 44 | [(-0 X) (+c0 X)] 45 | [(-0 X) (+c1 X)]} 46 | 'layer 1 47 | { 48 | [(-c0 X) (-not X R) (+c2 R)] 49 | [(-c1 X) (-not X R) (+c3 R)]} 50 | 'layer 2 51 | {(-c2 X) (-c3 Y) (-and X Y R) (+c4 R)} 52 | 'output 53 | [(-c4 R) R] 54 | 'apply semantics 55 | #semantics 56 | }) 57 | ''' 58 | -------------------------------------------------------------------------------- /test/README.md: -------------------------------------------------------------------------------- 1 | # Stellogen Tests 2 | 3 | This directory contains Cram tests for Stellogen. 4 | 5 | ## Test Files 6 | 7 | - `syntax.t` - Tests for basic syntax in `test/syntax/` 8 | - `examples.t` - Tests for all examples in `examples/` 9 | 10 | ## Running Tests 11 | 12 | Run all tests: 13 | ```bash 14 | dune test 15 | ``` 16 | 17 | Run tests and update expected outputs: 18 | ```bash 19 | dune test --auto-promote 20 | ``` 21 | 22 | Run specific test file: 23 | ```bash 24 | dune test test/examples.t 25 | ``` 26 | 27 | ## About Cram Tests 28 | 29 | Cram tests are simple text-based tests that show shell commands and their expected outputs: 30 | 31 | ``` 32 | $ command 33 | expected output 34 | ``` 35 | 36 | When a test runs successfully without any expected output specified, it just verifies the command exits successfully (exit code 0). 37 | 38 | ## Adding New Tests 39 | 40 | To add a new test: 41 | 42 | 1. Create a `.t` file in this directory 43 | 2. Write commands starting with ` $ ` (two spaces, dollar sign, space) 44 | 3. Run `dune test --auto-promote` to capture the output 45 | 4. Review the promoted output and commit 46 | 47 | ## Modifying Test Dependencies 48 | 49 | Test dependencies are declared in `test/dune`. If you add new test fixtures, add them to the `deps` section. 50 | -------------------------------------------------------------------------------- /examples/binary4.sg: -------------------------------------------------------------------------------- 1 | (use-macros "milkyway/prelude.sg") 2 | (macro (:: Tested Test) 3 | (== (process #Test #Tested) ok)) 4 | 5 | (spec u4 [(-b _ 1 _) (-b _ 2 _) (-b _ 3 _) (-b _ 4 _) ok]) 6 | 7 | (def (make_bin Name X1 X2 X3 X4) 8 | { [(+b Name 1 X1)] [(+b Name 2 X2)] [(+b Name 3 X3)] [(+b Name 4 X4)] }) 9 | 10 | (def b1 #(make_bin b1 0 0 0 1)) (:: b1 u4) 11 | (def b2 #(make_bin b2 0 0 1 1)) (:: b2 u4) 12 | 13 | (show #b1) 14 | (show #b2) 15 | 16 | (def (if A = X then R = Z) [(-b A I X) (+b R I Z)]) 17 | (def (if A = X and B = Y then R = Z) [(-b A I X) (-b B I Y) (+b R I Z)]) 18 | 19 | (def (and A B R) { 20 | #(if A = 0 and B = _ then R = 0) 21 | #(if A = 1 and B = X then R = X) }) 22 | (def rand (process #b1 #(and b1 b2 r) #b2)) 23 | (show #rand) 24 | (== #rand #(make_bin r 0 0 0 1)) 25 | 26 | (def (or A B R) { 27 | #(if A = 0 and B = X then R = X) 28 | #(if A = 1 and B = Y then R = 1) }) 29 | (def ror (process #b1 #(or b1 b2 r) #b2)) 30 | (show #ror) 31 | (== #ror #(make_bin r 0 0 1 1)) 32 | 33 | (def (not A R) { 34 | #(if A = 1 then R = 0) 35 | #(if A = 0 then R = 1) }) 36 | (def rnot (process #b1 #(not b1 r))) 37 | (show #rnot) 38 | (== #rnot #(make_bin r 1 1 1 0)) 39 | 40 | (def rnand (process #b1 #(and b1 b2 r1) #b2 #(not r1 r2))) 41 | (show #rnand) 42 | 43 | ''' 44 | (def rxor (process #rnand #(and r2 r r3) #ror)) 45 | (show #rxor) 46 | ''' 47 | -------------------------------------------------------------------------------- /src/sgen_ast.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lsc_ast 3 | open Expr_err 4 | 5 | type ident = StellarRays.term 6 | 7 | type idvar = string * int option 8 | 9 | type idfunc = polarity * string 10 | 11 | type source_location = 12 | { filename : string 13 | ; line : int 14 | ; column : int 15 | } 16 | 17 | type sgen_expr = 18 | | Raw of StellarRays.term 19 | | Call of ident 20 | | Exec of bool * sgen_expr * source_location option 21 | | Group of sgen_expr list (* Internal: for combining multiple expressions *) 22 | | Focus of sgen_expr 23 | | Def of ident * sgen_expr 24 | | Show of sgen_expr list * source_location option 25 | | Expect of sgen_expr * sgen_expr * ident * source_location option 26 | | Match of sgen_expr * sgen_expr * ident * source_location option 27 | | Use of ident 28 | 29 | type err = 30 | | ExpectError of 31 | { got : Marked.constellation 32 | ; expected : Marked.constellation 33 | ; message : ident 34 | ; location : source_location option 35 | } 36 | | MatchError of 37 | { term1 : Marked.constellation 38 | ; term2 : Marked.constellation 39 | ; message : ident 40 | ; location : source_location option 41 | } 42 | | UnknownID of string * source_location option 43 | | ExprError of expr_err * source_location option 44 | 45 | type env = { objs : (ident * sgen_expr) list } 46 | 47 | let initial_env = { objs = [] } 48 | 49 | type program = sgen_expr list 50 | -------------------------------------------------------------------------------- /examples/prolog/arithmetic.sg: -------------------------------------------------------------------------------- 1 | (use-macros "../milkyway/prelude.sg") 2 | ''' 3 | Note: Stellogen is NOT clause-based so it does not work like 4 | Datalog or Prolog although it can reproduce some programs 5 | (for instance, programs with single recursive argument or 6 | multiple non-recursive arguments). 7 | 8 | Having mechanisms to simulate the behavior of Prolog are needed. 9 | ''' 10 | 11 | ''' 12 | ARITHMETIC FUNCTIONS 13 | ''' 14 | 15 | (def add { 16 | [(+add 0 Y Y)] 17 | [(-add X Y Z) (+add (s X) Y (s Z))]}) 18 | (def sub { 19 | [(+sub Y 0 Y)] 20 | [(-sub X Y Z) (+sub (s X) (s Y) Z)]}) 21 | (def knowledge { #add #sub }) 22 | 23 | ''' 24 | UNARY ADDITION 25 | ''' 26 | 27 | (def (add_query X Y R) 28 | [(-add X Y R) (result of X + Y = R)]) 29 | 30 | ' Query: 0 + 0 = ? 31 | (show (exec #knowledge @#(add_query 0 0 R))) 32 | 33 | ' Query: 0 + 4 = ? 34 | (show (exec #knowledge @#(add_query 0 (stack s s s s 0) R))) 35 | 36 | ' Query: 2 + 2 = ? 37 | (show (exec #knowledge @#(add_query (stack s s 0) (stack s s 0) R))) 38 | 39 | ' Query: 2 + ? = 4 40 | (show (exec #knowledge @#(add_query (stack s s 0) R (stack s s s s 0)))) 41 | 42 | ''' 43 | UNARY SUBSTRACTION 44 | ''' 45 | 46 | (def (sub_query X Y R) 47 | [(-sub X Y R) (result of X - Y = R)]) 48 | 49 | ' Query: 0 - 0 = ? 50 | (show (exec #knowledge @#(sub_query 0 0 R))) 51 | 52 | ' Query: 4 - 2 = ? 53 | (show (exec #knowledge @#(sub_query (stack s s s s 0) (stack s s 0) R))) 54 | 55 | ' Query: ? - 2 = 2 56 | (show (exec #knowledge @#(sub_query R (stack s s 0) (stack s s 0)))) 57 | -------------------------------------------------------------------------------- /src/parser.mly: -------------------------------------------------------------------------------- 1 | %{ 2 | open Expr.Raw 3 | %} 4 | 5 | %token VAR 6 | %token SYM 7 | %token STRING 8 | %token AT 9 | %token BAR 10 | %token LPAR RPAR 11 | %token LBRACK RBRACK 12 | %token LBRACE RBRACE 13 | %token SHARP 14 | %token EOF 15 | 16 | %start expr_file 17 | 18 | %% 19 | 20 | let delimited_opt(l, x, r) := 21 | | ~=x; <> 22 | | ~=delimited(l, x, r); <> 23 | 24 | let revlist(x) := 25 | | { [] } 26 | | t=revlist(x); h=x; { h::t } 27 | 28 | let pars(x) == ~=delimited(LPAR, x, RPAR); <> 29 | let bracks(x) == ~=delimited(LBRACK, x, RBRACK); <> 30 | let braces(x) == ~=delimited(LBRACE, x, RBRACE); <> 31 | 32 | let expr_file := 33 | | EOF; { [] } 34 | | es=positioned_expr+; EOF; { es } 35 | 36 | let positioned_expr := 37 | | e=expr; { 38 | let pos_start = { $startpos with Lexing.pos_fname = !(Parser_context.current_filename) } in 39 | let pos_end = { $endpos with Lexing.pos_fname = !(Parser_context.current_filename) } in 40 | Positioned (e, pos_start, pos_end) 41 | } 42 | 43 | let params := 44 | | BAR; BAR; ~=expr+; <> 45 | 46 | let expr := 47 | | ~=pars(expr+); 48 | | ~=bracks(revlist(expr)); 49 | | ~=braces(revlist(expr)); 50 | | LBRACK; ~=revlist(expr); ~=params; RBRACK; 51 | | LBRACK; ~=revlist(expr); BAR; ~=expr; RBRACK; 52 | | SHARP; ~=expr; 53 | | AT; ~=expr; 54 | | ~=SYM; 55 | | ~=VAR; 56 | | ~=STRING; 57 | -------------------------------------------------------------------------------- /nvim/syntax/stellogen.vim: -------------------------------------------------------------------------------- 1 | if exists("b:current_syntax") 2 | finish 3 | endif 4 | 5 | " Comments (must be early to take precedence) 6 | syn region sgCommentMulti start="'''" end="'''" contains=NONE 7 | syn match sgComment "'[^'].*$" 8 | 9 | " Strings 10 | syn region sgString start=/\v"/ skip=/\v\\./ end=/\v"/ 11 | 12 | " Keywords 13 | syn keyword sgKeyword def macro macros eval slice show use use-macros exec fire process spec stack chain process-step 14 | syn keyword sgConstant ok 15 | 16 | " Operators and separators 17 | syn match sgOperator "::" 18 | syn match sgOperator "==" 19 | syn match sgOperator "\~=" 20 | syn match sgOperator "!=" 21 | syn match sgOperator "||" 22 | syn match sgOperator "@" 23 | syn match sgOperator "\.\.\." 24 | syn match sgSeparator "[\{\}\[\]|]" 25 | 26 | " Polarity markers (+ or - before identifiers) 27 | syn match sgPolarity "[+-]\ze\w" 28 | 29 | " Variables (uppercase starting identifiers) 30 | syn match sgVariable "\<[A-Z_]\w*\>" 31 | 32 | " Defined identifiers in (def X ...) - both simple and complex 33 | syn match sgDefinedId "\((def\s\+\)\@<=[a-z_][a-z0-9_]*" 34 | syn match sgDefinedId "\((def\s\+\)\@<=\d\+" 35 | syn match sgDefinedId "\((def\s*(\)\@<=[^)]\+" 36 | 37 | " Identifier references (prefixed with #) 38 | syn match sgIdRef "#[a-z_][a-z0-9_]*" 39 | syn match sgIdRef "#\d\+" 40 | syn match sgIdRef "#([^)]\+)" 41 | 42 | hi link sgKeyword Keyword 43 | hi link sgConstant Constant 44 | hi link sgComment Comment 45 | hi link sgCommentMulti Comment 46 | hi link sgOperator Operator 47 | hi link sgSeparator Delimiter 48 | hi link sgString String 49 | hi link sgPolarity Special 50 | hi link sgVariable Type 51 | hi link sgIdRef Identifier 52 | hi link sgDefinedId Function 53 | 54 | let b:current_syntax = "stellogen" 55 | -------------------------------------------------------------------------------- /examples/states/turing.sg: -------------------------------------------------------------------------------- 1 | (def (initial Q) { 2 | [(-i [C|W]) (+m Q [e e] C W)] 3 | [(-i []) (+m Q e e e)] 4 | }) 5 | 6 | (def (accept Q) [(-m qa L e R) accept]) 7 | (def (reject Q) [(-m qr L C R) reject]) 8 | 9 | (def (if Q1 then Q2) [(-m Q1 L e R) (+m Q2 L e R)]) 10 | (def (skip right on Q , D) [(-m Q L D [C|R]) (+m Q [D|L] C R)]) 11 | 12 | (def (if C1 on Q1 then Q2 , write C2 , right) 13 | [(-m Q1 L C1 [C|R]) (+m Q2 [C2|L] C R)]) 14 | 15 | (def (if C1 on Q1 then Q2 , write C2 , left) 16 | [(-m Q1 [C|L] C1 R) (+m Q2 L C [C2|R])]) 17 | 18 | ' Turing machine accepting words with as many 'a' as 'b' 19 | (def mt { 20 | #(initial q0) 21 | ' accept 22 | #(accept qa) 23 | #(if q0 then qa) 24 | ' reject 25 | #(reject qr) 26 | #(if q2 then qr) 27 | #(if q3 then qr) 28 | ' initial skip 29 | #(skip right on q0 , sep) 30 | 'mark 31 | #(if a on q0 then q2 , write sep , right) 32 | #(if b on q0 then q3 , write sep , right) 33 | 'skip 34 | #(skip right on q2 , a) 35 | #(skip right on q2 , sep) 36 | #(skip right on q3 , b) 37 | #(skip right on q3 , sep) 38 | 'join 39 | #(if b on q2 then q1 , write sep , left) 40 | #(if a on q3 then q1 , write sep , left) 41 | 'return 42 | #(if a on q1 then q1 , write a , left) 43 | #(if b on q1 then q1 , write b , left) 44 | #(if sep on q1 then q1 , write sep , left) 45 | #(if e on q1 then q0 , write e , right) 46 | }) 47 | 48 | (def (word W) (+i W)) 49 | 50 | (show (exec @#(word [a e]) #mt)) 51 | (show (exec @#(word [b e]) #mt)) 52 | (show (exec @#(word [a b b e]) #mt)) 53 | 54 | (show (exec @#(word [e]) #mt)) 55 | (show (exec @#(word [a b e]) #mt)) 56 | (show (exec @#(word [a a b b e]) #mt)) 57 | (show (exec @#(word [a b b a e]) #mt)) 58 | (show (exec @#(word [a b a b e]) #mt)) 59 | -------------------------------------------------------------------------------- /examples/proofnets/fomll.sg: -------------------------------------------------------------------------------- 1 | (use-macros "../milkyway/prelude.sg") 2 | 3 | ''' ======================================================== ''' 4 | ''' FIRST-ORDER MULTIPLICATIVE LINEAR LOGIC PROOF-STRUCTURES ''' 5 | ''' ======================================================== ''' 6 | ' FOMLL proof-structures are MLL proof-structures 7 | ' (cf. examples/proofnets/mll.sg) which contain only cut and axiom 8 | ' constructors. 9 | ' 10 | ' An axiom between vertices x and y becomes the binary postive star 11 | [+x +y] 12 | ' 13 | ' A cut between vertices y and z becomes the binary negative star 14 | ' which will link two axioms 15 | [-y -z] 16 | 17 | ''' ======================================================== ''' 18 | ''' FOR EXAMPLE ''' 19 | ''' ======================================================== ''' 20 | ' MLL proof-structures with only cuts and axioms yield partitions 21 | ' corresponding to axiom links with links between natural numbers. 22 | ' 23 | ' ax ax ax 24 | ' __ __ __ 25 | ' / \ / \ / \ 26 | ' 1 2 3 4 5 6 27 | ' \ \____/__/ 28 | ' \ cut/ 29 | ' \____/ 30 | ' cut 31 | ' 32 | ' becomes 33 | ' 34 | ' [1, 2] [3, 4] [5, 6] 35 | ' \ \______/____/ 36 | ' \________/ 37 | ' 38 | ' corresponding to the constellation 39 | (def x { 40 | [+1 +2] [+3 +4] [+5 +6] 41 | [-1 -4] [-2 -5] 42 | }) 43 | ' which evaluates into 44 | ' 45 | ' [1, 6] [3, 4] 46 | ' \ / 47 | ' \________/ 48 | ' 49 | ' then 50 | ' 51 | ' [3, 6] 52 | ' 53 | ' This corresponds to the following execution in stellogen 54 | ' in which [-3 +3] is a way to initiate a starting point in computation 55 | (def comp (exec #x @[-3 +3])) 56 | (def res { [+3 +6] }) 57 | (== #comp #res) 58 | 59 | 60 | ''' ======================================================== ''' 61 | ''' SUCCESSFUL TYPING ''' 62 | ''' ======================================================== ''' 63 | ' Typing works exactly the same as in examples/proofnets/mll.sg 64 | ' with the same specifications (providing you have the right adapters) 65 | ' except that the proof of identity (A ⊗ B) -o (A ⊗ B) is 66 | (def proof? { [+1 +3] [+2 +4]}) 67 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "stellogen"; 3 | 4 | inputs = { 5 | # Remark: when adding inputs here, don't forget to also add them in the 6 | # arguments to `outputs` below! 7 | flake-utils.url = "github:numtide/flake-utils"; 8 | nixpkgs.url = "nixpkgs/nixos-unstable"; 9 | }; 10 | 11 | # Remark: keep the list of outputs in sync with the list of inputs above 12 | # (see above remark) 13 | outputs = { self, flake-utils, nixpkgs}: 14 | flake-utils.lib.eachDefaultSystem (system: 15 | let 16 | pkgs = import nixpkgs { inherit system; }; 17 | ocamlPackages = pkgs.ocamlPackages; 18 | easy_logging = ocamlPackages.buildDunePackage rec { 19 | pname = "easy_logging"; 20 | version = "0.8.2"; 21 | src = pkgs.fetchFromGitHub { 22 | owner = "sapristi"; 23 | repo = "easy_logging"; 24 | rev = "v${version}"; 25 | sha256 = "sha256-Xy6Rfef7r2K8DTok7AYa/9m3ZEV07LlUeMQSRayLBco="; 26 | }; 27 | buildInputs = [ ocamlPackages.calendar ]; 28 | }; 29 | 30 | stellogen = ocamlPackages.buildDunePackage { 31 | pname = "stellogen"; 32 | version = "0.1.0"; 33 | duneVersion = "3"; 34 | src = ./.; 35 | OCAMLPARAM = "_,warn-error=+A"; # Turn all warnings into errors. 36 | propagatedBuildInputs = [ 37 | easy_logging 38 | ] ++ (with ocamlPackages; [ 39 | calendar 40 | alcotest 41 | base 42 | menhir 43 | ]); 44 | }; 45 | in 46 | { 47 | packages = { 48 | inherit stellogen; 49 | default = stellogen; 50 | }; 51 | devShells.default = pkgs.mkShell { 52 | packages = [ 53 | pkgs.ocamlPackages.ocaml 54 | pkgs.ocamlPackages.ocamlformat 55 | pkgs.ocamlPackages.menhir 56 | pkgs.ocamlPackages.odoc 57 | pkgs.ocamlPackages.ocaml-lsp 58 | pkgs.jq 59 | ]; 60 | 61 | inputsFrom = [ 62 | self.packages.${system}.stellogen 63 | ]; 64 | }; 65 | }); 66 | } 67 | -------------------------------------------------------------------------------- /exercises/03-boolean.sg: -------------------------------------------------------------------------------- 1 | 'fill the #your_answer hole by following the specifications 2 | 3 | (def checker 4 | (galaxy 5 | (interaction (union #tested #test)) 6 | (expect (const (star ok))))) 7 | 8 | (def not_spec 9 | (galaxy 10 | (test0 (const (@star (-not 0 1) ok))) 11 | (test1 (const (@star (-not 1 0) ok))))) 12 | 13 | (:: not (not_spec / checker)) 14 | (def not 15 | #your_asnwer) 16 | 17 | 'how to print the truth table of NOT ? 18 | (== table_not (const 19 | (star (table_not 0 1)) 20 | (star (table_not 1 0)))) 21 | (def table_not 22 | (union 23 | #not 24 | #your_answer)) 25 | 26 | (def and_spec 27 | (galaxy 28 | (test00 (const (@star (-and 0 0 0) ok))) 29 | (test01 (const (@star (-and 0 1 0) ok))) 30 | (test10 (const (@star (-and 1 0 0) ok))) 31 | (test11 (const (@star (-and 1 1 1) ok))))) 32 | 33 | (:: and (and_spec / checker)) 34 | (def and 35 | #your_answer) 36 | 37 | 'find a second way to compute AND 38 | (:: and (and_spec / checker)) 39 | (def and2 40 | #your_answer) 41 | 42 | (def or_spec 43 | (galaxy 44 | (test00 (const (@star (-or 0 0 0) ok))) 45 | (test01 (const (@star (-or 0 1 1) ok))) 46 | (test10 (const (@star (-or 1 0 1) ok))) 47 | (test11 (const (@star (-or 1 1 1) ok))))) 48 | 49 | (:: or (or_spec / checker)) 50 | (def or 51 | #your_asnwer) 52 | 53 | 'find a second way to compute OR 54 | (:: or2 (or_spec / checker)) 55 | (def or2 56 | #your_answer) 57 | 58 | (def impl_spec 59 | (galaxy 60 | (test00 (const (@star (-impl 0 0 1) ok))) 61 | (test01 (const (@star (-impl 0 1 1) ok))) 62 | (test10 (const (@star (-impl 1 0 0) ok))) 63 | (test11 (const (@star (-impl 1 1 1) ok))))) 64 | 65 | (:: impl (impl_spec / checker)) 66 | (def impl 67 | (exec (union (union #not #or) 68 | #your_answer))) 69 | 70 | 'find a second way to compute IMPLICATION 71 | (:: impl2 (impl_spec / checker)) 72 | (def impl2 73 | (exec (union (union #not #or) 74 | #your_answer))) 75 | 76 | 'implement the excluded middle X \/ ~X 77 | (== ex (const (star (+ex 1 1)) (star (+ex 0 1)))) 78 | (def ex 79 | (union (union #not #or) 80 | #your_answer)) 81 | 82 | 'how to show the values of X, Y and Z for which X /\ ~(Y /\ Z) is true? 83 | (show-exec 84 | #your_answer) 85 | -------------------------------------------------------------------------------- /web/playground.ml: -------------------------------------------------------------------------------- 1 | open Js_of_ocaml 2 | open Stellogen 3 | 4 | (* Strip ANSI color codes from error messages for web display *) 5 | let strip_ansi_codes str = 6 | let re = Regexp.regexp "\027\\[[0-9;]*m" in 7 | Regexp.global_replace re str "" 8 | 9 | (* Main function that runs Stellogen code and returns output *) 10 | let run_stellogen code_js = 11 | Console.console##log (Js.string "run_stellogen called"); 12 | let code = Js.to_string code_js in 13 | Console.console##log (Js.string ("Code: " ^ code)); 14 | 15 | try 16 | let result = Web_interface.run_from_string code in 17 | Console.console##log (Js.string "run_from_string returned"); 18 | 19 | match result with 20 | | Ok output -> 21 | Console.console##log (Js.string ("Success: " ^ output)); 22 | Js.string (strip_ansi_codes output) 23 | | Error err -> 24 | Console.console##log (Js.string ("Error: " ^ err)); 25 | Js.string ("ERROR: " ^ strip_ansi_codes err) 26 | with e -> 27 | let msg = "Exception in run_stellogen: " ^ Printexc.to_string e in 28 | Console.console##log (Js.string msg); 29 | Js.string msg 30 | 31 | (* Function that runs Stellogen code with trace and returns output *) 32 | let trace_stellogen code_js = 33 | Console.console##log (Js.string "trace_stellogen called"); 34 | let code = Js.to_string code_js in 35 | Console.console##log (Js.string ("Code: " ^ code)); 36 | 37 | try 38 | let result = Web_interface.trace_from_string code in 39 | Console.console##log (Js.string "trace_from_string returned"); 40 | 41 | match result with 42 | | Ok output -> 43 | Console.console##log (Js.string ("Success: " ^ output)); 44 | Js.string output (* Don't strip ANSI codes from HTML *) 45 | | Error err -> 46 | Console.console##log (Js.string ("Error: " ^ err)); 47 | Js.string ("ERROR: " ^ strip_ansi_codes err) 48 | with e -> 49 | let msg = "Exception in trace_stellogen: " ^ Printexc.to_string e in 50 | Console.console##log (Js.string msg); 51 | Js.string msg 52 | 53 | (* Export to JavaScript *) 54 | let () = 55 | Console.console##log (Js.string "Stellogen playground loaded"); 56 | Js.export "Stellogen" 57 | object%js 58 | method run code = run_stellogen code 59 | 60 | method trace code = trace_stellogen code 61 | end 62 | -------------------------------------------------------------------------------- /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | name: build 2 | on: 3 | pull_request: 4 | branches: 5 | - master 6 | push: 7 | branches: 8 | - master 9 | 10 | jobs: 11 | build: 12 | strategy: 13 | fail-fast: false 14 | matrix: 15 | os: 16 | - macos-latest # macOS ARM64 17 | # - macos-latest-large # macOS x86_64 # disabled because we're poor 18 | - ubuntu-latest 19 | - windows-latest 20 | ocaml-compiler: 21 | - "5.3" 22 | include: 23 | - os: ubuntu-latest 24 | ocaml-compiler: "4.14" 25 | runs-on: ${{ matrix.os }} 26 | steps: 27 | - name: checkout 28 | uses: actions/checkout@v4 29 | - name: setup-ocaml 30 | uses: ocaml/setup-ocaml@v3 31 | with: 32 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 33 | dune-cache: true 34 | opam-pin: true 35 | allow-prerelease-opam: false 36 | - name: update-macos 37 | if: runner.os == 'macOS' 38 | run: | 39 | brew update 40 | brew upgrade 41 | brew install pkgconf 42 | - name: update-linux 43 | if: runner.os == 'linux' 44 | run: | 45 | sudo apt update 46 | - name: depext 47 | run: | 48 | opam install . --depext-only --with-test --with-doc 49 | - name: setup 50 | run: | 51 | opam install . --deps-only --with-test --with-doc 52 | opam install ocamlformat 53 | opam clean --switch-cleanup 54 | - name: build 55 | run: | 56 | opam exec -- dune build @install 57 | - name: test 58 | run: | 59 | opam exec -- dune runtest 60 | - name: lint-doc 61 | run: | 62 | ODOC_WARN_ERROR=true opam exec -- dune build @doc 2> output.txt 63 | $(exit $(wc -l output.txt | cut -d " " -f1)) 64 | shell: bash 65 | - name: lint-fmt 66 | run: | 67 | opam exec -- dune build @fmt || (echo "\n⚠️ please run \`dune fmt\` and try again" && exit 1) 68 | - name: lint-fresh-opam-file 69 | run: | 70 | git diff --exit-code stellogen.opam || (echo "⚠️ please run \`dune build\`, commit the changes to owi.opam, and then try again" && exit 1) 71 | shell: bash 72 | -------------------------------------------------------------------------------- /docs/incremental_parsing_implementation.md: -------------------------------------------------------------------------------- 1 | # Incremental Parser Implementation 2 | 3 | > **Disclaimer**: This document was written with the assistance of Claude Code and represents exploratory research and analysis. The content may contain inaccuracies or misinterpretations and should not be taken as definitive statements about the Stellogen language implementation. 4 | 5 | This document provides a quick reference for the incremental parser implementation in Stellogen. 6 | 7 | ## Overview 8 | 9 | **The Stellogen parser now uses Menhir's incremental API by default.** The traditional parser has been completely replaced with the incremental parser in `src/sgen_parsing.ml`. 10 | 11 | ## Files Modified 12 | 13 | - **`src/sgen_parsing.ml`** - Main parser now uses incremental API (replaced traditional parser) 14 | - **`docs/incremental_parsing.md`** - Comprehensive documentation 15 | 16 | ## Quick Start 17 | 18 | The parser is used automatically by all Stellogen code: 19 | 20 | ```ocaml 21 | (* Standard usage - automatically uses incremental parser *) 22 | let lexbuf = Sedlexing.Utf8.from_string "(def x 42)" in 23 | let exprs = Sgen_parsing.parse_with_error "" lexbuf 24 | ``` 25 | 26 | ## Key Components 27 | 28 | ### Checkpoint Type 29 | The parser state is represented by `Parser.MenhirInterpreter.checkpoint`: 30 | - `InputNeeded` - needs more input 31 | - `Shifting` / `AboutToReduce` - internal states 32 | - `Accepted result` - success 33 | - `HandlingError` / `Rejected` - errors 34 | 35 | ### API Functions 36 | - `Parser.Incremental.expr_file` - create initial checkpoint 37 | - `Parser.MenhirInterpreter.offer` - supply token 38 | - `Parser.MenhirInterpreter.resume` - continue parsing 39 | 40 | ## Configuration 41 | 42 | Already enabled in `src/dune`: 43 | ```lisp 44 | (menhir 45 | (modules parser) 46 | (flags --table --dump --explain)) 47 | ``` 48 | 49 | The `--table` flag enables the incremental API. 50 | 51 | ## Testing 52 | 53 | All existing tests now use the incremental parser: 54 | 55 | ```bash 56 | # Run all tests 57 | dune test 58 | 59 | # Run specific example 60 | dune exec sgen run -- examples/nat.sg 61 | ``` 62 | 63 | ## Use Cases 64 | 65 | 1. **REPL** - parse partial input interactively 66 | 2. **IDE features** - syntax highlighting, error recovery 67 | 3. **Incremental compilation** - reparse only changed sections 68 | 4. **Better error messages** - access to parser state 69 | 70 | ## See Also 71 | 72 | - `docs/incremental_parsing.md` - Full documentation 73 | - [Menhir Manual](https://gallium.inria.fr/~fpottier/menhir/manual.html) 74 | - `src/sgen_parsing.ml` - Incremental parser implementation 75 | - `src/parser.mly` - Parser grammar 76 | -------------------------------------------------------------------------------- /exercises/solutions/03-boolean.sg: -------------------------------------------------------------------------------- 1 | 'fill the #your_answer hole by following the specifications 2 | 3 | (def checker 4 | (galaxy 5 | (interaction (union #tested #test)) 6 | (expect (const (star ok))))) 7 | 8 | (def not_spec 9 | (galaxy 10 | (test0 (const (@star (-not 0 1) ok))) 11 | (test1 (const (@star (-not 1 0) ok))))) 12 | 13 | (:: not (not_spec / checker)) 14 | (def not 15 | (const 16 | (star (+not 0 1)) 17 | (star (+not 1 0)))) 18 | 19 | 'how to print the truth table of NOT ? 20 | (== table_not (const 21 | (star (table_not 0 1)) 22 | (star (table_not 1 0)))) 23 | (def table_not 24 | (union 25 | #not 26 | (const (@star (-not X Y) (table_not X Y))))) 27 | 28 | (def and_spec 29 | (galaxy 30 | (test00 (const (@star (-and 0 0 0) ok))) 31 | (test01 (const (@star (-and 0 1 0) ok))) 32 | (test10 (const (@star (-and 1 0 0) ok))) 33 | (test11 (const (@star (-and 1 1 1) ok))))) 34 | 35 | (:: and (and_spec / checker)) 36 | (def and 37 | (const 38 | (star (+and 0 0 0)) 39 | (star (+and 0 1 0)) 40 | (star (+and 1 0 0)) 41 | (star (+and 1 1 1)))) 42 | 43 | (:: and (and_spec / checker)) 44 | (def and2 45 | (const 46 | (star (+and 0 X 0)) 47 | (star (+and 1 X X)))) 48 | 49 | (def or_spec 50 | (galaxy 51 | (test00 (const (@star (-or 0 0 0) ok))) 52 | (test01 (const (@star (-or 0 1 1) ok))) 53 | (test10 (const (@star (-or 1 0 1) ok))) 54 | (test11 (const (@star (-or 1 1 1) ok))))) 55 | 56 | (:: or (or_spec / checker)) 57 | (def or 58 | (const 59 | (star (+or 0 0 0)) 60 | (star (+or 0 1 1)) 61 | (star (+or 1 0 1)) 62 | (star (+or 1 1 1)))) 63 | 64 | (:: or2 (or_spec / checker)) 65 | (def or2 66 | (const 67 | (star (+or 0 X X)) 68 | (star (+or 1 X 1)))) 69 | 70 | (def impl_spec 71 | (galaxy 72 | (test00 (const (@star (-impl 0 0 1) ok))) 73 | (test01 (const (@star (-impl 0 1 1) ok))) 74 | (test10 (const (@star (-impl 1 0 0) ok))) 75 | (test11 (const (@star (-impl 1 1 1) ok))))) 76 | 77 | (:: impl (impl_spec / checker)) 78 | (def impl 79 | (exec (union (union #not #or) 80 | (const (@star (-not X Y) (-or Y Z R) (+impl X Z R)))))) 81 | 82 | (:: impl2 (impl_spec / checker)) 83 | (def impl2 84 | (exec (union (union #not #or) 85 | (const (@star (-not X Y) (-or Y Z R) (+impl X Z R)))))) 86 | 87 | (== ex (const (star (+ex 1 1)) (star (+ex 0 1)))) 88 | (def ex 89 | (union (union #not #or) 90 | (const (@star (-not X R1) (-or R1 X R2) (+ex X R2))))) 91 | 92 | 'how to show the values of X, Y and Z for which X /\ ~(Y /\ Z) is true? 93 | (show-exec 94 | (union (union (union #or #not) #and) 95 | (const (@star (-or Y Z R1) (-not R1 R2) (-and X R2 1) (x X) (y Y) (z Z))))) 96 | -------------------------------------------------------------------------------- /src/unification.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | module type Signature = sig 4 | type idvar 5 | 6 | type idfunc 7 | 8 | val equal_idvar : idvar -> idvar -> bool 9 | 10 | val equal_idfunc : idfunc -> idfunc -> bool 11 | 12 | val compatible : idfunc -> idfunc -> bool 13 | end 14 | 15 | (* --------------------------------------- 16 | Elementary definitions 17 | --------------------------------------- *) 18 | 19 | module Make (Sig : Signature) = struct 20 | type term = 21 | | Var of Sig.idvar 22 | | Func of Sig.idfunc * term list 23 | [@@deriving eq] 24 | 25 | type substitution = (Sig.idvar * term) list 26 | 27 | type equation = term * term 28 | 29 | type problem = equation list 30 | 31 | let rec fold fnode fbase acc = function 32 | | Var x -> fbase x acc 33 | | Func (f, ts) -> 34 | let acc' = fnode f acc in 35 | List.fold ts ~init:acc' ~f:(fold fnode fbase) 36 | 37 | let rec map fnode fbase = function 38 | | Var x -> fbase x 39 | | Func (g, ts) -> Func (fnode g, List.map ~f:(map fnode fbase) ts) 40 | 41 | let skip _ acc = acc 42 | 43 | let exists_var pred = fold skip (fun y acc -> pred y || acc) false 44 | 45 | let exists_func pred = fold (fun y acc -> pred y || acc) skip false 46 | 47 | let occurs x = exists_var (fun y -> Sig.equal_idvar x y) 48 | 49 | let vars = fold skip List.cons [] 50 | 51 | let apply sub x = 52 | match List.Assoc.find sub ~equal:Sig.equal_idvar x with 53 | | None -> Var x 54 | | Some t -> t 55 | 56 | let subst sub = map Fn.id (apply sub) 57 | 58 | (* --------------------------------------- 59 | Unification algorithm 60 | --------------------------------------- *) 61 | 62 | let map_snd f (x, y) = (x, f y) 63 | 64 | let map_pair f (x, y) = (f x, f y) 65 | 66 | let rec solve sub : problem -> substitution option = function 67 | | [] -> Some sub 68 | (* Clear *) 69 | | (Var x, Var y) :: pbs when Sig.equal_idvar x y -> solve sub pbs 70 | (* Orient + Replace *) 71 | | (Var x, t) :: pbs | (t, Var x) :: pbs -> elim x t pbs sub 72 | (* Open *) 73 | | (Func (f, ts), Func (g, us)) :: pbs when Sig.compatible f g -> ( 74 | match List.zip ts us with 75 | | Ok zipped -> solve sub (zipped @ pbs) 76 | | Unequal_lengths -> None ) 77 | | _ -> None 78 | 79 | (* Replace *) 80 | and elim x t pbs sub : substitution option = 81 | if occurs x t then None (* Circularity *) 82 | else 83 | let new_prob = List.map ~f:(map_pair (subst [ (x, t) ])) pbs in 84 | let new_sub = (x, t) :: List.map ~f:(map_snd (subst [ (x, t) ])) sub in 85 | solve new_sub new_prob 86 | 87 | let solution : problem -> substitution option = solve [] 88 | end 89 | -------------------------------------------------------------------------------- /test/errors.t: -------------------------------------------------------------------------------- 1 | Error Messages Test Suite 2 | ========================= 3 | 4 | This test suite verifies that syntax errors produce proper error messages 5 | with correct location information (file:line:column). 6 | 7 | Lexer Errors 8 | ------------ 9 | 10 | Test unterminated string literal: 11 | $ sgen run errors/unterminated_string.sg 12 | error: Unterminated string literal 13 | --> errors/unterminated_string.sg:2:24 14 | 15 | 2 | (def test "unterminated 16 | | ^ 17 | 18 | 19 | found 1 error(s) 20 | [1] 21 | 22 | Test unknown escape sequence: 23 | $ sgen run errors/unknown_escape.sg 24 | error: Unknown escape sequence '\' 25 | --> errors/unknown_escape.sg:2:19 26 | 27 | 2 | (def test "hello\xworld") 28 | | ^ 29 | 30 | 31 | found 1 error(s) 32 | [1] 33 | 34 | Test invalid escape sequence: 35 | $ sgen run errors/invalid_string_char.sg 36 | error: Unknown escape sequence '\' 37 | --> errors/invalid_string_char.sg:2:19 38 | 39 | 2 | (def test "valid\qinvalid") 40 | | ^ 41 | 42 | 43 | found 1 error(s) 44 | [1] 45 | 46 | Delimiter Matching Errors 47 | ------------------------- 48 | 49 | Test mismatched parenthesis and bracket: 50 | $ sgen run errors/mismatched_paren.sg 51 | error: No opening delimiter for ']'. 52 | --> errors/mismatched_paren.sg:2:20 53 | 54 | 2 | (def test (foo bar] 55 | | ^ 56 | 57 | 58 | found 1 error(s) 59 | [1] 60 | 61 | Test mismatched bracket and brace: 62 | $ sgen run errors/mismatched_bracket.sg 63 | error: No opening delimiter for '}'. 64 | --> errors/mismatched_bracket.sg:2:20 65 | 66 | 2 | (def test [foo bar}) 67 | | ^ 68 | 69 | 70 | found 1 error(s) 71 | [1] 72 | 73 | Test unclosed parenthesis: 74 | $ sgen run errors/unclosed_paren.sg 75 | error: unclosed delimiter '(' 76 | --> errors/unclosed_paren.sg:2:20 77 | 78 | 2 | (def test (foo bar) 79 | | ^ 80 | 81 | 82 | hint: add the missing closing delimiter 83 | 84 | found 1 error(s) 85 | [1] 86 | 87 | Declaration Errors 88 | ------------------ 89 | 90 | Test that any expression is now valid as a term (unified design): 91 | $ sgen run errors/invalid_declaration.sg 92 | 93 | 94 | Error Recovery 95 | -------------- 96 | 97 | Test multiple errors (reports first error only): 98 | $ sgen run errors/multiple_errors.sg 99 | error: Unterminated string literal 100 | --> errors/multiple_errors.sg:4:1 101 | 102 | 103 | found 1 error(s) 104 | [1] 105 | 106 | -------------------------------------------------------------------------------- /examples/syntax.sg: -------------------------------------------------------------------------------- 1 | (use-macros "milkyway/prelude.sg") 2 | 3 | 'define ray 4 | (def a (-f X)) 5 | 6 | 'define star 7 | (def b [(-f X)]) 8 | 9 | 'define constellation 10 | (def c { 11 | @[+a] 'focus 12 | [-a b]}) 13 | 14 | 'full focus 15 | (def f @{ [a] [b] [c] }) 16 | 17 | 'identifier 18 | (def x #a) 19 | 20 | 'group 21 | (def x { #a #b }) 22 | 23 | 'string literals 24 | (def s "hello world") 25 | 26 | 'cons 27 | ' [0 1] == %cons(0 (%cons 1 %nil)) 28 | (def w (+w [0 1 0 1])) 29 | 30 | 'stack 31 | ' (stack s s 0) == (s (s 0)) 32 | (def n (+nat (stack s s 0))) 33 | 34 | 'execution 35 | (def x [(+f X) X]) 36 | (def y (-f a)) 37 | (def ex (fire @#x #y)) 'linear 38 | (def ex (exec @#x #y)) 'non-linear 39 | 40 | 'show constellation 41 | (show #ex) 42 | (show { [a] [b] [c] }) 43 | (show #s) 44 | 45 | 'complex identifiers 46 | (def (f a b) [(function a b)]) 47 | (show #(f a b)) 48 | 49 | 'inequality constraints 50 | (def ineq { 51 | [(+f a)] 52 | [(+f b)] 53 | @[(-f X) (-f Y) (r X Y) || (!= X Y)]}) 54 | (show #ineq) 55 | (stack show exec #ineq) 56 | 57 | 'process 58 | (def c (process 59 | (+n0 0) 'base constellation 60 | [(-n0 X) (+n1 (s X))] 'interacts with previous 61 | [(-n1 X) (+n2 (s X))])) 'interacts with previous 62 | (show #c) 63 | 64 | 'constellation with fields 65 | (def g { 66 | [(+field test1) [(+f a) ok]] 67 | [(+field test2) [(+f b) ok]]}) 68 | (show #g) 69 | 70 | 'field access and evaluation 71 | (def (get G X) (exec #G @[(-field X)])) 72 | (show #(get g test1)) 73 | (show #(get g test2)) 74 | 75 | 'nested fields 76 | (def g1 [ 77 | [(+field test1) [ 78 | [(+field test2) [(+f c) ok]]]]]) 79 | (def g2 #(get g1 test1)) 80 | (stack show #(get g2 test2)) 81 | 82 | 'define type 83 | (macro (spec X Y) (def X Y)) 84 | (spec nat { 85 | [(-nat 0) ok] 86 | [(-nat (s N)) (+nat N)]}) 87 | 88 | 'expect (equality check) 89 | (def x 0) 90 | (== #x 0) 91 | '(== #x 1) ' it fails (uncomment to see error) 92 | 93 | 'match (unifiability check) 94 | ' Checks if two constellations can unify (requires opposite polarities) 95 | (def term1 (+f a)) 96 | (def term2 (-f X)) 97 | (~= #term1 #term2) 'succeeds: they unify with X=a 98 | 99 | ' Check if two patterns are compatible 100 | (def pattern1 [(+add (s X) Y Z)]) 101 | (def pattern2 [(-add N M R)]) 102 | (~= #pattern1 #pattern2) 'succeeds: they unify 103 | 104 | ' This would fail (uncomment to see error): 105 | ' (~= (+f a) (-g b)) 'different function symbols 106 | ' (~= (+f a) (+f b)) 'same polarity, cannot interact 107 | 108 | 'type checking 109 | (def 2 (stack +nat s s 0)) 110 | (== @(exec @#2 #nat) ok) 111 | 112 | 'import file 113 | (use-macros "milkyway/prelude.sg") 114 | 115 | 'declaration definition 116 | (macro (:: Tested Test) 117 | (== @(exec @#Tested #Test) ok)) 118 | (:: 2 nat) 119 | -------------------------------------------------------------------------------- /test/examples.t: -------------------------------------------------------------------------------- 1 | Test examples directory 2 | ======================== 3 | 4 | Binary4 example: 5 | $ sgen run ../examples/binary4.sg 6 | { [(+b b1 4 1)] [(+b b1 3 0)] [(+b b1 2 0)] [(+b b1 1 0)] } 7 | { [(+b b2 4 1)] [(+b b2 3 1)] [(+b b2 2 0)] [(+b b2 1 0)] } 8 | { [(+b r 4 1)] [(+b r 3 0)] [(+b r 2 0)] [(+b r 1 0)] } 9 | { [(+b r 4 1)] [(+b r 3 1)] [(+b r 2 0)] [(+b r 1 0)] } 10 | { [(+b r 4 0)] [(+b r 3 1)] [(+b r 2 1)] [(+b r 1 1)] } 11 | { [(+b r2 4 0)] [(+b r2 3 1)] [(+b r2 2 1)] [(+b r2 1 1)] } 12 | 13 | Circuits example: 14 | $ sgen run ../examples/circuits.sg 15 | 16 | Lambda calculus example: 17 | $ sgen run ../examples/lambda/lambda.sg 18 | [(out [r X7]) (ida (exp [l X7] d))] 19 | [(out X7) (x (exp X7 d))] 20 | 21 | Linear lambda example: 22 | $ sgen run ../examples/lambda/linear_lambda.sg 23 | [(out [r X7]) (ida [l X7])] 24 | [(out [X7]) (x X7)] 25 | 26 | MALL (multiplicative-additive linear logic) example: 27 | $ sgen run ../examples/proofnets/mall.sg 28 | { [(-3 [r l X4]) (-3 [r r X4]) || (slice c b)] [(c X11) (d X11) || (slice c a)] } 29 | 30 | MLL (multiplicative linear logic) example: 31 | $ sgen run ../examples/proofnets/mll.sg 32 | 33 | Natural numbers example: 34 | $ sgen run ../examples/naive_nat.sg 35 | (+nat (s (s (s 0)))) 36 | (res 1) 37 | (res 0) 38 | 39 | NPDA (non-deterministic pushdown automaton) example: 40 | $ sgen run ../examples/states/npda.sg 41 | { [accept] [accept] } 42 | accept 43 | accept 44 | {} 45 | 46 | Prolog-style arithmetic examples: 47 | $ sgen run ../examples/prolog/arithmetic.sg 48 | (result of 0 + 0 = 0) 49 | (result of 0 + (s (s (s (s 0)))) = (s (s (s (s 0))))) 50 | (result of (s (s 0)) + (s (s 0)) = (s (s (s (s 0))))) 51 | (result of (s (s 0)) + (s (s 0)) = (s (s (s (s 0))))) 52 | (result of 0 - 0 = 0) 53 | (result of (s (s (s (s 0)))) - (s (s 0)) = (s (s 0))) 54 | (result of (s (s (s (s 0)))) - (s (s 0)) = (s (s 0))) 55 | 56 | Prolog-style family examples: 57 | $ sgen run ../examples/prolog/family.sg 58 | bob 59 | { [pat] [ann] } 60 | 61 | Stack example: 62 | $ sgen run ../examples/stack.sg 63 | (save 0) 64 | 65 | Sum types example: 66 | $ sgen run ../examples/sumtypes.sg 67 | a 68 | 69 | Syntax reference: 70 | $ sgen run ../examples/syntax.sg 71 | a 72 | { [c] [b] [a] } 73 | (%string hello world) 74 | (function a b) 75 | { [(-f X) (-f Y) (r X Y) || (!= X Y)] [(+f b)] [(+f a)] } 76 | { [(r b a) || (!= b a)] [(r a b) || (!= a b)] } 77 | (+n2 (s (s 0))) 78 | { [(+field test2) [(+f b) ok]] [(+field test1) [(+f a) ok]] } 79 | [(+f a) ok] 80 | [(+f b) ok] 81 | [(+f c) ok] 82 | 83 | Turing machine example: 84 | $ sgen run ../examples/states/turing.sg 85 | reject 86 | reject 87 | reject 88 | accept 89 | accept 90 | accept 91 | accept 92 | accept 93 | 94 | NFA (non-deterministic finite automaton) example: 95 | $ sgen run ../examples/states/nfa.sg 96 | {} 97 | accept 98 | {} 99 | {} 100 | -------------------------------------------------------------------------------- /docs/error_recovery_demo.md: -------------------------------------------------------------------------------- 1 | # Error Recovery Demonstration 2 | 3 | > **Disclaimer**: This document was written with the assistance of Claude Code and represents exploratory research and analysis. The content may contain inaccuracies or misinterpretations and should not be taken as definitive statements about the Stellogen language implementation. 4 | 5 | This document demonstrates Stellogen's error recovery capabilities. 6 | 7 | ## Example 1: Single Error with Hint 8 | 9 | **Input** (`single_error.sg`): 10 | ```stellogen 11 | (def x 42)) 12 | ``` 13 | 14 | **Output**: 15 | ``` 16 | error: no opening delimiter for ')' 17 | --> single_error.sg:1:9 18 | 19 | 1 | (def x 42)) 20 | | ^ 21 | 22 | hint: remove this delimiter or add a matching opening delimiter 23 | 24 | found 1 error(s) 25 | ``` 26 | 27 | ## Example 2: Unclosed Delimiter 28 | 29 | **Input** (`unclosed.sg`): 30 | ```stellogen 31 | (def x (add 1 2 32 | ``` 33 | 34 | **Output**: 35 | ``` 36 | error: unclosed delimiter '(' 37 | --> unclosed.sg:2:1 38 | 39 | hint: add the missing closing delimiter 40 | 41 | found 1 error(s) 42 | ``` 43 | 44 | ## Example 3: Multiple Independent Errors 45 | 46 | **Input** (`multiple_errors.sg`): 47 | ```stellogen 48 | (def good1 42) 49 | (def bad1 x)) 50 | (def good2 100) 51 | ``` 52 | 53 | **Output**: 54 | ``` 55 | error: no opening delimiter for ')' 56 | --> multiple_errors.sg:2:12 57 | 58 | 2 | (def bad1 x)) 59 | | ^ 60 | 61 | hint: remove this delimiter or add a matching opening delimiter 62 | 63 | error: unexpected symbol ':=' 64 | --> multiple_errors.sg:3:2 65 | 66 | 3 | (def good2 100) 67 | | ^ 68 | 69 | hint: check if this symbol is in the right place 70 | 71 | found 2 error(s) 72 | ``` 73 | 74 | *Note: The second error is a cascade error caused by the parser's recovery attempt* 75 | 76 | ## Example 4: Valid Code Still Parses 77 | 78 | **Input** (`valid.sg`): 79 | ```stellogen 80 | (def add { 81 | [(+add 0 Y Y)] 82 | [(-add X Y Z) (+add (s X) Y (s Z))]}) 83 | 84 | (def query [(-add R) R]) 85 | ``` 86 | 87 | **Output**: 88 | ``` 89 | (Successfully parses with no errors) 90 | ``` 91 | 92 | ## Benefits Demonstrated 93 | 94 | 1. **Multiple Errors at Once** - No need for fix-compile-fix cycles 95 | 2. **Helpful Hints** - Context-aware suggestions 96 | 3. **Accurate Positions** - Exact line/column from parser state 97 | 4. **Source Context** - Shows problematic code with visual pointer 98 | 5. **Error Count** - Summary at the end 99 | 100 | ## Known Limitations 101 | 102 | - **Cascading Errors**: Recovery may generate follow-up errors 103 | - **EOF Limits**: Cannot recover past end-of-file with unclosed delimiters 104 | - **Context Dependent**: Some errors are harder to recover from than others 105 | 106 | ## Implementation 107 | 108 | See: 109 | - `docs/error_recovery.md` - Full documentation 110 | - `src/parse_error.ml` - Error recovery logic 111 | - `src/sgen_parsing.ml` - Parser integration 112 | -------------------------------------------------------------------------------- /web/README.md: -------------------------------------------------------------------------------- 1 | # Stellogen Web Playground 2 | 3 | A browser-based playground for experimenting with Stellogen code, compiled to JavaScript using js_of_ocaml. 4 | 5 | ## Building the Playground 6 | 7 | ### Prerequisites 8 | 9 | Install the required OCaml packages: 10 | 11 | ```bash 12 | opam install js_of_ocaml js_of_ocaml-compiler js_of_ocaml-ppx 13 | ``` 14 | 15 | ### Build Steps 16 | 17 | **Recommended: Use the build script** 18 | 19 | ```bash 20 | # From the project root 21 | ./web/build.sh 22 | ``` 23 | 24 | This will: 25 | 1. Generate `examples.js` from `examples/*.sg` files 26 | 2. Compile OCaml to JavaScript 27 | 3. Copy all files to `web_deploy/` 28 | 29 | **Manual build:** 30 | 31 | 1. **Generate examples:** 32 | 33 | ```bash 34 | node web/build-examples.js 35 | ``` 36 | 37 | 2. **Build the JavaScript file:** 38 | 39 | ```bash 40 | # From the project root 41 | dune build web/playground.bc.js 42 | ``` 43 | 44 | This will create: 45 | - `_build/default/web/playground.bc.js` - The compiled JavaScript 46 | 47 | 3. **Copy files to serve:** 48 | 49 | ```bash 50 | # Create a deploy directory 51 | mkdir -p web_deploy 52 | cp _build/default/web/playground.bc.js web_deploy/playground.js 53 | cp web/index.html web_deploy/ 54 | cp web/examples.js web_deploy/ 55 | ``` 56 | 57 | 4. **Serve locally (for testing):** 58 | 59 | ```bash 60 | # Using Python 61 | cd web_deploy 62 | python3 -m http.server 8000 63 | 64 | # Or using any other HTTP server 65 | # Then open http://localhost:8000 in your browser 66 | ``` 67 | 68 | ### Examples Management 69 | 70 | The playground loads examples from `web/examples.js`, which is **auto-generated** from the actual `examples/*.sg` files. 71 | 72 | **To update examples:** 73 | 74 | 1. Edit the `.sg` files in `examples/` 75 | 2. Run `node web/build-examples.js` to regenerate `web/examples.js` 76 | 3. Or simply run `./web/build.sh` which includes this step 77 | 78 | **Adding new examples:** 79 | 80 | 1. Create your `.sg` file in `examples/` 81 | 2. Add an entry to `EXAMPLE_MAPPING` in `web/build-examples.js` 82 | 3. Add a `