Compare commits

..

350 Commits

Author SHA1 Message Date
Scott Richmond
b08fac2daf to_number in doc topics 2024-11-06 17:45:56 -05:00
Scott Richmond
1f7a9ebd4c fix doc comment for to_number 2024-11-06 17:44:18 -05:00
Scott Richmond
951edccebf 0.1.36 2024-11-03 17:20:54 -05:00
Scott Richmond
49c0ee20b3 remove test svgs 2024-11-03 17:20:47 -05:00
Scott Richmond
1ead4a8c5c build 2024-11-03 17:19:11 -05:00
Scott Richmond
2f5557a552 build 2024-11-03 17:04:04 -05:00
Scott Richmond
066edb00b5 build 2024-11-03 16:45:20 -05:00
Scott Richmond
5ed314de15 update prelude docs 2024-11-01 16:23:32 -04:00
Scott Richmond
ee09b9f208 random works on tuples 2024-11-01 16:23:15 -04:00
Scott Richmond
a7fcad18a6 0.1.35 2024-11-01 14:59:51 -04:00
Scott Richmond
58dc94ce7e 0.1.34 2024-11-01 14:59:36 -04:00
Scott Richmond
7aedbc18d6 build 2024-11-01 14:59:17 -04:00
Scott Richmond
339c2095aa include to_number 2024-10-23 17:30:14 -04:00
Scott Richmond
e278d91bba 0.1.33 2024-10-23 17:29:28 -04:00
Scott Richmond
bb0aaef060 build 2024-10-23 17:27:32 -04:00
Scott Richmond
54e7597b33 0.1.32 2024-10-23 16:44:58 -04:00
Scott Richmond
13856cb8b2 fix penwidth bug 2024-10-23 16:44:51 -04:00
Scott Richmond
f0d19da532 update prelude docs 2024-10-20 15:12:29 -04:00
Scott Richmond
ab3cf98bb5 update doc topics; escape slashes in links 2024-10-20 15:12:17 -04:00
Scott Richmond
440b97d47f update prelude documentation 2024-10-20 14:50:22 -04:00
Scott Richmond
b392e3282c 0.1.31 2024-10-20 14:39:42 -04:00
Scott Richmond
12f1a85e27 fix p5 call push/pop errors 2024-10-20 14:39:36 -04:00
Scott Richmond
fd55dd9a50 0.1.30 2024-10-20 14:22:21 -04:00
Scott Richmond
8d98f3e2b4 fix p5 call snafu 2024-10-20 14:22:14 -04:00
Scott Richmond
ca1a026980 0.1.29 2024-10-20 14:17:47 -04:00
Scott Richmond
d0a5128e0e fix turtle/path rotation, add p5 canvas transformations to adapter from web frontend 2024-10-20 14:17:39 -04:00
Scott Richmond
7dfaed11e3 0.1.28 2024-10-18 15:22:46 -04:00
Scott Richmond
deaeb7b4db build 2024-10-18 15:22:40 -04:00
Scott Richmond
2686d70a49 change test case 2024-10-18 15:18:56 -04:00
Scott Richmond
e6b2ffe4c9 add ludus-extraction function from svg 2024-09-09 18:23:13 -04:00
Scott Richmond
7285e599c5 0.1.27 2024-08-02 14:56:05 -04:00
Scott Richmond
39984ac537 build 2024-08-02 14:55:46 -04:00
Scott Richmond
73b2343963 add p5 test file 2024-08-02 13:56:37 -04:00
Scott Richmond
1733de7dff build 2024-08-01 18:54:18 -04:00
Scott Richmond
be9a86a973 build 2024-08-01 18:50:09 -04:00
Scott Richmond
479e304357 fix viewBox math so we see just what is there 2024-08-01 18:35:28 -04:00
Scott Richmond
db5622bccd new random seed for every run 2024-08-01 18:00:11 -04:00
Scott Richmond
7f64164078 build 2024-08-01 17:45:09 -04:00
Scott Richmond
d9e0fd23ec build 2024-08-01 17:43:29 -04:00
Scott Richmond
ffed651b6e build 2024-08-01 17:40:54 -04:00
Scott Richmond
ea80f81c33 build 2024-08-01 17:31:36 -04:00
Scott Richmond
d477782ff6 build 2024-08-01 17:05:41 -04:00
Scott Richmond
4baabc0a20 build 2024-08-01 16:43:01 -04:00
Scott Richmond
1085c7ae44 build out svg adapter, viewBox isn't working yet 2024-07-31 19:25:22 -04:00
Scott Richmond
e72b9f91ca build 2024-07-31 12:06:42 -04:00
Scott Richmond
d8f152998e build out p5 adapter 2024-07-30 18:36:13 -04:00
Scott Richmond
af125ffbbb fix background! bugs; delete a bunch of p5 adapter code, now moved to JS 2024-07-30 18:35:55 -04:00
Scott Richmond
657ff3dedb remove print! 2024-07-30 18:32:54 -04:00
Scott Richmond
2c9f6f8279 start building out p5 adapter 2024-07-22 11:39:57 -04:00
Scott Richmond
4ca1da1240 build 2024-07-21 20:00:34 -04:00
Scott Richmond
121446c5c4 first step: Ludus speaks turtle graphics, not p5 calls 2024-07-21 19:22:42 -04:00
Scott Richmond
df85be3c1e ref->box everywhere 2024-07-21 16:31:20 -04:00
Scott Richmond
60106d10f0 consider turtle-reported vs. expected-calculated state 2024-07-21 16:26:56 -04:00
Scott Richmond
e068059362 update turtle graphics protocol doc 2024-07-20 16:54:37 -04:00
Scott Richmond
dd3867968e add description of turtle graphics protocol 2024-07-20 16:34:12 -04:00
Scott Richmond
98421a9215 allow shadowing of prelude 2024-07-20 13:51:11 -04:00
Scott Richmond
7467bc8867 disallow shadowing, remove all shadowing from Prelude. 2024-07-19 16:48:11 -04:00
Scott Richmond
2ec95c8f33 add loop & recur back into the language: we do actually need it!--just not *pedagogically* 2024-07-19 16:25:18 -04:00
Scott Richmond
7afc32d9d1 remove loop & recur from the language 2024-07-19 16:11:30 -04:00
Scott Richmond
d4adc1d912 clean up 2024-07-19 16:09:31 -04:00
Scott Richmond
4a069278b8 finally fix script, block, tuple, list, dict, etc. off by one errors for last term 2024-07-19 16:00:17 -04:00
Scott Richmond
e9fee4c0e1 make some additional comments re: off-by-one error errors 2024-07-16 20:16:28 -04:00
Scott Richmond
2027490614 improve some things 2024-07-16 20:12:21 -04:00
Scott Richmond
cb7098ac4e start fixing off-by-one errors: script, block, tuple, args, tup-patt 2024-07-16 19:40:40 -04:00
Scott Richmond
d416511b48 remove repl cruft 2024-07-14 14:42:31 -04:00
Scott Richmond
a6c899a85f Pretty-patterns shows words at ends of splatterns 2024-07-14 14:41:53 -04:00
Scott Richmond
9ddb43a30f called keywords work in pipelines 2024-07-14 14:28:09 -04:00
Scott Richmond
9e50f0cbdf Fix typo 2024-07-14 14:18:10 -04:00
Scott Richmond
2f03bbb12f mismatched arity -> wrong number of arguments 2024-07-14 13:53:32 -04:00
Scott Richmond
8cf84e63d3 add char functions to doc 2024-07-14 13:49:49 -04:00
Scott Richmond
5c32d32f24 add chars to prelude 2024-07-14 13:48:47 -04:00
Scott Richmond
32b42e0242 ignore .zig-cache 2024-07-13 18:30:45 -04:00
Scott Richmond
4d1122fa58 repl comment 2024-06-24 12:57:09 -04:00
Scott Richmond
faf15bfd75 at works with strings 2024-06-24 12:56:43 -04:00
Scott Richmond
492c954655 0.1.26 2024-06-24 11:17:59 -04:00
Scott Richmond
0b67854494 build 2024-06-24 11:17:57 -04:00
Scott Richmond
af95c9800f json encode output 2024-06-24 11:17:47 -04:00
Scott Richmond
ed0a3311a4 0.1.25 2024-06-24 10:55:06 -04:00
Scott Richmond
55351da166 build 2024-06-24 10:55:02 -04:00
Scott Richmond
9752a87f27 move nil? to fix binding; use append! for turtle states 2024-06-24 10:54:54 -04:00
Scott Richmond
a30cbaebc6 at for strings, for real 2024-06-21 15:28:46 -04:00
Scott Richmond
7b56e90468 build 2024-06-21 11:37:31 -04:00
Scott Richmond
e05043e375 fix nil pattern matching 2024-06-21 11:37:23 -04:00
Scott Richmond
705be69661 validation error on empty blocks 2024-06-20 18:00:44 -04:00
Scott Richmond
3b65092267 add clause for join with empty list and separator 2024-06-20 17:50:01 -04:00
Scott Richmond
0363d5a091 calling something other than a function causes a panic 2024-06-20 17:49:27 -04:00
Scott Richmond
887d192c8a 0.1.24 2024-06-20 16:36:14 -04:00
Scott Richmond
f0176548de build 2024-06-20 16:36:11 -04:00
Scott Richmond
bf7dfe94bd fix fold/empty list bug 2024-06-20 16:36:01 -04:00
Scott Richmond
694b8adc60 0.1.23 2024-06-20 16:19:06 -04:00
Scott Richmond
f070076e2b build 2024-06-20 16:19:02 -04:00
Scott Richmond
42492c8a09 fix bug in rest with error on empty list 2024-06-20 16:18:54 -04:00
Scott Richmond
2c1de39161 0.1.22 2024-06-20 12:12:13 -04:00
Scott Richmond
58d70483cf build 2024-06-20 12:12:10 -04:00
Scott Richmond
70e8b1ede8 comment repl cruft 2024-06-20 12:12:02 -04:00
Scott Richmond
98180507e4 show and hide turtle 2024-06-20 12:10:07 -04:00
Scott Richmond
b9e721e4e2 don't draw line on turtle if pen is up 2024-06-20 12:04:45 -04:00
Scott Richmond
fe5b196404 0.1.21 2024-06-20 10:16:03 -04:00
Scott Richmond
ad0aff1cb0 build 2024-06-20 10:16:00 -04:00
Scott Richmond
7bdaf291a0 fix slice 2024-06-19 18:23:54 -04:00
Scott Richmond
27b1bb4e50 add setheading! and turtle pen tip draws in pencolor 2024-06-18 18:47:56 -04:00
Scott Richmond
b8af13106a 0.1.20 2024-06-18 12:45:29 -04:00
Scott Richmond
fc643cb561 build 2024-06-18 11:13:40 -04:00
Scott Richmond
43693e3c0e fix get, solving turtle movement hang 2024-06-18 11:13:33 -04:00
Scott Richmond
b31452db78 0.1.19 2024-06-17 13:32:01 -04:00
Scott Richmond
0a8dd3b7f7 build 2024-06-17 13:31:58 -04:00
Scott Richmond
ecc6438c3b build 2024-06-17 13:29:15 -04:00
Scott Richmond
8eed4145db fix words 2024-06-17 13:29:08 -04:00
Scott Richmond
848ba249ca add commit to build 2024-06-17 13:15:33 -04:00
Scott Richmond
d057678822 build 2024-06-17 13:12:37 -04:00
Scott Richmond
ef4a345da6 remove print!s from words 2024-06-17 13:12:26 -04:00
Scott Richmond
2203601770 0.1.18 2024-06-17 13:07:05 -04:00
Scott Richmond
2ae5f7929a build 2024-06-17 13:06:56 -04:00
Scott Richmond
3d0b58e6ed fix bug in at 2024-06-17 13:06:37 -04:00
Scott Richmond
716ecb01c5 0.1.17 2024-06-16 23:56:50 -04:00
Scott Richmond
a703a63502 build 2024-06-16 23:56:46 -04:00
Scott Richmond
bc7da38b3d final touches before computer class 2024-06-16 23:56:29 -04:00
Scott Richmond
bed1f7933e fix links 2024-06-15 23:51:09 -04:00
Scott Richmond
3bcfa520ac include link to prelude 2024-06-15 22:52:28 -04:00
Scott Richmond
600166884e include link to prelude 2024-06-15 22:51:19 -04:00
Scott Richmond
fcf3e4cdbe fix things, add things 2024-06-15 22:40:58 -04:00
Scott Richmond
84de1dae6c fix links 2024-06-15 22:30:38 -04:00
Scott Richmond
69cad142bc update 2024-06-15 22:29:06 -04:00
Scott Richmond
6d65c5abfd remove obsolete docs 2024-06-15 22:20:08 -04:00
Scott Richmond
03d5fb3450 update! 2024-06-15 22:19:50 -04:00
Scott Richmond
2bebd2261e add missing tuple fns 2024-06-15 22:19:32 -04:00
Scott Richmond
81915ed4ba cleanup 2024-06-15 22:18:58 -04:00
Scott Richmond
e3cbb4ad57 tweaks 2024-06-15 22:18:29 -04:00
Scott Richmond
2ad939b48b repl cruft 2024-06-15 21:53:40 -04:00
Scott Richmond
e899bc96f0 updated doc 2024-06-15 21:53:09 -04:00
Scott Richmond
bce3f9d7b0 properly show sets 2024-06-15 21:52:50 -04:00
Scott Richmond
6022895fa8 improve formatting and add new functions to topics 2024-06-15 21:52:19 -04:00
Scott Richmond
07c6d23587 bugfixes and improvements 2024-06-15 21:51:56 -04:00
Scott Richmond
d64467ef6d accurately describe current Ludus 2024-06-15 21:50:46 -04:00
Scott Richmond
d1c48fb0fd add hrs 2024-06-15 18:14:03 -04:00
Scott Richmond
3f030ca505 add back to top links 2024-06-15 18:12:28 -04:00
Scott Richmond
d78f7ce827 updated janet-based docs, but for real this time 2024-06-15 18:08:48 -04:00
Scott Richmond
9d66c9d697 Bugfixes! 2024-06-15 18:08:20 -04:00
Scott Richmond
68aca09de6 updated janet-based docs 2024-06-15 17:04:01 -04:00
Scott Richmond
d94eb5485d fix some bugs, prep for doc 2024-06-15 17:03:49 -04:00
Scott Richmond
98d6b1c865 fix some bugs 2024-06-15 17:03:37 -04:00
Scott Richmond
aba77569ac some pure-ludus string manipulation testing 2024-06-15 11:58:30 -04:00
Scott Richmond
223823ea68 0.1.16 2024-06-14 17:21:50 -04:00
Scott Richmond
ae6ad34364 build 2024-06-14 17:21:45 -04:00
Scott Richmond
d37e51b605 don't fold using builting functions 2024-06-14 17:21:32 -04:00
Scott Richmond
5d6d4e723d 0.1.15 2024-06-14 17:18:16 -04:00
Scott Richmond
4f84f408a7 no repl cruft + build 2024-06-14 17:18:11 -04:00
Scott Richmond
aa5795e168 improve errors, a bit 2024-06-14 17:17:23 -04:00
Scott Richmond
1841915d92 fix? bug in call-fn with incorrect function call info 2024-06-14 16:52:07 -04:00
Scott Richmond
7a7a3b8977 fix show box stack overflow 2024-06-14 15:55:57 -04:00
Scott Richmond
5a27d345eb fix goto! error 2024-06-14 15:43:52 -04:00
Scott Richmond
9584a21521 fix string escapes 2024-06-14 15:25:05 -04:00
Scott Richmond
c61981fa16 0.1.14 2024-06-14 14:54:18 -04:00
Scott Richmond
0583af819f build 2024-06-14 14:54:16 -04:00
Scott Richmond
0cbae4ce61 comment out repl cruft 2024-06-14 14:54:07 -04:00
Scott Richmond
e428fccc86 bugfixes and error improvements 2024-06-14 14:53:23 -04:00
Scott Richmond
f2f557d045 finish eliza 2024-06-11 17:25:10 -04:00
Scott Richmond
d7d9e71d67 Delete errant prints 2024-06-11 17:24:22 -04:00
Scott Richmond
eadd6e8047 fix bug in join 2024-06-11 17:19:01 -04:00
Scott Richmond
a9190995da 0.1.13 2024-06-10 18:28:23 -04:00
Scott Richmond
6dd5886896 build 2024-06-10 18:28:18 -04:00
Scott Richmond
287bf26f39 comment out repl cruft 2024-06-10 18:27:52 -04:00
Scott Richmond
de8f5c7cf4 baby's first eliza 2024-06-10 18:27:00 -04:00
Scott Richmond
5913f9b594 add string manipulation functions 2024-06-10 18:26:48 -04:00
Scott Richmond
2e7db1b969 fix typo 2024-06-10 18:25:12 -04:00
Scott Richmond
c1359e5c70 0.1.12 2024-06-07 17:26:07 -04:00
Scott Richmond
441117b966 build 2024-06-07 17:26:00 -04:00
Scott Richmond
92a1ee9010 fix mod error 2024-06-07 17:25:46 -04:00
Scott Richmond
9a3217b2c9 0.1.11 2024-06-07 17:17:00 -04:00
Scott Richmond
8c8f555d83 build 2024-06-07 17:16:52 -04:00
Scott Richmond
2f5af11527 add load_turtle_state! to prelude 2024-06-07 17:16:29 -04:00
Scott Richmond
8a4dd4b6e5 0.1.10 2024-06-07 16:46:05 -04:00
Scott Richmond
f5ce3aa72a build 2024-06-07 16:45:46 -04:00
Scott Richmond
9db10edd5c fix random(dict) bug 2024-06-07 16:45:31 -04:00
Scott Richmond
533a40bd45 runtime errors should return strings, not buffers 2024-06-07 16:41:11 -04:00
Scott Richmond
1fff319bb6 fix random bugs 2024-06-07 16:40:37 -04:00
Scott Richmond
de647097b7 0.1.9 2024-06-07 15:44:43 -04:00
Scott Richmond
5e3ffb0e1e delete print!s from prelude 2024-06-07 15:44:35 -04:00
Scott Richmond
fd3b47fa15 0.1.8 2024-06-07 15:26:03 -04:00
Scott Richmond
92498e7f80 test string interpolation 2024-06-07 15:25:03 -04:00
Scott Richmond
2fccbe96eb build things! 2024-06-07 15:20:45 -04:00
Scott Richmond
f2d76e766b integrate build scripts; build before publish 2024-06-07 15:20:36 -04:00
Scott Richmond
9498bed710 update justs 2024-06-07 15:10:17 -04:00
Scott Richmond
b3cfeb82e1 test 2024-06-07 15:06:23 -04:00
Scott Richmond
c532636acb 0.1.7 2024-06-07 15:04:46 -04:00
Scott Richmond
8dcf0b14d1 bump npm version 2024-06-07 15:04:40 -04:00
Scott Richmond
4d0a37328d fix string interpolation, prelude bugs 2024-06-07 15:04:06 -04:00
Scott Richmond
a6e2e11e4a bump version number 2024-06-07 13:42:45 -04:00
Scott Richmond
77b76430c1 finally correctly wire up all the things? 2024-06-07 13:42:11 -04:00
Scott Richmond
ed762c6079 println debugging! 2024-06-07 11:42:11 -04:00
Scott Richmond
a0678f5742 revert version to simple semver 2024-06-06 19:31:56 -04:00
Scott Richmond
940fc8ec31 fix the merge conflicts 2024-06-06 19:09:05 -04:00
Scott Richmond
cc33a2fb3d complete fucking draft of janet/wasm interpreter 2024-06-06 18:47:04 -04:00
Scott Richmond
baba0f4977 start packaging things up for wasm 2024-06-06 16:14:04 -04:00
Scott Richmond
03128441a6 start standing up a test harness, do not finish it, use judge 2024-06-06 15:43:36 -04:00
Scott Richmond
c7f99d35a6 fix a bear of a bug with accidentally persisting loop contexts 2024-06-06 15:41:33 -04:00
Scott Richmond
125a299b10 add postlude 2024-06-06 10:36:55 -04:00
Scott Richmond
d84a930073 bring in and update postlude 2024-06-05 23:23:47 -04:00
Scott Richmond
176feb5ae2 boxed console printing works, but not janet prints 2024-06-05 23:03:08 -04:00
Scott Richmond
8ac289cc9d I keep working, shit's not working 2024-06-05 20:16:29 -04:00
Scott Richmond
35a4b8e1c6 stash work: bugfixes, better errors, etc. 2024-06-05 17:47:41 -04:00
Scott Richmond
20cb689d12 prelude now passes validator 2024-06-05 15:52:03 -04:00
Scott Richmond
5874a56090 pull in most recent prelude 2024-06-05 13:21:48 -04:00
Scott Richmond
6a4e2ccd17 continue integration work: basic framework 2024-06-05 13:01:43 -04:00
Scott Richmond
721594823d start integration work: comment out prints/pps; create ludus.janet 2024-06-05 11:55:06 -04:00
Scott Richmond
fa5e298d94 ref -> box; fix box representations; add ds modifying functions to base 2024-06-04 16:57:32 -04:00
Scott Richmond
6cc7f045a2 complete draft of base 2024-06-04 16:24:54 -04:00
Scott Richmond
a25ece5a68 fixed closure/function contexts work with forward declaration & mutual recursion 2024-06-04 16:06:31 -04:00
Scott Richmond
f80aa7a8dc function contexts are fixed at declaration 2024-06-04 15:52:24 -04:00
Scott Richmond
b86a25b5bc stand up pkgs 2024-06-04 14:50:48 -04:00
Scott Richmond
27b688b96d interpret loop & recur! 2024-06-04 14:25:22 -04:00
Scott Richmond
4da846d8d7 doc! works! 2024-06-04 13:28:20 -04:00
Scott Richmond
478bc8649e add runtime doc info 2024-06-04 13:04:53 -04:00
Scott Richmond
1842923fa3 clean up little bugs 2024-06-04 13:02:15 -04:00
Scott Richmond
df274799be pretty print patterns 2024-06-04 13:00:34 -04:00
Scott Richmond
3081af60b2 parse docstrings 2024-06-04 12:13:40 -04:00
Scott Richmond
943e96203e comment on last line does not kill scanner 2024-06-04 11:59:41 -04:00
Scott Richmond
bbd41a0f74 interpret forward-declared functions, allowing mutual recursion 2024-06-04 11:54:29 -04:00
Scott Richmond
bc1eac46b8 validate forward declarations 2024-06-04 11:50:17 -04:00
Scott Richmond
d0a6cdbf54 parse fn forward declarations 2024-06-04 11:17:25 -04:00
Scott Richmond
3903f10c8d update in-code project management 2024-05-31 13:29:51 -04:00
Scott Richmond
8e03707f64 fix arity-checking bug; do not check arities in self-recursive function calls 2024-05-30 19:56:21 -04:00
Scott Richmond
524e3627fb get pkg validation access working for root pkg access, e.g. Foo :bar and Foo :bar 2024-05-30 19:38:00 -04:00
Scott Richmond
1dce69e239 work on pkgs 2024-05-23 19:33:19 -04:00
Scott Richmond
017655e8f8 add sqrt to prelude exports 2024-05-23 19:31:43 -04:00
Scott Richmond
8b0954b8ec correctly parse pkgs, actually 2024-05-20 18:24:41 -04:00
Scott Richmond
4547c0747d correctly parse pkgs 2024-05-20 18:23:00 -04:00
Scott Richmond
70b6a1dcd7 correctly parse pkg-name and pkg-kw 2024-05-20 18:11:49 -04:00
Scott Richmond
23128902bc add pkg-kw tokens 2024-05-20 18:04:24 -04:00
Scott Richmond
94adf5e9d5 called keywords take only a single argument 2024-05-20 17:43:57 -04:00
Scott Richmond
1120f21df2 dict pattern matching 2024-05-19 20:19:00 -04:00
Scott Richmond
d249ee0b21 validate dict patterns, by validating pairs 2024-05-19 20:18:39 -04:00
Scott Richmond
e767c319b1 fix dict parsing 2024-05-19 20:18:22 -04:00
Scott Richmond
010b584ef1 partial function application! 2024-05-19 19:35:41 -04:00
Scott Richmond
ba1aa8ed03 comment out repl cruft 2024-05-19 19:35:30 -04:00
Scott Richmond
e5917c6284 partially applied functions don't kill validation 2024-05-19 19:15:22 -04:00
Scott Richmond
6bf4dde487 do expressions 2024-05-19 18:38:44 -04:00
Scott Richmond
822f5c0178 {stringify, ltype} -> imports from base 2024-05-19 18:24:11 -04:00
Scott Richmond
2415f3d437 bugfixes 2024-05-19 18:23:34 -04:00
Scott Richmond
a399669197 fix bugs, oops 2024-05-19 18:13:08 -04:00
Scott Richmond
e468add325 write most of a base 2024-05-19 18:04:08 -04:00
Scott Richmond
24bbef74aa add janet functions 2024-05-19 16:18:52 -04:00
Scott Richmond
a06014270f validate with passed context; don't die on builtin functions 2024-05-19 16:17:34 -04:00
Scott Richmond
608ab4ab67 stringify fns and bugfixes 2024-05-19 14:54:51 -04:00
Scott Richmond
70bff13eea add ref to main switch 2024-05-19 14:54:37 -04:00
Scott Richmond
8d3d9a2dc5 2big commit: stand up fns, definitions and calls, lots of bugfixes 2024-05-19 01:58:10 -04:00
Scott Richmond
265f867a71 fix string interpolation 2024-05-18 18:22:49 -04:00
Scott Richmond
5deab18356 string patterns should now be working 2024-05-18 17:43:21 -04:00
Scott Richmond
014da297d0 more cleanup still 2024-05-18 17:05:47 -04:00
Scott Richmond
88aaf864ab more cleanup 2024-05-18 17:05:14 -04:00
Scott Richmond
95054ef234 add match exprs 2024-05-18 17:04:23 -04:00
Scott Richmond
41cd39df2e check + compile string patterns; some cleanup, some messes still 2024-05-18 17:04:04 -04:00
Scott Richmond
32cf7d6cc4 add expr to match to matchh 2024-05-18 17:01:12 -04:00
Scott Richmond
b5d23b26ec ensure :errors is always a tuple or array, never nil; allows (empty? (scanner :errors)) to work as a test for errors 2024-05-18 17:00:18 -04:00
Scott Richmond
b0c912b16c don't die when trying to check arity of a nonexistent function 2024-05-16 13:57:23 -04:00
Scott Richmond
d5f593b0f3 tuple patterns, with splats! 2024-05-15 12:33:52 -04:00
Scott Richmond
e0919e771d bugfix 2024-05-15 12:33:34 -04:00
Scott Richmond
399f1fd4c7 make progress; WIP: interpreting pattern matching 2024-05-15 00:05:25 -04:00
Scott Richmond
3a8a236f01 start work on interpreter 2024-05-14 20:44:54 -04:00
Scott Richmond
c68d08e8b2 fix imports 2024-05-14 20:44:43 -04:00
Scott Richmond
3e9f38ef5c update notes 2024-05-14 18:56:18 -04:00
Scott Richmond
b6e1d0e6ec clean up files 2024-05-14 18:56:06 -04:00
Scott Richmond
bc17fe5006 successfully flag tail calls 2024-05-14 18:52:11 -04:00
Scott Richmond
5fbafbac94 make progress: many things 2024-05-14 18:41:21 -04:00
Scott Richmond
ec43aa3c67 accept newlines after arrows in fn clauses; make some asts mutable for validation 2024-05-14 18:41:07 -04:00
Scott Richmond
3225ea2472 improve pkg 2024-05-14 13:46:13 -04:00
Scott Richmond
67cd9d479b keywords must start with lower case 2024-05-14 13:45:41 -04:00
Scott Richmond
3b3071adb0 capture unvalidated notes from parser as todos 2024-05-13 21:07:27 -04:00
Scott Richmond
7018949845 a whole lot of a validator 2024-05-13 20:55:36 -04:00
Scott Richmond
68e96bf223 many bugfixes; desugar pairs with word shorthand in dicts 2024-05-13 20:55:21 -04:00
Scott Richmond
2cfe9fdffc complete draft of parsing 2024-05-11 23:25:36 -04:00
Scott Richmond
806ec0e8f0 moar validations 2024-05-11 23:25:20 -04:00
Scott Richmond
65eb17778c don't put break before pipeline 2024-05-11 23:25:07 -04:00
Scott Richmond
b5def30348 add a pretty-printer (that sometimes causes errors!), lots of bugs but functions for all the things 2024-05-10 16:10:57 -04:00
Scott Richmond
b0cffea71f moar idears for validation 2024-05-10 16:10:27 -04:00
Scott Richmond
064b5df2dd better name for package names 2024-05-10 15:02:55 -04:00
Scott Richmond
f1a1e9ec62 notes towards an ast-validator 2024-05-10 15:02:37 -04:00
Scott Richmond
8f284f1e65 first draft of all the things; many bugs abound 2024-05-10 15:02:22 -04:00
Scott Richmond
232261b646 add uppercase pkg to scanner 2024-05-10 14:29:12 -04:00
Scott Richmond
f3778792b3 parse interpolated strings/string patterns 2024-05-09 18:30:13 -04:00
Scott Richmond
248e424993 moar bugfixes 2024-05-09 18:29:51 -04:00
Scott Richmond
3f16e45204 fix escaping brace bug, which was fixing next-char bug; also clean some stuff up 2024-05-09 16:35:22 -04:00
Scott Richmond
c5d04ddd66 some unfinished work on string interpolation 2024-05-08 17:42:10 -04:00
Scott Richmond
3466b075af add easy patterns, start work on string interpolation 2024-05-08 17:31:47 -04:00
Scott Richmond
736f1024c3 fix nil parser bug, start work on patterns 2024-05-08 17:24:29 -04:00
Scott Richmond
4f16cf5cb0 finally get when clauses & forms right 2024-05-08 17:14:51 -04:00
Scott Richmond
942f55fb39 fix panic off-by-one-error 2024-05-08 15:56:59 -04:00
Scott Richmond
0eb212dd45 add a break before pipline 2024-05-08 15:29:31 -04:00
Scott Richmond
77bacd1367 get when expressions worked out 2024-05-08 15:29:18 -04:00
Scott Richmond
cdb71a8122 :rarrow -> :arrow 2024-05-08 13:59:46 -04:00
Scott Richmond
c36a140c6b if expressions, done 2024-05-08 13:50:26 -04:00
Scott Richmond
f3256f7d12 first draft if 2024-05-08 13:22:49 -04:00
Scott Richmond
05703a27fa complete simple expressions 2024-04-29 18:38:08 -04:00
Scott Richmond
98fcfe7eb4 get the recursive descent framework worked out 2024-04-29 16:25:24 -04:00
Scott Richmond
402b444231 add todos for computer class 2024-04-28 18:14:11 -04:00
Scott Richmond
3d570beb45 start work on a recursive descent parser 2024-04-28 18:13:49 -04:00
Scott Richmond
0de9f90f27 update .gitignore to exclude repl cruft 2024-04-28 18:10:03 -04:00
Scott Richmond
2bc32c35f2 get the thing to run, anyway 2024-04-06 19:12:44 -04:00
Scott Richmond
83ce75c6ea Clean some things up 2024-04-06 18:15:12 -04:00
Scott Richmond
42907f19d7 start debugging current state of affairs: add comments with compile errors 2024-04-06 17:00:22 -04:00
Scott Richmond
bb42ca7ca4 Add doc command to justfile 2024-04-06 16:58:11 -04:00
Scott Richmond
efffbafdba Save some work. 2024-03-25 16:04:54 -04:00
Scott Richmond
4a1e509fc4 0.1.3 2024-01-22 17:37:28 -05:00
Scott Richmond
aef33279ca Fix vector subtraction 2024-01-22 17:37:11 -05:00
Scott Richmond
1b361971bc 0.1.2 2024-01-22 17:18:46 -05:00
Scott Richmond
673a96ffb8 Update prelude 2024-01-22 17:17:29 -05:00
Scott Richmond
90c97e7cfe Fix exports & bump version 2024-01-19 17:49:26 -05:00
Scott Richmond
d253dc3d3e stash work 2024-01-19 16:50:01 -05:00
Scott Richmond
f02532ee40 Get annoyed by translating my clj parser into janet; start work on a Janet/PEG parser 2024-01-11 19:42:58 -05:00
Scott Richmond
f4d09afed6 clj->janet :: loop->clj-loop 2024-01-11 14:26:22 -05:00
Scott Richmond
a65b4ba873 Keep working on translating parser 2024-01-09 23:42:56 -05:00
Scott Richmond
70e8763dc5 Pull janet files out into their own dir; start work on parser 2024-01-07 22:59:00 -05:00
Scott Richmond
d3a1e10983 Improve repl commands 2024-01-07 22:58:03 -05:00
Scott Richmond
ff40d395f8 Repl things 2024-01-07 20:10:45 -05:00
Scott Richmond
307bebfa53 First pass at janet scanner 2024-01-07 20:10:16 -05:00
Scott Richmond
153c5a358e Take some notes clj->janet 2024-01-07 20:10:02 -05:00
Scott Richmond
2cbc39029c Janet repl things 2024-01-07 20:09:01 -05:00
Scott Richmond
1520b1d8e7 Repl cruft 2023-12-31 18:37:19 -05:00
Scott Richmond
83bfc01275 Try with kitten 2023-12-31 18:37:09 -05:00
Scott Richmond
14780bf6b8 First pass at new state model: all refs are included in results. 2023-12-27 12:24:12 -05:00
Scott Richmond
f657da57ef Bump version 2023-12-27 12:09:39 -05:00
Scott Richmond
40f66321f1 Mention the whole team, duh 2023-12-26 19:43:53 -05:00
Scott Richmond
c9a956fafb Bump version 2023-12-24 23:42:37 -05:00
47420740df Merge pull request 'test_harness' (#22) from test_harness into main
Reviewed-on: #22
2023-12-25 04:41:16 +00:00
Scott Richmond
8b47aab280 Allow test harness to expect panics 2023-12-24 19:12:04 -05:00
Scott Richmond
d12d485583 Add basic test harness, actually add files this time 2023-12-24 17:17:08 -05:00
Scott Richmond
afb8bacb25 Stand up automated js/tap-based test harness framework. 2023-12-24 17:08:02 -05:00
Scott Richmond
20ea25761a Remove conflicting repl cruft. 2023-12-24 15:59:31 -05:00
Scott Richmond
770c84d081 Merge branch 'test-exprs' 2023-12-24 15:58:52 -05:00
Scott Richmond
b5d57cd96c Testing hits all the desiderata. 2023-12-24 15:53:40 -05:00
Scott Richmond
b6eeaa1d3e Stand up basic testing 2023-12-24 15:23:53 -05:00
Scott Richmond
b723532d1a Add testing status to run 2023-12-24 14:22:16 -05:00
8375e19f1e Merge pull request 'expr-repeat' (#19) from expr-repeat into main
Reviewed-on: #19
2023-12-24 19:17:16 +00:00
Scott Richmond
7a2c404daf Light testing 2023-12-24 14:16:08 -05:00
Scott Richmond
7541d2499d Change interpreter (just change name of binding in interpret-repeat 2023-12-24 14:12:50 -05:00
Scott Richmond
a6d64ff827 Change grammar 2023-12-24 14:11:49 -05:00
Scott Richmond
46817bd4e5 Update documentation; a pull request seems like overkill 2023-12-18 01:13:26 -05:00
Scott Richmond
6c11c5139b Language documentation reflects panic! as a form. 2023-12-18 01:13:15 -05:00
a86b8f4fa4 Merge pull request 'better_panics' (#16) from better_panics into main
Reviewed-on: #16
2023-12-18 05:46:05 +00:00
Scott Richmond
7fe53a13b4 Bump version 2023-12-18 00:43:24 -05:00
Scott Richmond
3a50910e3d Fix bug where partially applied called keyword returns nil 2023-12-18 00:42:44 -05:00
34f9a08bd6 Merge pull request 'better_panics' (#15) from better_panics into main
Reviewed-on: #15
2023-12-18 05:26:57 +00:00
Scott Richmond
0b6deefd5d Bump version 2023-12-18 00:23:06 -05:00
Scott Richmond
b12b49c197 Fix cljs/clj bug 2023-12-18 00:22:42 -05:00
Scott Richmond
ff1e1345b8 Stop tracking repl-port 2023-12-18 00:20:50 -05:00
Scott Richmond
be2c91b7dc Fix line number reporting bugs: look for lines in the right place. 2023-12-18 00:20:34 -05:00
Scott Richmond
4e646101e2 Remove duplicate error messages. 2023-12-17 23:16:12 -05:00
Scott Richmond
53b71fe790 Panic is now a form, not a function. 2023-12-17 23:13:50 -05:00
6cf3fdd5f2 Merge pull request 'Light update; no struct deletion necessary.' (#14) from delete_structs into main
Reviewed-on: #14
2023-12-18 00:33:39 +00:00
3373d28f93 Merge pull request 'delete_structs' (#13) from delete_structs into main
Reviewed-on: #13
2023-12-18 00:21:37 +00:00
71 changed files with 71967 additions and 4094 deletions

6
.gitignore vendored
View File

@ -28,3 +28,9 @@ node_modules/
.shadow-cljs .shadow-cljs
.cljs_node_repl/ .cljs_node_repl/
.helix/ .helix/
target/repl-port
.repl-buffer
.repl-buffer.janet
.env
src/jpm_tree
.zig-cache

View File

@ -1,24 +0,0 @@
# Change Log
All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/).
## [Unreleased]
### Changed
- Add a new arity to `make-widget-async` to provide a different widget shape.
## [0.1.1] - 2021-10-23
### Changed
- Documentation on how to make the widgets.
### Removed
- `make-widget-sync` - we're all async, all the time.
### Fixed
- Fixed widget maker to keep working when daylight savings switches over.
## 0.1.0 - 2021-10-23
### Added
- Files from the new template.
- Widget maker public API - `make-widget-sync`.
[Unreleased]: https://sourcehost.site/your-name/cludus/compare/0.1.1...HEAD
[0.1.1]: https://sourcehost.site/your-name/cludus/compare/0.1.0...0.1.1

View File

@ -2,48 +2,37 @@
## Ludus: A friendly, dynamic, functional language ## Ludus: A friendly, dynamic, functional language
Ludus is a scripting programming language that is designed to be friendly, dynamic, and functional. Ludus is a scripting programming language that is designed to be friendly, dynamic, and functional.
This repo currently contains an in-progress reference implementation of an interpreter for the Ludus programming language, using Clojure as a host language. This repo currently contains a work-in-progress implementation of an interpreter for the Ludus programming language, using [Janet](https://janet-lang.org) as a host language.
Ludus is part of the [_Thinking with Computers_ project](https://alea.ludus.dev/twc/), run by Scott Richmond at the University of Toronto, with collaborator Matt Nish-Lapidus; Bree Lohman and Mynt Marsellus are the RAs for the project. Ludus is our research language, which aspires to be a free translation of Logo for the 2020s.
Ludus is part of the [_Thinking with Computers_ project](https://thinking-with-computers.github.io), run by Scott Richmond at the University of Toronto. Ludus is our research language, which aspires to be a free translation of Logo for the 2020s.
Here are our design goals: Here are our design goals:
#### Friendly #### Friendly
Ludus, like Logo, is meant to be a teaching language, often for students who don't think of themselves as "computer people." Our intended audience are humanities and art people at the University level (undergrads, grads, faculty). Everything is kept as simple as possible, but no simpler. Everything is consistent as possible. We aspire to the best error messages we can muster, which is important for a language to be teachable. That means being as strict as we can muster, _in order to be friendlier_. Ludus, like Logo, is meant to be a teaching language, often for students who don't think of themselves as "computer people." Our intended audience are humanities and art people at the university level (undergrads, grads, faculty). Everything is kept as simple as possible, but no simpler. Everything is consistent as possible. We aspire to the best error messages we can muster, which is important for a language to be teachable. That means being as strict as we can muster, _in order to be friendlier_.
Our current development target is Ludus on the web: https://thinking-with-computers/ludus-web. That wires what we do on the langauge interpreter (here in this repo) to a web frontent. Our current development target is Ludus on the web: https://web.ludus.dev. That wires what we do on the langauge interpreter (here in this repo) to a web frontend.
Naturally, it starts with Logo's famed turtle graphics. Naturally, it starts with Logo's famed turtle graphics.
#### Dynamic #### Dynamic
Statically typed programming languages generally give more helpful error messages than dynamic ones, but learning a type system (even one with robust type inference) requires learning two parallel systems: the type system and the expression system. Type systems only really make sense once you've learned why they're necessary. And their benefits seem (to us, anyway) to be largely necessary when writing long-lived, maintainable, multiauthor code. Ludus code is likely to be one-off, expressive, and single-authored. Statically typed programming languages generally give more helpful error messages than dynamic ones, but learning a type system (even one with robust type inference) requires learning two parallel systems: the type system and the expression system (well, and the pattern system). Type systems only really make sense once you've learned why they're necessary. And their benefits seem (to us, anyway) to be largely necessary when writing long-lived, maintainable, multi-author code. Ludus code is likely to be one-off, expressive, and single-authored.
To stay friendly, Ludus is dynamic. But: despite the dynamism, we aim to be as strict as possible. Certainly, we want to avoid the type conversion shenanigans of a language like JavaScript. To stay friendly, Ludus is dynamic. But: despite the dynamism, we aim to be as strict as possible. Certainly, we want to avoid the type conversion shenanigans of a language like JavaScript.
#### Functional #### Functional
Ludus is emphatically functional: it uses functions for just about everything. This is both because your humble PI had his world reordered when he learned his first functional language (Elixir), and because the research into Logo and the programming cultures of MIT in the 1970s revolve around extremely functional Lisp code (i.e., Scheme). Logo is a weird little language, but it is a descendant of Lisp. So is Ludus. Ludus is emphatically functional: it uses functions for just about everything. This is both because your humble PI had his world reordered when he learned his first functional language (Elixir), and because the research into Logo and the programming cultures of MIT in the 1970s revolve around extremely functional Lisp code (i.e., Scheme). Logo is a weird little language, but it is a descendant of Lisp. So is Ludus.
Also, we believe that Ludus's immutable bindings and persistent or immutable data structures and careful approach to manipulating state lead to a lot of good pedagogical results. Learning a programming language involves learning how to model what's going on inside the computer; Ludus, we think, makes that simpler and easier. Also, we believe that Ludus's immutable bindings and persistent or immutable data structures and careful approach to manipulating state lead to a lot of good pedagogical results. Learning a programming language involves learning how to model what's going on inside the computer; Ludus, we think, makes that both simpler and easier.
If you're looking for cognate languages, Ludus takes a _lot_ of design inspiration from Clojure and Elixir (which itself took a lot from Clojure). (The current--quick, dirty, and slow--version of LUdus written in Clojure, in no small part to have access to persistent data structures that compile to JS.) Clojure and Elixir are great! If you're asking why you should use Ludus instead of them, you're already at the point where you should be using them. Ludus is, maybe, for the people whom you'd like to work with in 5 years at your Pheonix shop. If you're looking for cognate languages, Ludus takes a _lot_ of design inspiration from Clojure and Elixir (which itself took a lot from Clojure). (The current--quick, dirty, and slow--version of Ludus is written in [Janet](https://janet-lang.org).) Clojure and Elixir are great! If you're asking why you should use Ludus instead of them, you're already at the point where you should be using them. Ludus is, maybe, for the people whom you'd like to work with in 5 years at your Pheonix shop (but even then, probably not).
### Status ### Status
Pre-alpha, still under active development. Lots of things change all the time. See [the ludus-spec repo for progress notes and additional documentation](https://github.com/thinking-with-computers/ludus-spec/blob/main/todo.md). Pre-alpha, still under active development. Lots of things change all the time.
The current version of Ludus is a pure function that runs in JavaScript. We have plans for more and better things. The current version of Ludus is a pure function that runs in JavaScript as a WASM blob. We have plans for more and better things.
### Use ### Use
Current emphasis is on the web version: see https://github.com/thinking-with-computers/ludus-web/. Current emphasis is on the web version: https://web.ludus.dev.
Or, if you're on a Mac and want to open a terminal:
* Clone this repo.
- `git clone https://github.com/thinking-with-computers/ludus`
* Have Clojure and Leiningen installed.
- On a Mac: `brew install clojure leiningen`
* `lein run {script}`, it runs your script.
* `lein run`, it runs a REPL.
~Or, download a binary on the [releases page](https://github.com/thinking-with-computers/ludus/releases). (At current: M1 Mac only.)~
### Main features ### Main features
* Expression-oriented: everything returns a value * Expression-oriented: everything returns a value
@ -52,17 +41,14 @@ Or, if you're on a Mac and want to open a terminal:
* Easy-peasy partial application with placeholders * Easy-peasy partial application with placeholders
* Function pipelines * Function pipelines
* Persistent or immutable data structures * Persistent or immutable data structures
* Careful, explicit state management using `ref`erences * Careful, explicit state management using `box`es
* Clean, concise, expressive syntax * Clean, concise, expressive syntax
* Value-based equality; only functions are reference types * Value-based equality; only functions are reference types
#### Under construction #### Under construction
* Tail call optimization * Actor-model style concurrency.
* Actor model style concurrency? * Faster, bytecode-based VM written in a systems language, for better performance.
* ~Strong nominal data typing, including tagged unions~ * Performant persistent, immutable data structures, à la Clojure.
- ~Exhaustiveness-checking in `match` expressions in dynamically-typed code~
* Faster, bytecode-based VM written in a systems language, compiled to WASM for web use.
* Recursive descent parser with excellent parsing error message, just as soon as the syntax is fully stabilized.
### `Hello, world!` ### `Hello, world!`
Ludus is a scripting language. At current it does not have a good REPL. Our aim is to get interactive coding absolutely correct, and our efforts in [ludus-web](https://github.com/thinking-with-computers/ludus-web) are currently under way to surface the right interactivity models for Ludus. Ludus is a scripting language. At current it does not have a good REPL. Our aim is to get interactive coding absolutely correct, and our efforts in [ludus-web](https://github.com/thinking-with-computers/ludus-web) are currently under way to surface the right interactivity models for Ludus.
@ -84,7 +70,7 @@ print! ("Hello, world!")
=> :ok => :ok
``` ```
Or, you can use a the `print!` function, which sends a string to a console (`stdout` on Unix, or a little console box on the web). Because `print!` returns the keyword `:ok` when it completes, that is the result of the last expression in the script--and so Ludus also prints this. Here, we use the `print!` function, which sends a string to a console (`stdout` on Unix, or a little console box on the web). Because `print!` returns the keyword `:ok` when it completes, that is the result of the last expression in the script--and so Ludus also prints this.
### Some code ### Some code
Fibonacci numbers: Fibonacci numbers:
@ -104,4 +90,4 @@ fib (10) &=> 55
``` ```
### More on Ludus ### More on Ludus
See the [language reference](/language.md) and [the documentation for the prelude](/prelude.md). See the [language reference](language.md) and [the documentation for the prelude](prelude.md).

View File

@ -1,55 +0,0 @@
[x] Fix recursive definition problems in grammar.clj
TODOS for parser
[ ] Make parser errors pretty
[ ] Use synchronization to make parsing more robust
[ ] Decide on synchronization tokens: [then else ] ) } , ; \n]
TODOS from interpreter
[x] implement tuple splat patterns
[x] update match-list to use new AST representation
[x] fix length comparison when pattern includes splats
[x] update match-dict to use new AST representation
[x] update match-struct to use new AST representation
[ ] update interpret-receive to use new AST representation
[ ] Check interpret-fn-inner ctx for cycles/bugs
Re-add processes to the language
[ ] Write send as function
[ ] update interpret-spawn to use new AST representation
[ ] ---- Investigate weird timing issue in current send implementation
[ ] Investigate `with-bindings` and virtual threads
Finish interpreter
[x] Wire up new interpreter to repl, script situation
[x] Merge new interpreter
Conditionals
[ ] Fix let bindings/scope in `if` expressions
[ ] Make `and` and `or` special forms
[ ] ---- `if and (let x ...)` pattern
[ ] ---- arguments are lazily, not eagerly, executed
Write a compiler: desugaring
[~] `...` to `..._` in tuple & list patterns
[ ] placeholder partial application to anonymous lambda
[ ] word -> :[word] word in pairs (patterns & expressions)
Write a compiler: correctness
[ ] check for unbound names
[ ] check for re-binding names
[ ] check that recur is in tail position
[ ] check that recur is only called inside loop or fn forms
[ ] check ns accesses
[ ] prevent import cycles
[ ] splattern is last member in a pattern
[ ] -----List/Tuple
[ ] -----Dict/Struct/Set
Write a compiler: optimization
[ ] devise tail call optimization
Next steps
[ ] Get drawing working?
[ ] Add stack traces for panics

View File

@ -1,8 +0,0 @@
<html>
<head>
<title>Hello, world!</title>
</head>
<body>
<script src="main.js"></script>
</body>
</html>

130
build/driver.cpp Normal file
View File

@ -0,0 +1,130 @@
#include <cstdint>
#include <emscripten.h>
#include <emscripten/bind.h>
#include <string>
#include <stdio.h>
#include "janet.h"
using std::string;
// set all our exported Janet functions as null pointers
static JanetFunction *janet_ludus = NULL;
// these let us look up functions
Janet env_lookup(JanetTable *env, const char *name) {
Janet out;
janet_resolve(env, janet_csymbol(name), &out);
return out;
}
JanetFunction *env_lookup_function(JanetTable *env, const char *name) {
Janet value = env_lookup(env, name);
if (!janet_checktype(value, JANET_FUNCTION)) {
janet_panicf("expected %s to be a function, got %q\n", name, value);
}
return janet_unwrap_function(value);
}
// this lets us call a function
bool call_fn(JanetFunction *fn, int argc, const Janet *argv, Janet *out) {
JanetFiber *fiber = NULL;
if (janet_pcall(fn, argc, argv, out, &fiber) == JANET_SIGNAL_OK) {
return true;
} else {
janet_stacktrace(fiber, *out);
return false;
}
}
// this is darkish magic, reads an embedded file
// do not fuck with this, fellas
unsigned char *read_file(const char *filename, size_t *length) {
size_t capacity = 2 << 17;
unsigned char *src = (unsigned char *)malloc(capacity * sizeof(unsigned char));
assert(src);
size_t total_bytes_read = 0;
FILE *file = fopen(filename, "r");
assert(file);
size_t bytes_read;
do {
size_t remaining_capacity = capacity - total_bytes_read;
if (remaining_capacity == 0) {
capacity <<= 1;
src = (unsigned char*)realloc(src, capacity * sizeof(unsigned char));
assert(src);
remaining_capacity = capacity - total_bytes_read;
}
bytes_read = fread(&src[total_bytes_read], sizeof(unsigned char), remaining_capacity, file);
total_bytes_read += bytes_read;
} while (bytes_read > 0);
fclose(file);
*length = total_bytes_read;
return src;
}
// finally, getting a string back
// this is our result type
struct StringResult {
string value;
};
// this is our result constructor
// Janet's getcstring resturns const char*
StringResult string_result(const char* cstr) {
// ...which we have to cast to a std::string
return (StringResult) {.value = (string) cstr };
}
// and this is a function that takes and returns a string
// it returns a StringResult, tho
StringResult ludus(string source) {
Janet result;
const Janet args[1] = {janet_cstringv(source.c_str())};
call_fn(janet_ludus, 1, args, &result);
// get the cstring in the result
// the 0 passed here is the index in the result of the string
const char* cstr = janet_getcstring(&result, 0);
// return a constructed StringResult
return string_result(cstr);
}
// This function sets up our Janet interpreter, and fixes the null pointers
EMSCRIPTEN_KEEPALIVE
int main() {
janet_init(); // start the interpreter
JanetTable *core_env = janet_core_env(NULL); // get a core env
JanetTable *lookup = janet_env_lookup(core_env); // and get an env table
// load the janet image into memory
// note that the image is hardcoded here
size_t image_length;
unsigned char *image = read_file("ludus.jimage", &image_length);
// load the image into the Janet environment
Janet env = janet_unmarshal(image, image_length, 0, lookup, NULL);
if(!janet_checktype(env, JANET_TABLE)) {
janet_panicf("invalid image %q", env);
}
// fix the null pointers, as above
// note that the bound symbols are just the normal fn names
// no namespacing
janet_ludus = env_lookup_function(janet_unwrap_table(env), "ludus");
janet_gcroot(janet_wrap_function(janet_ludus));
}
// these bindings are exported into javascript
EMSCRIPTEN_BINDINGS(module) {
using namespace emscripten;
// these are the functions that will be available
function("ludus", &ludus, allow_raw_pointers());
// we also want a wrapper for our StringResult
// we won't access it directly, but emcc makes it nice
value_object<StringResult>("StringResult")
.field("value", &StringResult::value);
}

51563
build/janet.c Normal file

File diff suppressed because it is too large Load Diff

2277
build/janet.h Normal file

File diff suppressed because it is too large Load Diff

13
build/justfile Normal file
View File

@ -0,0 +1,13 @@
build:
# the complex emscripten invocation
# note we have the stack size set to 1024*1024 (1 MB)
emcc \
-o out.mjs \
janet.c driver.cpp \
--embed-file ludus.jimage \
-lembind \
-s "EXPORTED_FUNCTIONS=['_main']" \
-s EXPORT_ES6 \
-s ALLOW_MEMORY_GROWTH=1 \
-s STACK_SIZE=1048576 \
-s MODULARIZE

BIN
build/ludus.jimage Normal file

Binary file not shown.

370
build/ludus.mjs Normal file
View File

@ -0,0 +1,370 @@
import init from "./out.mjs"
const mod = await init()
let res = null
let code = null
export function run (source) {
code = source
const output = mod.ludus(source).value
res = JSON.parse(output)
return res
}
export function stdout () {
if (!res) return ""
return res.io.stdout.data
}
export function turtle_commands () {
if (!res) return []
return res.io.turtle.data
}
export function result () {
return res
}
const turtle_init = {
position: [0, 0],
heading: 0,
pendown: true,
pencolor: "white",
penwidth: 1,
visible: true
}
const colors = {
black: [0, 0, 0, 255],
silver: [192, 192, 192, 255],
gray: [128, 128, 128, 255],
white: [255, 255, 255, 255],
maroon: [128, 0, 0, 255],
red: [255, 0, 0, 255],
purple: [128, 0, 128, 255],
fuchsia: [255, 0, 255, 255],
green: [0, 128, 0, 255],
lime: [0, 255, 0, 255],
olive: [128, 128, 0, 255],
yellow: [255, 255, 0, 255],
navy: [0, 0, 128, 255],
blue: [0, 0, 255, 255],
teal: [0, 128, 128, 255],
aqua: [0, 255, 25, 255],
}
function resolve_color (color) {
if (typeof color === 'string') return colors[color]
if (typeof color === 'number') return [color, color, color, 255]
if (Array.isArray(color)) return color
return [0, 0, 0, 255] // default to black?
}
let background_color = "black"
function add (v1, v2) {
const [x1, y1] = v1
const [x2, y2] = v2
return [x1 + x2, y1 + y2]
}
function mult (vector, scalar) {
const [x, y] = vector
return [x * scalar, y * scalar]
}
function unit_of (heading) {
const turns = -heading + 0.25
const radians = turn_to_rad(turns)
return [Math.cos(radians), Math.sin(radians)]
}
function command_to_state (prev_state, curr_command) {
const verb = curr_command[0]
switch (verb) {
case "goto": {
const [_, x, y] = curr_command
return {...prev_state, position: [x, y]}
}
case "home": {
return {...prev_state, position: [0, 0], heading: 0}
}
case "right": {
const [_, angle] = curr_command
const {heading} = prev_state
return {...prev_state, heading: heading + angle}
}
case "left": {
const [_, angle] = curr_command
const {heading} = prev_state
return {...prev_state, heading: heading - angle}
}
case "forward": {
const [_, steps] = curr_command
const {heading, position} = prev_state
const unit = unit_of(heading)
const move = mult(unit, steps)
return {...prev_state, position: add(position, move)}
}
case "back": {
const [_, steps] = curr_command
const {heading, position} = prev_state
const unit = unit_of(heading)
const move = mult(unit, -steps)
return {...prev_state, position: add(position, move)}
}
case "penup": {
return {...prev_state, pendown: false}
}
case "pendown": {
return {...prev_state, pendown: true}
}
case "penwidth": {
const [_, width] = curr_command
return {...prev_state, penwidth: width}
}
case "pencolor": {
const [_, color] = curr_command
return {...prev_state, pencolor: color}
}
case "setheading": {
const [_, heading] = curr_command
return {...prev_state, heading: heading}
}
case "loadstate": {
// console.log("LOADSTATE: ", curr_command)
const [_, [x, y], heading, visible, pendown, penwidth, pencolor] = curr_command
return {position: [x, y], heading, visible, pendown, penwidth, pencolor}
}
case "show": {
return {...prev_state, visible: true}
}
case "hide": {
return {...prev_state, visible: false}
}
case "background": {
background_color = curr_command[1]
return prev_state
}
}
}
function eq_vect (v1, v2) {
const [x1, y1] = v1
const [x2, y2] = v2
return (x1 === x2) && (y1 === y2)
}
function eq_color (c1, c2) {
if (c1 === c2) return true
const res1 = resolve_color(c1)
const res2 = resolve_color(c2)
for (let i = 0; i < res1.length; ++i) {
if (res1[i] !== res2[i]) return false
}
return true
}
function states_to_call (prev, curr) {
const calls = []
// whose state should we use?
// pen states will only differ on more than one property
// if we use `loadstate`
// my sense is `prev`, but that may change
if (prev.pendown && !eq_vect(prev.position, curr.position)) {
calls.push(["line", prev.position[0], prev.position[1], curr.position[0], curr.position[1]])
}
if (!eq_color(curr.pencolor, prev.pencolor)) {
calls.push(["stroke", ...resolve_color(curr.pencolor)])
}
if (curr.penwidth !== prev.penwidth) {
calls.push(["strokeWeight", curr.penwidth])
}
return calls
}
const turtle_radius = 20
const turtle_angle = 0.385
const turtle_color = [255, 255, 255, 150]
const p5_call_root = [
["background", ...resolve_color(background_color)],
["push"],
["rotate", Math.PI],
["scale", -1, 1],
["stroke", ...resolve_color(turtle_init.pencolor)],
]
function rotate (vector, heading) {
const radians = turn_to_rad(heading)
const [x, y] = vector
return [
(x * Math.cos (radians)) - (y * Math.sin (radians)),
(x * Math.sin (radians)) + (y * Math.cos (radians))
]
}
function turn_to_rad (heading) {
return (heading % 1) * 2 * Math.PI
}
function turn_to_deg (heading) {
return (heading % 1) * 360
}
function svg_render_line (prev, curr) {
if (!prev.pendown) return ""
if (eq_vect(prev.position, curr.position)) return ""
const {position: [x1, y1], pencolor, penwidth} = prev
const {position: [x2, y2]} = curr
const [r, g, b, a] = resolve_color(pencolor)
return `
<line x1="${x1}" y1="${y1}" x2="${x2}" y2="${y2}" stroke="rgb(${r} ${g} ${b})" stroke-opacity="${a/255}" stroke-width="${penwidth}"/>
`
}
function escape_svg (svg) {
return svg
.replace(/&/g, "&amp;")
.replace(/</g, "&lt;")
.replace(/>/g, "&gt;")
.replace(/"/g, "&quot;")
.replace(/'/g, "&apos;")
}
export function extract_ludus (svg) {
const code = svg.split("<ludus>")[1]?.split("</ludus>")[0] ?? ""
return code
.replace(/&amp;/g, "&")
.replace(/&lt;/g, "<")
.replace(/&gt;/g, ">")
.replace(/&quot;/g, `"`)
.replace(/&apos;/g, `'`)
}
function svg_render_path (states) {
const path = []
for (let i = 1; i < states.length; ++i) {
const prev = states[i - 1]
const curr = states[i]
path.push(svg_render_line(prev, curr))
}
return path.join("")
}
function svg_render_turtle (state) {
if (!state.visible) return ""
const [fr, fg, fb, fa] = turtle_color
const fill_alpha = fa/255
const {heading, pencolor, position: [x, y], pendown, penwidth} = state
const origin = [0, turtle_radius]
const [x1, y1] = origin
const [x2, y2] = rotate(origin, turtle_angle)
const [x3, y3] = rotate(origin, -turtle_angle)
const [pr, pg, pb, pa] = resolve_color(pencolor)
const pen_alpha = pa/255
const ink = pendown ? `<line x1="${x1}" y1="${y1}" x2="0" y2="0" stroke="rgb(${pr} ${pg} ${pb})" stroke-opacity="${pen_alpha}" stroke-width="${penwidth}" />` : ""
return `
<g transform="translate(${x}, ${y})rotate(${-turn_to_deg(heading)})">
<polygon points="${x1} ${y1} ${x2} ${y2} ${x3} ${y3}" stroke="none" fill="rgb(${fr} ${fg} ${fb})" fill-opacity="${fill_alpha}"/>
${ink}
</g>
`
}
export function svg (commands) {
// console.log(commands)
const states = [turtle_init]
commands.reduce((prev_state, command) => {
const new_state = command_to_state(prev_state, command)
states.push(new_state)
return new_state
}, turtle_init)
// console.log(states)
const {maxX, maxY, minX, minY} = states.reduce((accum, {position: [x, y]}) => {
accum.maxX = Math.max(accum.maxX, x)
accum.maxY = Math.max(accum.maxY, y)
accum.minX = Math.min(accum.minX, x)
accum.minY = Math.min(accum.minY, y)
return accum
}, {maxX: 0, maxY: 0, minX: 0, minY: 0})
const [r, g, b, a] = resolve_color(background_color)
const view_width = (maxX - minX) * 1.2
const view_height = (maxY - minY) * 1.2
const margin = Math.max(view_width, view_height) * 0.1
const x1 = minX - margin
// don't actually need these:
// const y1 = minY - margin
// const x2 = maxX + margin
const y2 = maxY + margin
const path = svg_render_path(states)
const turtle = svg_render_turtle(states[states.length - 1])
return `<?xml version="1.0" standalone="no"?>
<svg version="1.1" xmlns="http://www.w3.org/2000/svg" style="background-color:rgb(${r} ${g} ${b}); background-opacity: ${a/255}" viewBox="${x1} ${-y2} ${view_width} ${view_height}">
<g transform="scale(-1, 1) rotate(180)">
${path}
${turtle}
</g>
<ludus>
${escape_svg(code)}
</ludus>
</svg>
`
}
function p5_render_turtle (state, calls) {
if (!state.visible) return
calls.push(["push"])
const [r, g, b, a] = turtle_color
calls.push(["fill", r, g, b, a])
const {heading, pencolor, position: [x, y], pendown, penwidth} = state
const origin = [0, turtle_radius]
const [x1, y1] = origin
const [x2, y2] = rotate(origin, turtle_angle)
const [x3, y3] = rotate(origin, -turtle_angle)
calls.push(["translate", x, y])
// need negative turtle rotation with the other p5 translations
calls.push(["rotate", -turn_to_rad(heading)])
calls.push(["noStroke"])
calls.push(["beginShape"])
calls.push(["vertex", x1, y1])
calls.push(["vertex", x2, y2])
calls.push(["vertex", x3, y3])
calls.push(["endShape"])
calls.push(["strokeWeight", penwidth])
calls.push(["stroke", ...resolve_color(pencolor)])
if (pendown) calls.push(["line", 0, 0, x1, y1])
calls.push(["pop"])
return calls
}
export function p5 (commands) {
const states = [turtle_init]
commands.reduce((prev_state, command) => {
const new_state = command_to_state(prev_state, command)
states.push(new_state)
return new_state
}, turtle_init)
// console.log(states)
const p5_calls = [...p5_call_root]
for (let i = 1; i < states.length; ++i) {
const prev = states[i - 1]
const curr = states[i]
const calls = states_to_call(prev, curr)
for (const call of calls) {
p5_calls.push(call)
}
}
p5_calls[0] = ["background", ...resolve_color(background_color)]
p5_render_turtle(states[states.length - 1], p5_calls)
p5_calls.push(["pop"])
return p5_calls
}

7170
build/out.mjs Normal file

File diff suppressed because it is too large Load Diff

BIN
build/out.wasm Executable file

Binary file not shown.

13
build/p5_test.mjs Normal file
View File

@ -0,0 +1,13 @@
import {run, p5} from "./ludus.mjs"
const code = `
print! ("Hello, world!")
pencolor! (colors :white)
fd! (50)
pw! (3)
`
const result = run(code)
console.log(result.io.stdout.data)
console.log(p5(result.io.turtle.data))

22
build/svg_test.mjs Normal file
View File

@ -0,0 +1,22 @@
import {run, svg, stdout} from "./ludus.mjs"
const code = `
let start = unbox (turtle_state)
fd! (100)
rt! (0.25)
fd! (100)
loadstate! (start)
& home! ()
rt! (0.25)
fd! (100)
lt! (0.25)
`
const result = run(code)
// console.log(stdout(result))
console.log(svg(result.io.turtle.data))

37
build/svg_test.svg Normal file
View File

@ -0,0 +1,37 @@
<?xml version="1.0" standalone="no"?>
<svg version="1.1" xmlns="http://www.w3.org/2000/svg" style="background-color:rgb(0 0 0); background-opacity: 1" viewBox="-12 -112 120 120">
<g transform="scale(-1, 1) rotate(180)">
<line x1="0" y1="0" x2="6.123233995736766e-15" y2="100" stroke="rgb(255 255 255)" stroke-opacity="1" stroke-width="1"/>
<line x1="6.123233995736766e-15" y1="100" x2="0" y2="0" stroke="rgb(255 255 255)" stroke-opacity="1" stroke-width="1"/>
<line x1="0" y1="0" x2="100" y2="0" stroke="rgb(255 255 255)" stroke-opacity="1" stroke-width="1"/>
<g transform="translate(100, 0)rotate(90)">
<polygon points="0 20 -13.226237306473037 -15.00222139260919 13.226237306473037 -15.00222139260919" stroke="none" fill="rgb(255 255 255)" fill-opacity="0.5882352941176471"/>
<line x1="0" y1="20" x2="0" y2="0" stroke="rgb(255 255 255)" stroke-opacity="1" stroke-width="1" />
</g>
</g>
<ludus>
let home = unbox (turtle_state)
fd! (100)
loadstate! (home)
rt! (0.25)
fd! (100)
do turtle_state &gt; unbox
</ludus>
</svg>

After

Width:  |  Height:  |  Size: 1.1 KiB

9
build/test.mjs Normal file
View File

@ -0,0 +1,9 @@
import {run} from "./ludus.mjs"
console.log(run(`
forward! (100)
right! (0.25)
print! ("foobar")
`))

View File

@ -1,17 +0,0 @@
{:deps
{org.clojure/clojurescript {:mvn/version "1.11.121"}
thheller/shadow-cljs {:mvn/version "2.26.0"}
babashka/fs {:mvn/version "0.4.19"}
}
:source-paths ["src/ludus"]
:aliases
{:main
{:exec-fn ludus.core/main!}
:repl
{:exec-fn clojure.core.server/start-server
:exec-args {:name "repl"
:port 5555
:accept clojure.core.server/repl
:server-daemon false}}}}

View File

@ -1,3 +0,0 @@
# Introduction to cludus
TODO: write [great documentation](http://jacobian.org/writing/what-to-write/)

1
foo.ld
View File

@ -1 +0,0 @@
:foo

View File

@ -1,7 +0,0 @@
#!/opt/homebrew/bin/fish
jenv shell graalvm64-19.0.2
lein uberjar
native-image --enable-preview --report-unsupported-elements-at-runtime --initialize-at-build-time -jar ./target/ludus-0.1.0-SNAPSHOT-standalone.jar -H:Name=./target/ludus

View File

@ -1,6 +1,31 @@
# start a repl # open a janet repl in a different os window
repl: repl:
clj -X:repl kitten @ launch --type=os-window --allow-remote-control --cwd=current --title=hx_repl:ludus --keep-focus
kitten @ send-text -m "title:hx_repl:ludus" "janet -s\n"
# restart the repl server
restart:
kitten @ send-text -m "title:hx_repl:ludus" "\04"
kitten @ send-text -m "title:hx_repl:ludus" "janet -s\n"
# send what's selected to the repl and evaluate it
eval:
sd "$" "\n" | sd "\n\n" "\n" | kitten @ send-text -m "title:hx_repl:ludus" --stdin
# get documentation for a symbol in janet/clojure
doc:
sd "$" "\n" | sd "\n\n" "\n" | xargs -I _ echo "(doc " _ ")" | kitten @ send-text -m "title:hx_repl:ludus" --stdin
# publish to npm (did you build things first?)
publish:
npm version patch
npm publish
# build the ludus jimage
build: build:
shadow-cljs release node rm -f build/out.mjs
rm -f build/out.wasm
rm -f build/ludus.jimage
janet -c src/ludus.janet build/ludus.jimage
cd build && just build
git commit -am "build"

View File

@ -1,6 +1,6 @@
# Ludus language reference # Ludus language reference
This is not intended for beginners, but to be a language overview for experienced users. That said, it may help beginners orient themselves in the language. This is not intended for beginners, but to be a language overview for experienced programmers. That said, it may help beginners orient themselves in the language.
## Comments ## Comments
Ludus's comment character is `&`. Anything after an ampersand on a line is ignored. There are no multiline comments. Ludus's comment character is `&`. Anything after an ampersand on a line is ignored. There are no multiline comments.
@ -9,15 +9,15 @@ Ludus's comment character is `&`. Anything after an ampersand on a line is ignor
Ludus has four types of atomic values. Ludus has four types of atomic values.
### `nil` ### `nil`
`nil` is Ludus's representation of nothing. In the grand Lisp tradition, Ludus can, and frequently does, use `nil`-punning. Its type is `:nil`. `nil` is Ludus's representation of nothing. In the grand Lisp tradition, Ludus can, and occasionally does, use `nil`-punning. Its type is `:nil`.
### Booleans ### Booleans
`true` and `false`. That said, in all conditional constructs, `nil` and `false` are "falsy," and everything else is "truthy." Their type is `:boolean`. `true` and `false`. That said, in all conditional constructs, `nil` and `false` are "falsy," and everything else is "truthy." Their type is `:boolean`.
### Numbers ### Numbers
Ludus has numbers. At current, they rely on underlying number types. When Ludus runs in the browser, numbers are Javascript 64-bit floats. When Ludus runs at the command line in JVM-based Clojure, Ludus numbers could be ints, floats, or ratios, depending. Numbers are more complicated than you think. Ludus has numbers, which are IEEE-754 64-bit floats. Numbers are more complicated than you think, probably.
Number literals in Ludus are either integers or decimal floating point numbers. Number literals in Ludus are either integers or decimal floating point numbers, e.g. `32.34`, `42`, `-0.23`. Underscores in numbers are ignored, and can be used to separate long numbers, e.g. `1_234_567_890`.
Numbers' type is `:number`. Numbers' type is `:number`.
@ -27,21 +27,42 @@ Ludus keywords begin with a colon and a letter, e.g. `:keyword`. Types are repre
Keywords must begin with an ASCII upper- or lower-case letter, and can then include any letter character, as well as `_`, `/`, `!`, `?`, and `*`. Keywords must begin with an ASCII upper- or lower-case letter, and can then include any letter character, as well as `_`, `/`, `!`, `?`, and `*`.
## Strings ## Strings
Ludus strings are dependent on the host platform. Given that Ludus either runs in Javascript or the JVM, strings are UTF-16 strings. Eventually, Ludus will use UTF-8 strings. Strings are much more complicated than you think. Strings are emphatically not a collection type. Ludus strings are UTF-8 strings, and only use double quotes. Strings may be multiline. For example, this is a string: `"foo"`. So is this:
```
"foo
bar baz"
```
Strings use backslashes for escapes, including `\n` for newline, `\t` for tab, `\"` for a double quote, and `\{` for an open curly brace (see below on interpolation).
Strings' type is `:string`. Strings' type is `:string`.
## Collections ### String interpolation
Ludus has a few different types of collections, in increasing order of complexity: tuples, lists, sets, dicts, and namespaces. Strings may also insert a string representation of any Ludus value that is bound to a name, by inserting that name in curly braces. To wit,
```
let foo = :foo
let bar = 42
let baz = [1, 2, 3]
"{foo} {bar} {baz}" &=> ":foo 42 1, 2, 3"
```
Interpolations may _not_ be arbitrary expressions: only bound names may be used in interpolations.
### Separators ## Collections
Ludus has a few different types of collections, in increasing order of complexity: tuples, lists, sets, dicts, and packages. All collections are immutable.
#### Separators
In all collection literals, members are written with a separator between them. On the same line, use a comma; or a newline will also separate elements. You may use as many separators as you wish at any point inside a collection or pattern. `(,,,,,,,3,,4,,,,,,)` and `(3, 4)` are the same value. In all collection literals, members are written with a separator between them. On the same line, use a comma; or a newline will also separate elements. You may use as many separators as you wish at any point inside a collection or pattern. `(,,,,,,,3,,4,,,,,,)` and `(3, 4)` are the same value.
#### Efficiency
At the current moment, Ludus collections are all copy-on-write; this means that Ludus is _not_ performant with large collections. Eventually, Ludus will have Clojure-style persistent, immutable collections.
### Tuples ### Tuples
Tuples are fully-immutable, ordered collections of any kinds of values, delimited by parentheses, e.g. `(1, :a, "foo")`. At current, they have no length limit (although they eventually will). Unlike in some languages, tuples can be empty or contain a single element: `()` and `(:foo)` are both just fine. Tuples largely cannot be manipulated functionally; they must be written as literals and unpacked using pattern matching. They can, however, be converted to lists, either through pattern matching or the `list` function. Their type is `:tuple`. Tuples are fully-immutable, ordered collections of any kinds of values, delimited by parentheses, e.g. `(1, :a, "foo")`. At current, they have no length limit (although they eventually will). Unlike in some languages, tuples can be empty or contain a single element: `()` and `(:foo)` are both just fine. Tuples largely cannot be manipulated functionally; they must be written as literals and unpacked using pattern matching. They can, however, be converted to lists, either through pattern matching or the `list` function. Their type is `:tuple`.
### Lists ### Lists
Lists are persistent and immutable ordered collections of any kinds of values, delimited by square braces, e.g. `[1, :a, "foo"]`. They are currently implemented using Clojure's persistent vectors. Their type is `:list`. Lists are persistent and immutable ordered collections of any kinds of values, delimited by square braces, e.g. `[1, :a, "foo"]`. Their type is `:list`.
Lists may be combined using splats, written with ellipses, e.g., `[...foo, ...bar]`. Lists may be combined using splats, written with ellipses, e.g., `[...foo, ...bar]`.
@ -51,13 +72,13 @@ Sets are persistent and immutable unordered collections of any kinds of values,
### Dictionaries, or dicts ### Dictionaries, or dicts
Dicts are persistent and immutable associative collections of any kinds of values. Dicts use keywords as keys (and cannot use any other kind of Ludus value as a key, not even strings), but can store any values. Dict literals are written as keyword-value pairs: `#{:a 1, :b false}`. Single words may be used as a shorthand for a key-value pair. Accessing a key that holds no value returns `nil`. Their type is `:dict`. Dicts are persistent and immutable associative collections of any kinds of values. Dicts use keywords as keys (and cannot use any other kind of Ludus value as a key, not even strings), but can store any values. Dict literals are written as keyword-value pairs: `#{:a 1, :b false}`. Single words may be used as a shorthand for a key-value pair. Accessing a key that holds no value returns `nil`. Their type is `:dict`.
### Namespaces ### Packages
Namespaces are immutable collections of bindings. They may only be described at the top level of a script. Accessing a key that has no value on a namepsace results in a panic. Their type is `:ns`. Packages are immutable collections of bindings. They may only be described at the top level of a script, and their names must begin with a capital letter. Accessing a key that has no value on a package results in a validation error. They may not be accessed using functions, but only direct keyword access. Their type is `:pkg`.
They are written with the form `ns`, then a word that will be bound as their name, and then an associative structure (pairs or word shorthands), delimited by `{}`, e.g.: They are written with the form `pkg`, then a package name, beginning with a capital letter, that will be bound as their name, and then an associative structure (pairs or word shorthands), delimited by `{}`, e.g.:
``` ```
ns foo { pkg Foo {
:bar "bar" :bar "bar"
:baz 42 :baz 42
quux quux
@ -65,28 +86,33 @@ ns foo {
``` ```
### Working with collections ### Working with collections
Ludus names are bound permanently and immutably. How do you add something to a list or a dict? How do you get things out of them? Ludus names are bound permanently and immutably. Collections are immutable. How do you add something to a list or a dict? How do you get things out of them?
Ludus provides functions that allow working with persistent collections. They're detailed in [the Prelude](/prelude.md). That said, all functions that modify collections take a collection and produce the modified collection _as a return value_, without changing the original collection. E.g., `append ([1, 2, 3], 4)` will produce `[1, 2, 3, 4]`. (For dicts, the equivalent is `assoc`.) Ludus provides functions that allow working with persistent collections. They're detailed in [the Prelude](prelude.md). That said, all functions that modify collections take a collection and produce the modified collection _as a return value_, without changing the original collection. E.g., `append ([1, 2, 3], 4)` will produce `[1, 2, 3, 4]`, but the original list is unchanged. (For dicts, the equivalent is `assoc`.)
## Expressions ## Expressions
Ludus is an expression-based language: all forms in the language are expressions and return values, except `panic!`. That said, not all expressions may be used everywhere. Ludus is an expression-based language: all forms in the language are expressions and return values, except `panic!`. That said, not all expressions may be used everywhere.
### Terminating expressions
Expressions in scripts and blocks are terminated by a newline or a semicolon. In compound forms, like, `if`, the terminator comes after the `else` expression.
In forms with multiple clauses surrounded by curly braces (i.e., function bodies, `match`, `when`, etc.), you may separate clauses with semicolons as well as newlines.
### Toplevel expressions ### Toplevel expressions
Some expressions may only be used in the "top level" of a script. Because they are the toplevel, they are assured to be statically knowable. These include: `ns`, `use`, `import`, and `test`. Some expressions may only be used in the "top level" of a script. Because they are the toplevel, they are assured to be statically knowable. These include: `pkg`, `ns`, `use`, `import`, and `test`. (NB: not all of these are yet implemented.)
### Non-binding expressions ### Non-binding expressions
Some forms may take any expression that does _not_ [bind a name](#Words-and-bindings), for example, any entry in a collection, or the right-hand side of a `let` binding. This is because binding a name in some positions is ambiguous, or nonsensical, or leads to unwarranted complications. Some forms may take any expression that does _not_ [bind a name](#words-and-bindings), for example, any entry in a collection, or the right-hand side of a `let` binding. This is because binding a name in some positions is ambiguous, or nonsensical, or leads to unwarranted complications.
### Simple expressions ### Simple expressions
Many complex forms will only accept "simple" expressions. Formally, simple expressions are either literal (atomic, string, or collection literals) or synthetic expressions. They are expressions which do not take sub-expressions: no `if`, `when`, `match`, etc. (`do` expressions are currently not simple, but that may be revised.) Many compound forms will only accept "simple" expressions. Formally, simple expressions are either literal (atomic, string, or collection literals) or synthetic expressions. They are expressions which do not take sub-expressions: no `if`, `when`, `match`, etc. (`do` expressions are currently not simple, but that may be revised.)
## Words and bindings ## Words and bindings
Ludus uses _words_ to bind values to names. Words must start with a lower case ASCII letter, and can subsequently include any letter character (modulo backing character encoding), as well as , `_`, `/`, `?`, `!`, and `*`. Ludus uses _words_ to bind values to names. Words must start with a lower case ASCII letter, and can subsequently include any letter character (modulo backing character encoding), as well as , `_`, `/`, `?`, `!`, and `*`.
Ludus binds values to names immutably and permanently: no name in the same scope may ever be re-bound to a different value. (Although see [refs](#references-and-state), below. Ludus binds values to names immutably and permanently: no name in the same scope may ever be re-bound to a different value. (Although see [boxes](#boxes-and-state), below.
Attempting to use an unbound name (a word that has not had a value bound to it) will result in a panic. Attempting to use an unbound name (a word that has not had a value bound to it) will result in a validation error, and the script will not run.
### `let` bindings: a very short introduction ### `let` bindings: a very short introduction
Ludus's basic binding form is `let`: Ludus's basic binding form is `let`:
@ -94,7 +120,7 @@ Ludus's basic binding form is `let`:
``` ```
let foo = :bar & `foo` is now bound to `bar` for the rest of the scope. let foo = :bar & `foo` is now bound to `bar` for the rest of the scope.
let foo = :baz & panic! let foo = :baz & Validation error: name foo was bound in line 1
``` ```
`let` bindings are more complex; we will return to these below. `let` bindings are more complex; we will return to these below.
@ -106,10 +132,10 @@ Ludus makes extensive use of pattern-matching. Patterns do two jobs at once: the
The simplest pattern is the placeholder: it matches against anything, and does not bind a name. It is written as a single underscore: `_`, e.g., `let _ = :foo`. The simplest pattern is the placeholder: it matches against anything, and does not bind a name. It is written as a single underscore: `_`, e.g., `let _ = :foo`.
#### Ignored names #### Ignored names
If you wish to be a bit more explict than using a placeholder, you can use an ignored name, which is a name that starts with an underscore: `_foo`. This is not bound, is not a valid name, and can be used however much you wish, even multiple times in the same pattern. It's a placeholder, plus a reader-facing description. If you wish to be a bit more explict than using a placeholder, you can use an ignored name, which is a name that starts with an underscore: `_foo`. This is not bound, is not a valid name, and can be used however much you wish, even multiple times in the same pattern. It is, in fact, a placeholder, plus a reader-facing description.
### Literal patterns ### Literal patterns
Patterns can be literal atomic values or strings: `0`, `false`, `nil`, `"foo"`, etc. That means you can write `let 0 = 0` or `let :foo = :foo`, and everything will be jsut fine. Patterns can be literal atomic values or strings: `0`, `false`, `nil`, `:foo`, etc. That means you can write `let 0 = 0` or `let :foo = :foo`, and, while nothing will happen, everything will be just fine.
Literals match against, well, literal values: if the pattern and the value are the same, they match! If not, they don't match. Literals match against, well, literal values: if the pattern and the value are the same, they match! If not, they don't match.
@ -121,6 +147,24 @@ Word patterns match against any value, and bind that value to the word as a name
#### Typed patterns #### Typed patterns
Word patterns can, optionally, take a type, using the `as` reserved word, and the keyword representing the desired type: `let foo as :number = 42`. Word patterns can, optionally, take a type, using the `as` reserved word, and the keyword representing the desired type: `let foo as :number = 42`.
### String patterns
Ludus has a simple but powerful form of string pattern matching that mirrors string interpolation. Any word inside curly braces in a string will match against a substring of a string passed into a pattern.
```
let i_am = "I am the walrus"
let "I {verb} the {noun}" = i_am
(verb, noun) &=> ("am", "walrus")
```
Note that such names may well be bound to empty strings: a match does not guarantee that there will be anything in the string. This is particularly relevant at the beginning and end of string patterns:
```
let we_are = "We are the eggmen"
let "{first}We {what}" = we_are
(first, what) &=> ("", "are the eggmen")
```
### Collection patterns ### Collection patterns
Tuples, lists, and dicts can be destructured using patterns. They are written nearly identically to their literal counterparts. Collection patterns are composed of any number of simpler patterns or other collection patterns. They bind any names nested in them, match literals in them, etc. Tuples, lists, and dicts can be destructured using patterns. They are written nearly identically to their literal counterparts. Collection patterns are composed of any number of simpler patterns or other collection patterns. They bind any names nested in them, match literals in them, etc.
@ -141,11 +185,15 @@ let () = () & empty tuples are also patterns
#### List patterns #### List patterns
List patterns are identical to tuple patterns, but they are written using square braces. They also match against a specific number of members, and may take a splat in the last position, e.g. `let [first, ...rest] = [1, 2, 3]`. List patterns are identical to tuple patterns, but they are written using square braces. They also match against a specific number of members, and may take a splat in the last position, e.g. `let [first, ...rest] = [1, 2, 3]`.
Note that list patterns, like tuple patterns, match on explicit length. That means that if you are matching only the first items of a list, you must explicitly include a splat pattern, e.g. `let [first, second, ...] = [1, 2, 3, 4]`.
#### Dict patterns #### Dict patterns
Dict patterns are written either with shorthand words, or keyword-pattern pairs. Consider: `let #{:a foo, :b 12, c} = #{:a 1, :b 12, :c 4}`. `foo` is now 1; `b` is now 12, `c` is now 4. If a dict does not hold a value at a particular key, there is no match. Dict patterns are written either with shorthand words, or keyword-pattern pairs. Consider: `let #{:a foo, :b 12, c} = #{:a 1, :b 12, :c 4}`. `foo` is now 1; `b` is now 12, `c` is now 4. If a dict does not hold a value at a particular key, there is no match.
Dict patterns may also use a splat as their last member: `let #{:a 1, ...b} = #{:a 1, :b 2, :c 3}` will bind `b` to `#{:b 2, :c 3}`. Dict patterns may also use a splat as their last member: `let #{:a 1, ...b} = #{:a 1, :b 2, :c 3}` will bind `b` to `#{:b 2, :c 3}`.
Like tuple and list patterns, dict patterns without a splat at the end match only on exact equivalence on all keys.
## `let` bindings ## `let` bindings
`let` bindings are the basic form of matching and binding in Ludus. It is written `let {pattern} = {non-binding expression}`. The pattern can be arbitrarily complex. If the left-hand side of a `let` binding does not match, Ludus will raise a panic, halting evaluation of the script. `let` bindings are the basic form of matching and binding in Ludus. It is written `let {pattern} = {non-binding expression}`. The pattern can be arbitrarily complex. If the left-hand side of a `let` binding does not match, Ludus will raise a panic, halting evaluation of the script.
@ -162,7 +210,7 @@ let first = {
add (outer, inner) add (outer, inner)
} & first is now bound to 65 } & first is now bound to 65
inner & panic! unbound name inner inner & Validation error: unbound name inner
``` ```
@ -182,37 +230,28 @@ let y = {
``` ```
## Conditional forms ## Conditional forms
Ludus has a robust set of conditionoal forms, all of which are expressions and resolve to a single value. Ludus has a robust set of conditional forms, all of which are expressions and resolve to a single value.
### `if` ### `if`
`if` evaluates a condition; if the result of the condition is truthy, it evaluates is `then` branch; if the condition is falsy, it evaluates its `else` branch. Both branches must always be present. Newlines may come before `then` and `else`. `if` evaluates a condition; if the result of the condition is truthy, it evaluates is `then` branch; if the condition is falsy, it evaluates its `else` branch. Both branches must always be present. Newlines may come before `then` and `else`.
`if {simple expression} then {non-binding expression} else {non-binding expression}` `if {simple expression} then {non-binding expression} else {non-binding expression}`
#### `if let`
There is one exception to the above: a single `let` form can be used as the condition. In that case, if the `let` binding is successful--the pattern matches--the `then` branch is evaluated with any resulting bindings. If the pattern does not match, in place of a panic, the `else` branch is evaluated. Note that if the right-hand value of the `let` expression is falsy, the `else` branch will also be evaluated.
```
if let (:ok, value) = might_fail ()
then do_something_with (value)
else recover
```
### `when` ### `when`
`when` is like Lisp's `cond`: it takes a series of clauses, separated by semicolons or newlines, delimited by curly braces. Clauses are written `lhs -> rhs`. `when` expressions are extremely useful for avoiding nested `if`s. `when` is like Lisp's `cond`: it takes a series of clauses, separated by semicolons or newlines, delimited by curly braces. Clauses are written `lhs -> rhs`. `when` expressions are extremely useful for avoiding nested `if`s.
The left hand of a clause is a simple expression; the right hand of a clause is any expression. When the left hand is truthy, the right hand is evaluated, and the result of that evaluation is returned; no further clauses are evaluated. If no clause has a truthy left-hand value, then a panic is raised. `else` and `_` are valid left-hand expressions, which are always truthy in this context. The left hand of a clause is a simple expression; the right hand of a clause is any expression. When the left hand is truthy, the right hand is evaluated, and the result of that evaluation is returned; no further clauses are evaluated. If no clause has a truthy left-hand value, then a panic is raised. In the example below, not the use of literal `true` as an always-matching clause.
``` ```
when { when {
maybe () -> :something maybe () -> :something
mabye_not () -> :something_else mabye_not () -> :something_else
else -> :always true -> :always
} }
``` ```
### `match` ### `match`
A `match` form is the most powerful conditional form in Ludus (for now). It consists of a test expression, and a series of clauses. The test expression must be a simple expression, followed by `with`, and then a series of clauses separated by a semicolon or newline, delimited by curly braces. A `match` form is the most powerful conditional form in Ludus. It consists of a test expression, and a series of clauses. The test expression must be a simple expression, followed by `with`, and then a series of clauses separated by a semicolon or newline, delimited by curly braces.
``` ```
match may_fail () with { match may_fail () with {
@ -223,9 +262,20 @@ match may_fail () with {
The left hand of a match clause is a pattern; the right hand is an expression: `pattern -> expression`. If the pattern matches the test expression of a clause, the expression is evaluated with any bindings from the pattern, and `match` form evaluates to the result of that expression. The left hand of a match clause is a pattern; the right hand is an expression: `pattern -> expression`. If the pattern matches the test expression of a clause, the expression is evaluated with any bindings from the pattern, and `match` form evaluates to the result of that expression.
If a test expression does not match against any clause's pattern, a panic is raised. As with `when` expressions, `_` and `else` always match. If a test expression does not match against any clause's pattern, a panic is raised.
Ludus does not attempt to do any exhaustiveness checking on match forms. Ludus does not attempt to do any exhaustiveness checking on match forms; match errors are always runtime errors.
#### Guards
`match` clauses may have a _guard expression_, which allows a clause only to match if the expression's result is truthy. In the previous example, consider that we might want different behaviour depending on the value of the number:
```
match may_fail () with {
(:ok, value) if pos? (value) -> calculate_positive_result (value)
(:ok, value) if neg? (value) -> calculate_negative_result (value)
(:ok, 0) -> do_something_with_zero ()
(:err, msg) -> { log! (msg); recover_somehow () }
}
```
## Functions ## Functions
Ludus is an emphatically functional language. Almost everything in Ludus is accomplished by applying functions to values, or calling functions with arguments. (These are precise synonyms.) Ludus is an emphatically functional language. Almost everything in Ludus is accomplished by applying functions to values, or calling functions with arguments. (These are precise synonyms.)
@ -247,7 +297,7 @@ A named function is identical to a lambda, with the one change that a word follo
#### Compound functions #### Compound functions
Compound functions are functions that have multiple clauses. They must be named, and in place of a single clause after a name, they consist in one or more clauses, separated by semicolons or newlines, delimited by curly braces. Optionally, compound functions may have a docstring as their first element after the opening curly brace. The docstring explains the function's purpose and use, before any of the function clauses. Compound functions are functions that have multiple clauses. They must be named, and in place of a single clause after a name, they consist in one or more clauses, separated by semicolons or newlines, delimited by curly braces. Optionally, compound functions may have a docstring as their first element after the opening curly brace. The docstring explains the function's purpose and use, before any of the function clauses.
An exampele from Ludus's Prelude: An example from Ludus's Prelude:
``` ```
fn some { fn some {
@ -258,10 +308,29 @@ fn some {
``` ```
### Closures ### Closures
Functions in Ludus are closures: function bodies have access not only to their specific scope, but any enclosing scope. Note that function bodies may have access to names bound after them in their scope, so long as the function is _called_ after any names it accesses are bound. Functions in Ludus are closures: function bodies have access not only to their specific scope, but any enclosing scope. That said, functions only have access to names bound _before_ they are defined; nothing is hoisted in Ludus.
### Mutual recursion and forward declaration
If you try the following, you'll get a validation error:
```
fn stupid_odd? {
(0) -> false
(x) -> supid_even? (dec (x)) & Validation error: unbound name stupid_even?
}
fn stupid_even? {
(0) -> true
(x) -> stupid_odd? (dec (x))
}
```
To allow for mutual recursion, Ludus allows forward declarations, which are written `fn name` without any clauses. In the example above, we would simply put `fn stupid_even?` before we define `stupid_odd?`.
If you declare a function without defining it, however, Ludus will raise a validation error.
### The Prelude ### The Prelude
The Prelude is a substantial set of functions that is available in any given Ludus script. (It is, itself, just a Ludus file that has special access to host functions.) Because of that, a large number of functions are always available. The prelude documentation is [here](/prelude.md). The Prelude is a substantial set of functions that is available in any given Ludus script. (It is, itself, just a Ludus file that has special access to host functions.) Because of that, a large number of functions are always available. The prelude documentation is [here](prelude.md).
### Partial application ### Partial application
Functions in Ludus can be partially applied by using a placeholder in the arguments. Partial application may only use a single placeholder (partially applied functions are always unary), but it can be anywhere in the arguments: `let add_1 = add(1, _)` or `let double = mult(_, 2)`. Functions in Ludus can be partially applied by using a placeholder in the arguments. Partial application may only use a single placeholder (partially applied functions are always unary), but it can be anywhere in the arguments: `let add_1 = add(1, _)` or `let double = mult(_, 2)`.
@ -274,11 +343,11 @@ Because of "partial application," Ludus has a concept of an "argument tuple" (wh
In place of nesting function calls inside other function calls, Ludus allows for a more streamlined version of function application: the `do` form or function pipeline. `do` is followed by an initial expression. `do` expressions use `>` as an operator: whatever is on the left hand side of the `>` is passed in as a single argument to whatever is on its right hand side. For example: In place of nesting function calls inside other function calls, Ludus allows for a more streamlined version of function application: the `do` form or function pipeline. `do` is followed by an initial expression. `do` expressions use `>` as an operator: whatever is on the left hand side of the `>` is passed in as a single argument to whatever is on its right hand side. For example:
``` ```
let silly_result = do 23 let silly_result = do 23 >
> mult (_, 2) > add (1, _) mult (_, 2) > add (1, _) >
> sub (_, 2) > div (_, 9) & silly_result is 5 sub (_, 2) > div (_, 9) & silly_result is 5
``` ```
Newlines may appear before any instance of `>` in a `do` expression. Newlines may appear after any instance of `>` in a `do` expression. That does, however, mean that you must be careful not to accidentally include any trailing `>`s.
### Called keywords ### Called keywords
Keywords may be called as functions, in which case they extract the value stored at that key in the value passed in: Keywords may be called as functions, in which case they extract the value stored at that key in the value passed in:
@ -290,8 +359,16 @@ let bar = :a (foo) & `bar` is now 1
Called keywords can be used in pipelines. Called keywords can be used in pipelines.
In addition, keywords may be called when they are bound to names:
```
let foo = #{:a 1, :b 2}
let bar = :a
bar (foo) & => 1
```
## Synthetic expressions ## Synthetic expressions
Synthetic expressions are valid combinations of words, keywords, and argument tuples which allow for calling functions and extracting values from associative collections. The root--first term--of a synthetic expression must be a word or a keyword; subsequent terms must be either argument tuples or keywords. Synthetic expressions are valid combinations of words, keywords, package names, and argument tuples which allow for calling functions and extracting values from associative collections. The root--first term--of a synthetic expression must be a word or a keyword; subsequent terms must be either argument tuples or keywords.
``` ```
let foo = #{:a 1, :b #{:c "bar" :d "baz"}} let foo = #{:a 1, :b #{:c "bar" :d "baz"}}
@ -303,7 +380,7 @@ let baz = :b (foo) :d & `baz` is now "baz"
``` ```
## Looping forms ## Looping forms
Ludus will have optimized tail calls--the most straightforward way to accomplish repeating behaviour is function recursion. There are two additional looping forms, `repeat` and `loop`. Ludus has optimized tail calls--the most straightforward way to accomplish repeating behaviour is function recursion. There are two additional looping forms, `repeat` and `loop`.
### `repeat` ### `repeat`
`repeat` is a help to learners, and is useful for executing side effects multiple times. It is written `repeat {number|word} { {exprs} }`. From turtle graphics: `repeat` is a help to learners, and is useful for executing side effects multiple times. It is written `repeat {number|word} { {exprs} }`. From turtle graphics:
@ -316,8 +393,8 @@ repeat 4 {
``` ```
Note that `repeat` does two interesting things: Note that `repeat` does two interesting things:
1. It never returns a value other than `nil`. If it's in the block, it disappears. 1. It never returns a value other than `nil`. If it's in the block, it disappears. This is a unique (and frankly, undesirable) property in Ludus.
2. Unlike everything else in Ludus, it requires a block. You cannot write `repeat 4 forward! (100)`. (But: watch this space.) 2. Unlike everything else in Ludus, repeate _requires_ a block, and not simply an expression. You cannot write `repeat 4 forward! (100)`.
### `loop`/`recur` ### `loop`/`recur`
`loop` and `recur` are largely identical to recursive functions for repetition, but use a special form to allow an anonymous construction and a few guard rails. `loop` and `recur` are largely identical to recursive functions for repetition, but use a special form to allow an anonymous construction and a few guard rails.
@ -332,7 +409,9 @@ loop (xs, 0) with {
} &=> 10 } &=> 10
``` ```
`recur` is the recursive call. It must be in tail position--`recur` must be the root of a synthetic expression, in return position. (At present, this is not checked. It will be statically verified, eventually.) `recur` is the recursive call. It must be in tail position--`recur` must be the root of a synthetic expression, in return position. If `recur` is not in tail position, a validation error will be raised.
In addition, `recur` calls must have the same number of arguments as the original tuple passed to `loop`. While Ludus will allow you to write clauses in `loop` forms with a different arity than the original tuple, those will never match.
`recur` calls return to the nearest `loop`. Nested `loop`s are probably a bad idea and should be avoided when possible. `recur` calls return to the nearest `loop`. Nested `loop`s are probably a bad idea and should be avoided when possible.
@ -342,14 +421,18 @@ The "toplevel" of a script are the expressions that are not embedded in other ex
### `import` ### `import`
`import` allows for the evaluation of other Ludus scripts: `import "path/to/file" as name`. `import` just evaluates that file, and then binds a name to the result of evaluating that script. This, right now, is quite basic: circular imports are currently allowed but will lead to endless recursion; results are not cached, so each `import` in a chain re-evaluates the file; and so on. `import` allows for the evaluation of other Ludus scripts: `import "path/to/file" as name`. `import` just evaluates that file, and then binds a name to the result of evaluating that script. This, right now, is quite basic: circular imports are currently allowed but will lead to endless recursion; results are not cached, so each `import` in a chain re-evaluates the file; and so on.
Status: not yet implemented.
### `use` ### `use`
`use` loads the contents of a namespace into a script's context. To ensure that this is statically checkable, this must be at the toplevel. `use` loads the contents of a namespace into a script's context. To ensure that this is statically checkable, this must be at the toplevel.
### `ns` Status: not yet implemented.
Namespaces, `ns`es, may only be described at the toplevel of a script. This is to ensure they can be statically evaluatable.
### `pkg`
Packages, `pkg`es, may only be described at the toplevel of a script. This is to ensure they can be statically evaluatable.
### `test` ### `test`
A `test` expression (currently not working!--it will blow up your script, although it parses properly) is a way of ensuring things behave the way you want them to. Run the script in test mode (how?--that doesn't exist yet), and these are evaluated. If the expression under `test` returns a truthy value, you're all good! If the expression under `test` returns a falsy value or raises a panic, then Ludus will report which test(s) failed. A `test` expression is a way of ensuring things behave the way you want them to. Run the script in test mode, and these are evaluated. If the expression under `test` returns a truthy value, you're all good! If the expression under `test` returns a falsy value or raises a panic, then Ludus will report which test(s) failed.
``` ```
test "something goes right" eq? (:foo, :foo) test "something goes right" eq? (:foo, :foo)
@ -365,47 +448,66 @@ test "something goes wrong" {
Formally: `test <string> <expression>`. Formally: `test <string> <expression>`.
## Changing things: `ref`s Status: not yet implemented.
Ludus does not let you re-bind names. It does, however, have a type that allows for changing values over time: `ref` (short for reference--they are references to values). `ref`s are straightforward, but do require a bit more overhead than `let` bindings. The idea is that Ludus makes it obvious where mutable state is in a program, as well as where that mutable state may change. It does so elegantly, but with some guardrails that may take a little getting used to.
The type of a `ref` is, predictably, `:ref`. ## Changing things: `box`es
Ludus does not let you re-bind names. It does, however, have a type that allows for changing values over time: `box`. A box is a place to put things, it has its own identity, it can store whatever you put in it, but to get what's in it, you have to `unbox` it.
Syntactically and semantically, `box`es are straightforward, but do require a bit more overhead than `let` bindings. The idea is that Ludus makes it obvious where mutable state is in a program, as well as where that mutable state may change. It does so elegantly, but with some guardrails that may take a little getting used to.
The type of a `box` is, predictably, `:box`.
``` ```
ref foo = 42 & foo is now bound to a _ref that contains 42_ box foo = 42 & foo is now bound to a _box that contains 42_
add (1, foo) & panic! no match: foo is _not_ a number add (1, foo) & panic! no match: foo is _not_ a number
make! (foo, 23) & foo is now a ref containing 23 store! (foo, 23) & foo is now a box containing 23
update! (foo, inc) & foo is now a ref containing 24 update! (foo, inc) & foo is now a ref containing 24
value_of (foo) &=> 23; use value_of to get the value contained in a ref unbox (foo) &=> 23; use unbox to get the value contained in a box
``` ```
### Ending with a bang! ### Ending with a bang!
Ludus has a strong naming convention that functions that change state or could cause an explicit panic end in an exclamation point (or, in computer nerd parlance, a "bang"). So anything function that mutates the value held in a reference ends with a bang: `make!` and `update!` take bangs; `value_of` does not. Ludus has a strong naming convention that functions that change state or could cause an explicit panic end in an exclamation point (or, in computer nerd parlance, a "bang"). So anything function that mutates the value held in a reference ends with a bang: `store!` and `update!` take bangs; `unbox` does not.
This convention also includes anything that prints to the console: `print!`, `report!`, `doc!`, `update!`, `make!`, etc. This convention also includes anything that prints to the console: `print!`, `report!`, `doc!`, `update!`, `store!`, etc.
(Note that there are a few counter-examples to this: math functions that could cause a panic [in place of returning NaN] do not end with bangs: `div`, `inv`, and `mod`; each of these has variants that allow for more graceful error handling).
### Ending with a whimper? ### Ending with a whimper?
Relatedly, just about any function that returns a boolean value is a predicate function--and has a name that ends with a question mark: `eq?` tests for equality; `ref?` tells you if something is a ref or not; `lte?` is less-than-or-equal. Relatedly, just about any function that returns a boolean value is a predicate function--and has a name that ends with a question mark: `eq?` tests for equality; `box?` tells you if something is a ref or not; `lte?` is less-than-or-equal.
## Errors: panic! in the Ludus script ## Errors: panic! in the Ludus script
A special function, `panic!`, halts script execution with any arguments output as error messages. Panics also happen in the following cases: A special form, `panic!`, halts script execution with the expression that follows as an error message.
* a `let` binding has no match against the value of its expression
```
panic! :oops
if true then :ok else panic! "It's false!"
```
Panics also happen in the following cases:
* a `let` binding pattern has no match against the value of its expression
* a `match` or `when` form has no matching clause * a `match` or `when` form has no matching clause
* a function is called with arguments that do not match any of its clauses * a function is called with arguments that do not match any of its clauses
* something that is not a function or keyword is called as a function * something that is not a function or keyword is called as a function
* `div` divides by zero * a called keyword is partially applied
* `div`, `inv`, or `mod` divides by zero
* `sqrt` takes the square root of a negative number
* certain error handling functions, like `unwrap!` or `assert!`, are invoked on values that cause them to panic * certain error handling functions, like `unwrap!` or `assert!`, are invoked on values that cause them to panic
In fact, the only functions in the Prelude which can cause panics are, at current, `div`, `unwrap!`, and `assert!`. And, of course, `panic!` itself. In fact, the only functions in the Prelude which explicitly cause panics are, at current, `div`, `inv`, `mod`, `sqrt`, `unwrap!`, and `assert!`.
### `nil`s, not errors ### `nil`s, not errors
Ludus, however, tries to return `nil` instead of panicking a lot of the time. So, for example, attempting to get access a value at a keyword off a number, while nonsensical, will return `nil` rather than panicking: Ludus, however, tries to return `nil` instead of panicking where it seems prudent. So, for example, attempting to get access a value at a keyword off a number or `nil`, while nonsensical, will return `nil` rather than panicking:
``` ```
let a = true let a = true
a :b :c :d :e &=> nil a :b :c :d :e &=> nil
let b = [1, 2, 3]
at (b, 12) &=> nil
``` ```
### Result tuples ### Result tuples
Operations that could fail--especially when you want some information about why--don't always return `nil` on failures. Instead of exceptions or special error values, recoverable errors in Ludus are handled instead by result tuples: `(:ok, value)` and `(:err, msg)`. So, for example, `unwrap!` takes a result tuple and either returns the value in the `:ok` case, or panics in the `:err` case. Operations that could fail--especially when you want some information about why--don't always return `nil` on failures. Instead of exceptions or special error values, recoverable errors in Ludus are handled instead by result tuples: `(:ok, value)` and `(:err, msg)`. So, for example, `unwrap!` takes a result tuple and either returns the value in the `:ok` case, or panics in the `:err` case.
Variants of some functions that may have undesirably inexplicit behaviour are written as `{name}/safe`. So, for example, you can get a variant of `div` that returns a result tuple in `div/safe`, which returns `(:ok, result)` when everything's good; and `(:err, "division by zero")` when the divisor is 0. Or, `get/safe` will give you a result rather than returning `nil`. (Althougn `nil` punning makes this mostly unncessary. Mostly.) Variants of some functions that may have undesirably inexplicit behaviour are written as `{name}/safe`. So, for example, you can get a variant of `div` that returns a result tuple in `div/safe`, which returns `(:ok, result)` when everything's good; and `(:err, "division by zero")` when the divisor is 0.

View File

@ -1,19 +0,0 @@
{
"folders":
[
{
"path": "."
}
],
"settings": {
"on_post_save_project": [
{
"command": "exec",
"args": {
"shell_cmd": "lein cljfmt fix"
},
"scope": "window"
}
]
}
}

4100
package-lock.json generated

File diff suppressed because it is too large Load Diff

View File

@ -1,14 +1,17 @@
{ {
"name": "@ludus/ludus-js-pure", "name": "@ludus/ludus-js-pure",
"version": "0.1.0-alpha.7.7", "version": "0.1.36",
"description": "A Ludus interpreter in a pure JS function.", "description": "A Ludus interpreter in a pure JS function.",
"main": "target/js/ludus.js", "type": "module",
"main": "build/ludus.mjs",
"directories": {}, "directories": {},
"keywords": [], "keywords": [],
"author": "Scott Richmond", "author": "Scott Richmond",
"license": "GPL-3.0", "license": "GPL-3.0",
"devDependencies": { "files": [
"shadow-cljs": "^2.26.0" "build/out.wasm",
}, "build/out.mjs",
"dependencies": {} "build/ludus.mjs"
],
"devDependencies": {}
} }

7
postlude.ld Normal file
View File

@ -0,0 +1,7 @@
& this file runs after any given interpretation
& even if the original interpretation panics
& the goal is to output any global state held in Ludus
& this does not have base loaded into it, only prelude: must be pure Ludus
store! (turtle_state, turtle_init)
store! (turtle_commands, [])

File diff suppressed because it is too large Load Diff

File diff suppressed because one or more lines are too long

View File

@ -1,14 +0,0 @@
(defproject ludus "0.1.0-SNAPSHOT"
:description "FIXME: write description"
:url "http://ludus.dev"
:license {:name "EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0"
:url "https://www.eclipse.org/legal/epl-2.0/"}
:dependencies [[org.clojure/clojure "1.11.1"]
[babashka/fs "0.4.19"]
]
:plugins [[lein-cljfmt "0.8.0"]]
:repl-options {:init-ns ludus.core}
:main ludus.core
:profiles {:uberjar {:aot :all}}
:jvm-opts ["--enable-preview"]
)

View File

@ -1,111 +1,285 @@
fn fib { let input = "I remember my mother"
"Tells you a fib number."
(0) -> 0 print! ("DOCTOR")
(1) -> 1
(n) -> add ( print! ("> ", input)
fib (dec (n))
fib (sub (n, 2)) let sanitized = do input > trim > downcase
)
& ensuring we have spaces at the beginning and end
& this lets us match patterns as written below
let padded = join ([" ", sanitized, " "])
fn switch_persons {
("i") -> "you"
("you") -> "i"
("am") -> "are"
("me") -> "you"
("my") -> "your"
(x) -> x
} }
fn unwrap { fn repersonalize (x) -> do x >
((:some, value)) -> value trim >
((:ok, value)) -> value split (_, " ") >
map (switch_persons, _) >
join (_, " ")
fn one_of {
(str as :string) -> str
(strs as :list) -> random (strs)
} }
fn default (default_value) -> fn (maybe) -> when maybe is { let output = match padded with {
(:ok, value) -> value "{x} hello {y}" -> "How do you do. Please state your problem"
(:err, _) -> default_value "{x} hi {y}" -> "How do you do. Please state your problem"
nil -> default_value "{x} computer {y}" -> [
value -> value "Do computers worry you"
"What do you think about machines"
"Why do you mention computers"
"What do you think machines have to do with your problem"
]
"{x} name {y}" -> "I am not interested in names"
"{x} sorry {y}" -> [
"Please don't apologize"
"Apologies are not necessary"
"What feelings do you have when you apologize"
]
"{x} i remember {y}" -> {
let switched = repersonalize (y)
[
"Do you often think of {switched}"
"Does thinking of {switched} bring anything else to mind"
"What else do you remember"
"Why do you recall {switched} right now"
"What in the present situation reminds you of {switched}"
"What is the connection between me and {switched}"
]
}
"{x} do you remember {y}" -> {
let switched = repersonalize (y)
[
"Did you think I would forget {switched}"
"Why do you think I should recall {switched} now"
"What about {switched}"
"You mentioned {switched}"
]
}
"{x} if {y}" -> {
let switched = repersonalize (y)
[
"Do you reall think that its likely that {switched}"
"Do you wish that {switched}"
"What do you think about {switched}"
"Really--if {switched}"
]
}
"{x} i dreamt {y}" -> {
let switched = repersonalize (y)
[
"Really--{y}"
"Have you ever fantasized {y} while you were awake"
"Have you dreamt {y} before"
]
}
"{x} dream about {y}" -> {
let switched = repersonalize (y)
"How do you feel about {switched} in reality"
}
"{x} dream {y}" -> [
"What does this dream suggest to you"
"Do you dream often"
"What persons appear in your dreams"
"Don't you believe that dream has to do with your problem"
]
"{x} my mother {y}" -> {
let switched = repersonalize (y)
[
"Who else in your family {y}"
"Tell me more about your family"
]
}
"{x} my father {y}" -> [
"Your father"
"Does he influence you strongly"
"What else comes to mind when you think of your father"
]
"{x} i want {y}" -> {
let switched = repersonalize (y)
[
"What would it mean if you got {y}"
"Why do you want {y}"
"Suppose you got {y} soon"
]
}
"{x} i am glad {y}" -> {
let switched = repersonalize (y)
[
"How have I helped you to be {y}"
"What makes you happy just now"
"Can you explain why you are suddenly {y}"
]
}
"{x} i am sad {y}" -> {
let switched = repersonalize (y)
[
"I am sorry to hear you are depressed"
"I'm sure it's not pleasant to be sad"
]
}
"{x} are like {y}" -> {
let switched_x = repersonalize (x)
let switched_y = repersonalize (y)
"What resemblance to you see between {switched_x} and {switched_y}"
}
"{x} is like {y}" -> {
let switched_x = repersonalize (x)
let switched_y = repersonalize (y)
[
"In what way is it that {switched_x} is like {switched_y}"
"What resemblance do you see"
"Could there really be some connection"
"How"
]
}
"{x} alike {y}" -> [
"In what way"
"What similarities are there"
]
"{x} same {y}" -> "What other connections do you see"
"{x} i was {y}" -> {
let switched = repersonalize (y)
[
"Were you really"
"Perhaps I already knew you were {switched}"
"Why do you tell me you were {switched} now"
]
}
"{x} was i {y}" -> {
let switched = repersonalize (y)
[
"What if you were {switched}"
"Do you think you were {switched}"
"What wouuld it mean if you were {switched}"
]
}
"{x} i am {y}" -> {
let switched = repersonalize (y)
[
"In what way are you {switched}"
"Do you want to be {switched}"
]
}
"{x} am i {y}" -> {
let switched = repersonalize (y)
[
"Do you believe you are {switched}"
"Would you want to be {switched}"
"You wish I would tell you you are {switched}"
"What would it mean if you were {switched}"
]
}
"{x} am {y}" -> [
"Why do you say *AM*"
"I don't understand that"
]
"{x} are you {y}" -> {
let switched = repersonalize (y)
[
"Why are you interested in whether I am {switched} or not"
"Would you prefer if I weren't {switched}"
"Perhaps I am {switched} in your fantasies"
]
}
"{x} you are {y}" -> {
let switched = repersonalize (y)
"What makes you think I am {y}"
}
"{x} because {y}" -> [
"Is that the real reason"
"What other reasons might there be"
"Does that reason seem to explain anything else"
]
"{x} were you {y}" -> {
let switched = repersonalize (y)
[
"Perhaps I was {switched}"
"What od you think"
"What if I had been {switched}"
]
}
"{x} i can't {y}" -> {
let switched = repersonalize (y)
[
"Maybe you could {switched} now"
"What if you could {switched}"
]
}
"{x} i feel {y}" -> {
let switched = repersonalize (y)
"Do you often feel {switched}"
}
"{x} i felt {y}" -> "What other feelings do you have"
"{x} i {y} you {z}" -> {
let switched = repersonalize (y)
"Perhaps in your fantasy we {switched} each other"
}
"{x} why don't you {y}" -> {
let switched = repersonalize (y)
[
"Should you {y} yourself"
"Do you believe I don't {y}"
"Perhaps I will {y} in good time"
]
}
"{x} yes {y}" -> [
"You seem quite positive"
"You are sure"
"I understand"
]
"{x} no {y}" -> [
"Why not"
"You are being a bit negative"
"Are you saying *NO* just to be negative"
]
"{x} someone {y}" -> "Can you be more specific"
"{x} everyone {y}" -> [
"Surely not everyone"
"Can you think of anyone in particular"
"Who for example"
"You are thinking of a special person"
]
"{x} always {y}" -> [
"Can you think of a specific example"
"When"
"What incident are you thinking of"
"Really--always"
]
"{x} what {y}" -> [
"Why do you ask"
"Does that question interest you"
"What is it you really want to know"
"What do you think"
"What comes to your mind when you ask that"
]
"{x} perhaps {y}" -> "You do not seem quite certain"
"{x} are {y}" -> {
let switched = repersonalize (y)
[
"Did you think they might not be {switched}"
"Possibly they are {switched}"
]
}
_ -> [
"Very interesting"
"I am not sure I understand you fully"
"What does that suggest to you"
"Please continue"
"Go on"
"Do you feel strongly about discussing such things"
]
} }
fn some (value) -> (:some, value) print! (">>> ", do output > one_of > upcase)
fn ok (value) -> (:ok, value)
let foo = unwrap ((:ok, 42))
print (:foo, foo)
let bar = unwrap ((:some, 23))
print (:bar, bar)
let baz = do 69 > default (12) > print (:baz, _)
let quux = do nil > default (12) > print (:quux, _)
& unwrap ((:err, "message"))
fn map {
(f) -> fn mapper (xs) -> map (f, xs)
(f, xs) -> {
let n = count (xs)
loop (0, []) with (i, ys) -> if eq (i, n)
then ys
else recur (
inc (i)
conj (ys, f (nth (i, xs))))
}
}
fn reduce {
(f) -> fn reducer {
(xs) -> reduce (f, xs)
(xs, init) -> reduce (f, xs, init)
}
(f, xs) -> {
let first_x = first (xs)
let more_xs = rest (xs)
reduce (f, more_xs, first_x)
}
(f, xs, init) -> {
let n = count (xs)
loop (0, init) with (i, acc) -> if eq (i, n)
then acc
else {
let curr = nth (i, xs)
let next = f (acc, curr)
recur (inc (i), next)
}
}
}
fn filter {
(f) -> fn filterer (xs) -> filter (f, xs)
(f, xs) -> {
let n = count (xs)
loop (0, []) with (i, ys) -> when {
eq (i, n) -> ys
f (nth (i, xs)) -> recur (inc (i), conj (ys, nth (i, xs)))
else -> recur (inc (i), ys)
}
}
}
& fn shuffle
ref x = 4
set! (x, "foo")
set! (x, :foo)
deref (x)
let greater_than_two? = gt (_, 2)
fn square (x) -> mult (x, x)
let xs = [1, 2, 3]
let ys = #{:a 1, :b 2}
ys :a
:a (ys)
let y = 1
do y > inc > square > sub (_, 3)

View File

@ -1,14 +0,0 @@
;; shadow-cljs configuration
{:deps true
:dev-http {8234 "target"}
:builds
{:node {:target :node-library
:output-to "target/js/ludus.js"
:exports {:run ludus.node/run}
:modules {:main {:entries [ludus.node]}}}
:browser {:target :browser
:output-dir "target/js"
:asset-path "target"
:modules {:main {:init-fn ludus.web/init}}}}}

337
src/base.janet Normal file
View File

@ -0,0 +1,337 @@
# A base library for Ludus
# Only loaded in the prelude
(import /src/scanner :as s)
(defn bool [x] (if (= :^nil x) nil x))
(defn ludus/and [& args] (every? (map bool args)))
(defn ludus/or [& args] (some bool args))
(defn ludus/type [value]
(when (= :^nil value) (break :nil))
(def typed? (when (dictionary? value) (value :^type)))
(def the-type (if typed? typed? (type value)))
(case the-type
:buffer :string
:boolean :bool
:array :list
:table :dict
:cfunction :function
the-type))
(var stringify nil)
(defn- dict-str [dict]
(string/join
(map
(fn [[k v]] (string (stringify k) " " (stringify v)))
(pairs dict))
", "))
(defn- stringish? [x] (or (string? x) (buffer? x)))
(defn- stringify* [value]
(when (stringish? value) (break value))
(def type (ludus/type value))
(case type
:nil ""
:number (string value)
:bool (string value)
:keyword (string ":" value)
:tuple
(string/join (map stringify value) ", ")
:list
(string/join (map stringify value) ", ")
:dict (dict-str value)
:set
(string/join (map stringify (keys value)) ", ")
:box (stringify (value :^value))
:fn (string "fn " (value :name))
:function (string "builtin " (string value))
:pkg (dict-str value)
))
(set stringify stringify*)
(var show nil)
(defn- show-pkg [x]
(def tab (struct/to-table x))
(set (tab :^name) nil)
(set (tab :^type) nil)
(string "pkg " (x :^name) " {" (stringify tab) "}")
)
(defn- dict-show [dict]
(string/join
(map
(fn [[k v]] (string (show k) " " (show v)))
(pairs dict))
", "))
(defn- set-show [sett]
(def prepped (merge sett))
(set (prepped :^type) nil)
(def shown (map show (keys prepped)))
(string/join shown ", ")
)
(defn- show* [x]
(case (ludus/type x)
:nil "nil"
:string (string "\"" x "\"")
:tuple (string "(" (string/join (map show x) ", ") ")")
:list (string "[" (string/join (map show x) ", ") "]")
:dict (string "#{" (dict-show x) "}")
:set (string "${" (set-show x) "}")
:box (string "box " (x :name) " [ " (show (x :^value)) " ]")
:pkg (show-pkg x)
(stringify x)))
(set show show*)
# (var json nil)
# (defn- dict-json [dict]
# (string/join
# (map
# (fn [[k v]] (string (json k) ": " (json v)))
# (pairs dict))
# ", "))
# (defn- json* [x]
# (case (ludus/type x)
# :nil "\"null\""
# :number (string x)
# :bool (if true "\"true\"" "\"false\"")
# :string (string "\"" x "\"")
# :keyword (string "\"" x "\"")
# :tuple (string "[" (string/join (map json x) ", ") "]")
# :list (string "[" (string/join (map json x) ", ")"]")
# :dict (string "{" (dict-json x) "}")
# :set (string "[" (string/join (map json (keys x)) ", ") "]")
# (show x)))
# (set json json*)
(defn show-patt [x]
(case (x :type)
:nil "nil"
:bool (string (x :data))
:number (string (x :data))
:keyword (string ":" (x :data))
:word (x :data)
:placeholder (get-in x [:token :lexeme])
:tuple (string "(" (string/join (map show-patt (x :data)) ", ") ")")
:list (string "[" (string/join (map show-patt (x :data)) ", ")"]")
:dict (string "#{" (string/join (map show-patt (x :data)) ", ") "}")
:pair (string (show-patt (get-in x [:data 0])) " " (show-patt (get-in x [:data 1])))
:typed (string (show-patt (get-in x [:data 1])) " as " (show-patt (get-in x [:data 0])))
:interpolated (get-in x [:token :lexeme])
:string (get-in x [:token :lexeme])
:splat (string "..." (when (x :data) (show-patt (x :data))))
(error (string "cannot show pattern of unknown type " (x :type)))))
(defn pretty-patterns [fnn]
(def {:body clauses} fnn)
(string/join (map (fn [x] (-> x first show-patt)) clauses) "\n"))
(defn doc [fnn]
(when (not= :fn (ludus/type fnn)) (break "No documentation available."))
(def {:name name :doc docstring} fnn)
(string/join [name
(pretty-patterns fnn)
(if docstring docstring "No docstring available.")]
"\n"))
(defn- conj!-set [sett value]
(set (sett value) true)
sett)
(defn- conj-set [sett value]
(def new (merge sett))
(conj!-set new value))
(defn- conj!-list [list value]
(array/push list value))
(defn- conj-list [list value]
(def new (array/slice list))
(conj!-list new value))
(defn conj! [x value]
(case (ludus/type x)
:list (conj!-list x value)
:set (conj!-set x value)))
(defn conj [x value]
(case (ludus/type x)
:list (conj-list x value)
:set (conj-set x value)
(error (string "cannot conj onto " (show x)))))
(defn disj! [sett value]
(set (sett value) nil)
sett)
(defn disj [sett value]
(def new (merge sett))
(set (new value) nil)
new)
(defn assoc! [dict key value]
(set (dict key) value)
dict)
(defn assoc [dict key value]
(merge dict {key value}))
(defn dissoc! [dict key]
(set (dict key) nil)
dict)
(defn dissoc [dict key]
(def new (merge dict))
(set (new key) nil)
new)
(defn ludus/get [key dict &opt def]
(default def :^nil)
(get dict key def))
(defn rest [indexed]
(array/slice indexed 1))
(defn to_list [x]
(case (ludus/type x)
:list x
:tuple @[;x]
:dict (pairs x)
:set (-> x (dissoc :^type) keys)
@[x]))
(defn showprint [x]
(if (= :string (ludus/type x))
x
(show x)))
(defn print! [args]
(print ;(map showprint args)))
(defn prn [x]
(pp x)
x)
(defn concat [x y & zs]
(case (ludus/type x)
:string (string x y ;zs)
:list (array/concat @[] x y ;zs)
:set (merge x y ;zs)))
(defn unbox [b] (get b :^value))
(defn store! [b x] (set (b :^value) x))
(defn mod [x y]
(% x y))
(defn- byte->ascii [c i]
(if (< c 128)
(string/from-bytes c)
(error (string "non-ASCII character at index" i))))
(defn chars [str]
(def out @[])
(try
(for i 0 (length str)
(array/push out (byte->ascii (str i) i)))
([e] (break [:err e])))
[:ok out])
(defn to_number [str]
(when (string/find "&" str)
(break [:err (string "Could not parse `" str "` as a number")]))
(def scanned (s/scan (string/trim str)))
(when (< 0 (length (scanned :errors)))
(break [:err (string "Could not parse `" str "` as a number")]))
(def tokens (scanned :tokens))
(when (< 3 (length tokens))
(break [:err (string "Could not parse `" str "` as a number")]))
(def fst (first tokens))
(when (not= :number (fst :type))
(break [:err (string "Could not parse `" str "` as a number")]))
[:ok (fst :literal)])
(def ctx {
"add" +
"and" ludus/and
"assoc!" assoc!
"assoc" assoc
"atan_2" math/atan2
"bool" bool
"ceil" math/ceil
"chars" chars
"concat" concat
"conj!" conj!
"conj" conj
"cos" math/cos
"count" length
"dec" dec
"disj!" disj!
"disj" disj
"dissoc!" dissoc!
"dissoc" dissoc
"div" /
"doc" doc
"downcase" string/ascii-lower
"eq?" deep=
"first" first
"floor" math/floor
"get" ludus/get
"gt" >
"gte" >=
"inc" inc
"last" last
"lt" <
"lte" <=
"mod" mod
"mult" *
"not" not
"nth" ludus/get
"or" ludus/or
"pi" math/pi
"print!" print!
"prn" prn
"push" array/push
"random" math/random
"range" range
"rest" rest
"round" math/round
"show" show
"sin" math/sin
"slice" array/slice
"split" string/split
"sqrt" math/sqrt
"store!" store!
"str_slice" string/slice
"stringify" stringify
"sub" -
"tan" math/tan
"to_list" to_list
"to_number" to_number
"trim" string/trim
"triml" string/triml
"trimr" string/trimr
"type" ludus/type
"unbox" unbox
"upcase" string/ascii-upper
})
(def base (let [b @{:^type :dict}]
(each [k v] (pairs ctx)
(set (b (keyword k)) v))
b))
(to_number " 123 a ")

131
src/doc.janet Normal file
View File

@ -0,0 +1,131 @@
(import /src/base :as base)
(import /src/prelude :as prelude)
(defn map-values [f dict]
(from-pairs (map (fn [[k v]] [k (f v)]) (pairs dict))))
(def with-docs (map-values base/doc prelude/ctx))
(def sorted-names (-> with-docs keys sort))
(defn escape-underscores [str] (string/replace "_" "\\_" str))
(defn escape-punctuation [str] (->> str
(string/replace "?" "")
(string/replace "!" "")
(string/replace "/" "")))
(defn toc-entry [name]
(def escaped (escape-underscores name))
(string "[" escaped "](#" (escape-punctuation escaped) ")"))
(def alphabetical-list
(string/join (map toc-entry sorted-names) "&nbsp;&nbsp;&nbsp; "))
(def topics {
"math" ["abs" "add" "angle" "atan/2" "between?" "ceil" "cos" "dec" "deg/rad" "deg/turn" "dist" "div" "div/0" "div/safe" "even?" "floor" "gt?" "gte?" "heading/vector" "inc" "inv" "inv/0" "inv/safe" "lt?" "lte?" "max" "min" "mod" "mod/0" "mod/safe" "mult" "neg" "neg?" "odd?" "pi" "pos?" "rad/deg" "rad/turn" "random" "random_int" "range" "round" "sin" "sqrt" "sqrt/safe" "square" "sub" "sum_of_squares" "tan" "tau" "to_number" "turn/deg" "turn/rad" "zero?"]
"boolean" ["and" "bool" "bool?" "false?" "not" "or" "true?"]
"dicts" ["any?" "assoc" "assoc?" "coll?" "count" "dict" "dict?" "diff" "dissoc" "empty?" "get" "keys" "random" "update" "values"]
"lists" ["any?" "append" "at" "butlast" "coll?" "concat" "count" "each!" "empty?" "filter" "first" "fold" "join" "keep" "last" "list" "list?" "map" "ordered?" "random" "range" "rest" "second" "sentence" "slice"]
"sets" ["any?" "append" "coll?" "concat" "contains?" "count" "empty?" "omit" "random" "set" "set?"]
"tuples" ["any?" "at" "coll?" "count" "empty?" "first" "last" "ordered?" "rest" "second" "tuple?"]
"strings" ["any?" "chars" "chars/safe" "concat" "count" "downcase" "empty?" "join" "sentence" "show" "slice" "split" "string" "string?" "strip" "to_number" "trim" "upcase" "words"]
"types and values" ["assoc?" "bool?" "box?" "coll?" "dict?" "eq?" "fn?" "keyword?" "list?" "neq?" "nil?" "number?" "ordered?" "set?" "show" "some" "some?" "string?" "tuple?" "type"]
"boxes and state" ["box?" "unbox" "store!" "update!"]
"results" ["err" "err?" "ok" "ok?" "unwrap!" "unwrap_or"]
"errors" ["assert!"]
"turtle graphics" ["back!" "background!" "bk!" "clear!" "colors" "fd!" "forward!" "goto!" "heading" "heading/vector" "hideturtle!" "home!" "left!" "loadstate!" "lt!" "pc!" "pd!" "pencolor" "pencolor!" "pendown!" "pendown?" "penup!" "penwidth" "penwidth!" "position" "pu!" "pw!" "render_turtle!" "reset_turtle!" "right!" "rt!" "setheading!" "showturtle!" "turtle_state"]
"environment and i/o" ["doc!" "print!" "report!" "state"]
})
(defn capitalize [str]
(def fst (slice str 0 1))
(def rest (slice str 1))
(def init_cap (string/ascii-upper fst))
(def lower_rest (string/ascii-lower rest))
(string init_cap lower_rest))
(defn topic-entry [topic]
(string "### " (capitalize topic) "\n"
(as-> topic _ (topics _) (array/slice _) (sort _) (map toc-entry _)
(string/join _ "&nbsp;&nbsp;&nbsp; "))
"\n"))
(def by-topic (let [the-topics (-> topics keys sort)
topics-entries (map topic-entry the-topics)]
(string/join topics-entries "\n")))
(defn compose-entry [name]
(def header (string "\n### " name "\n"))
(def the-doc (get with-docs name))
(when (= "No documentation available." the-doc)
(break (string header the-doc "\n")))
(def lines (string/split "\n" the-doc))
(def description (last lines))
(def patterns (string/join (slice lines 1 (-> lines length dec)) "\n"))
(def backto "[Back to top.](#ludus-prelude-documentation)\n")
(string header description "\n```\n" patterns "\n```\n" backto))
(compose-entry "update")
(def entries (string/join (map compose-entry sorted-names) "\n---"))
(def doc-file (string
```
# Ludus prelude documentation
These functions are available in every Ludus script.
The documentation for any function can be found within Ludus by passing the function to `doc!`,
e.g., running `doc! (add)` will send the documentation for `add` to the console.
For more information on the syntax & semantics of the Ludus language, see [language.md](./language.md).
The prelude itself is just a Ludus file, which you can see at [prelude.ld](./prelude.ld).
## A few notes
**Naming conventions.** Functions whose name ends with a question mark, e.g., `eq?`, return booleans.
Functions whose name ends with an exclamation point, e.g., `make!`, change state in some way.
In other words, they _do things_ rather than _calculating values_.
Functions whose name includes a slash either convert from one value to another, e.g. `deg/rad`,
or they are variations on a function, e.g. `div/0` as a variation on `div`.
**How entries are formatted.** Each entry has a brief (sometimes too brief!) description of what it does.
It is followed by the patterns for each of its function clauses.
This should be enough to indicate order of arguments, types, and so on.
**Patterns often, but do not always, indicate types.** Typed patterns are written as `foo as :bar`,
where the type is indicated by the keyword.
Possible ludus types are: `:nil`, `:boolean`, `:number`, `:keyword` (atomic values);
`:string` (strings are their own beast); `:tuple` and `:list` (ordered collections), `:set`s, and `:dict`ionaries (the other collection types); `:pkg` (packages, which are quasi-collections); `:fn` (functions); and `:box`es.
**Conventional types.** Ludus has two types based on conventions.
* _Result tuples._ Results are a way of modeling the result of a calculation that might fail.
The two possible values are `(:ok, value)` and `(:err, msg)`.
`msg` is usually a string describing what went wrong.
To work with result tuples, see [`unwrap!`](#unwrap) and [`unwrap_or`](#unwrap_or).
That said, usually you work with these using pattern matching.
* _Vectors._ Vectors are 2-element tuples of x and y coordinates.
The origin is `(0, 0)`.
Many math functions take vectors as well as numbers, e.g., `add` and `mult`.
You will see vectors indicated in patterns by an `(x, y)` tuple.
You can see what this looks like in the last clause of `add`: `((x1, y1), (x2, y2))`.
## Functions by topic
```
by-topic
```
## All functions, alphabetically
```
alphabetical-list
```
## Function documentation
```
entries
))
(spit "prelude.md" doc-file)

140
src/errors.janet Normal file
View File

@ -0,0 +1,140 @@
(import /src/base :as b)
(defn- get-line [source line]
((string/split "\n" source) (dec line)))
(defn- caret [source line start]
(def lines (string/split "\n" source))
(def the-line (lines (dec line)))
(def prev-lines (slice lines 0 (dec line)))
(def char-counts (map (fn [x] (-> x length inc)) prev-lines))
(def prev-line-chars (sum char-counts))
(def offset (- start prev-line-chars))
(def indent (string/repeat "." (+ 6 offset)))
(string indent "^")
)
(defn scan-error [e]
(def {:line line-num :input input :source source :start start :msg msg} e)
(print "Syntax error: " msg)
(print " on line " line-num " in " input ":")
(def source-line (get-line source line-num))
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn parse-error [e]
(def msg (e :msg))
(def {:line line-num :input input :source source :start start} (e :token))
(def source-line (get-line source line-num))
(print "Syntax error: " msg)
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn validation-error [e]
(def msg (e :msg))
(def {:line line-num :input input :source source :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(case msg
"unbound name"
(do
(print "Validation error: " msg " " (get-in e [:node :data]))
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start)))
(do
(print "Validation error: " msg)
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start))))
e)
(defn- fn-no-match [e]
(print "Ludus panicked! no match")
(def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(print " on line " line-num " in " input ", ")
(def called (e :called))
(print " calling: " (slice (b/show called) 3))
(def value (e :value))
(print " with arguments: " (b/show value))
(print " expected match with one of:")
(def patterns (b/pretty-patterns called))
(def fmt-patt (do
(def lines (string/split "\n" patterns))
(def indented (map (fn [x] (string " " x)) lines))
(string/join indented "\n")
))
(print fmt-patt)
(print " >>> " source-line)
(print (caret source line-num start))
)
(defn- let-no-match [e]
(print "Ludus panicked! no match")
(def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(print " on line " line-num " in " input ", ")
(print " matching: " (b/show (e :value)))
(def pattern (get-in e [:node :data 0]))
(print " with pattern: " (b/show-patt pattern))
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn- match-no-match [e]
(print "Ludus panicked! no match")
(def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(print " on line " line-num " in " input ", ")
(def value (e :value))
(print " matching: " (b/show value))
(print " with patterns:")
(def clauses (get-in e [:node :data 1]))
(def patterns (b/pretty-patterns {:body clauses}))
(def fmt-patt (do
(def lines (string/split "\n" patterns))
(def indented (map (fn [x] (string " " x)) lines))
(string/join indented "\n")
))
(print fmt-patt)
(def source-line (get-line source line-num))
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn- generic-panic [e]
(def msg (e :msg))
(def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(print "Ludus panicked! " msg)
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn- unbound-name [e]
(def {:line line-num :source source :lexeme name :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(print "Ludus panicked! unbound name " name)
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn runtime-error [e]
(when (= :string (type e))
(print (string "Internal Ludus error: " e))
(print "Please file an issue at https://alea.ludus.dev/twc/ludus/issues")
(break e))
(def msg (e :msg))
(case msg
"no match: function call" (fn-no-match e)
"no match: let binding" (let-no-match e)
"no match: match form" (match-no-match e)
"no match: when form" (generic-panic e)
"unbound name" (unbound-name e)
(generic-panic e))
e)

657
src/interpreter.janet Normal file
View File

@ -0,0 +1,657 @@
# A tree walk interpreter for ludus
(import /src/base :as b)
(var interpret nil)
(var match-pattern nil)
(defn- todo [msg] (error (string "not yet implemented: " msg)))
(defn- resolve-name [name ctx]
# # (print "resolving " name " in:")
# # (pp ctx)
(when (not ctx) (break :^not-found))
(if (has-key? ctx name)
(ctx name)
(resolve-name name (ctx :^parent))))
(defn- match-word [word value ctx]
(def name (word :data))
# # (print "matched " (b/show value) " to " name)
(set (ctx name) value)
{:success true :ctx ctx})
(defn- typed [pattern value ctx]
(def [type-ast word] (pattern :data))
(def type (type-ast :data))
(if (= type (b/ludus/type value))
(match-word word value ctx)
{:success false :miss [pattern value]}))
(defn- match-tuple [pattern value ctx]
(when (not (tuple? value))
(break {:success false :miss [pattern value]}))
(def val-len (length value))
(var members (pattern :data))
(when (empty? members)
(break (if (empty? value)
{:success true :ctx ctx}
{:success false :miss [pattern value]})))
(def patt-len (length members))
(var splat nil)
(def splat? (= :splat ((last members) :type)))
(when splat?
(when (< val-len patt-len)
# (print "mismatched splatted tuple lengths")
(break {:success false :miss [pattern value]}))
# (print "splat!")
(set splat (last members))
(set members (slice members 0 (dec patt-len))))
(when (and (not splat?) (not= val-len patt-len))
# (print "mismatched tuple lengths")
(break {:success false :miss [pattern value]}))
(var curr-mem :^nothing)
(var curr-val :^nothing)
(var success true)
(for i 0 (length members)
(set curr-mem (get members i))
(set curr-val (get value i))
# (print "in tuple, matching " curr-val " with ")
# (pp curr-mem)
(def match? (match-pattern curr-mem curr-val ctx))
# (pp match?)
(when (not (match? :success))
(set success false)
(break)))
(when (and splat? (splat :data))
(def rest (array/slice value (length members)))
(match-word (splat :data) rest ctx))
(if success
{:success true :ctx ctx}
{:success false :miss [pattern value]}))
(defn- match-list [pattern value ctx]
(when (not (array? value))
(break {:success false :miss [pattern value]}))
(def val-len (length value))
(var members (pattern :data))
(when (empty? members)
(break (if (empty? value)
{:success true :ctx ctx}
{:success false :miss [pattern value]})))
(def patt-len (length members))
(var splat nil)
(def splat? (= :splat ((last members) :type)))
(when splat?
(when (< val-len patt-len)
# (print "mismatched splatted list lengths")
(break {:success false :miss [pattern value]}))
# (print "splat!")
(set splat (last members))
(set members (slice members 0 (dec patt-len))))
(when (and (not splat?) (not= val-len patt-len))
# (print "mismatched list lengths")
(break {:success false :miss [pattern value]}))
(var curr-mem :^nothing)
(var curr-val :^nothing)
(var success true)
(for i 0 (length members)
(set curr-mem (get members i))
(set curr-val (get value i))
# (print "in list, matching " curr-val " with ")
# (pp curr-mem)
(def match? (match-pattern curr-mem curr-val ctx))
# (pp match?)
(when (not (match? :success))
(set success false)
(break)))
(when (and splat? (splat :data))
(def rest (array/slice value (length members)))
(match-word (splat :data) rest ctx))
(if success
{:success true :ctx ctx}
{:success false :miss [pattern value]}))
(defn- match-string [pattern value ctx]
(when (not (string? value))
(break {:success false :miss [pattern value]}))
(def {:compiled compiled :bindings bindings} pattern)
# (print "matching " value " with")
# (pp (pattern :grammar))
(def matches (peg/match compiled value))
(when (not matches)
(break {:success false :miss [pattern value]}))
(when (not= (length matches) (length bindings))
(error "oops: different number of matches and bindings"))
(for i 0 (length matches)
(set (ctx (bindings i)) (matches i)))
{:success true :ctx ctx})
(defn- match-dict [pattern value ctx]
(when (not (table? value))
(break {:success false :miss [pattern value]}))
(def val-size (length value))
(var members (pattern :data))
(def patt-len (length members))
(when (empty? members)
(break (if (empty? value)
{:success true :ctx ctx}
{:success false :miss [pattern value]})))
(var splat nil)
(def splat? (= :splat ((last members) :type)))
(when splat?
(when (< val-size patt-len)
# (print "mismatched splatted dict lengths")
(break {:success false :miss [pattern value]}))
# (print "splat!")
(set splat (last members))
(set members (slice members 0 (dec patt-len))))
(when (and (not splat?) (not= val-size patt-len))
# (print "mismatched dict lengths")
(break {:success false :miss [pattern value]}))
(var success true)
(def matched-keys @[])
(for i 0 (length members)
(def curr-pair (get members i))
(def [curr-key curr-patt] (curr-pair :data))
(def key (interpret curr-key ctx))
(def curr-val (value key))
(def match? (match-pattern curr-patt curr-val ctx))
(array/push matched-keys key)
(when (not (match? :success))
(set success false)
(break)))
(when (and splat? (splat :data) success)
(def rest (merge value))
(each key matched-keys
(set (rest key) nil))
(match-word (splat :data) rest ctx))
(if success
{:success true :ctx ctx}
{:success false :miss [pattern value]}))
(defn- match-pattern* [pattern value &opt ctx]
# (print "in match-pattern, matching " value " with:")
# (pp pattern)
(default ctx @{})
(def data (pattern :data))
(case (pattern :type)
# always match
:placeholder {:success true :ctx ctx}
:ignored {:success true :ctx ctx}
:word (match-word pattern value ctx)
# match on equality
:nil {:success (= :^nil value) :ctx ctx}
:bool {:success (= data value) :ctx ctx}
:number {:success (= data value) :ctx ctx}
:string {:success (= data value) :ctx ctx}
:keyword {:success (= data value) :ctx ctx}
# TODO: lists, dicts
:tuple (match-tuple pattern value ctx)
:list (match-list pattern value ctx)
:dict (match-dict pattern value ctx)
:interpolated (match-string pattern value ctx)
:typed (typed pattern value ctx)
))
(set match-pattern match-pattern*)
(defn- lett [ast ctx]
# (print "lett!")
# (pp ast)
(def [patt expr] (ast :data))
(def value (interpret expr ctx))
(def match? (match-pattern patt value))
(if (match? :success)
(do
(merge-into ctx (match? :ctx))
value)
(error {:node ast :value value :msg "no match: let binding"})))
(defn- matchh [ast ctx]
(def [to-match clauses] (ast :data))
(def value (interpret to-match ctx))
(def len (length clauses))
(when (ast :match) (break ((ast :match) 0 value ctx)))
(defn match-fn [i value ctx]
(when (= len i)
(error {:node ast :value value :msg "no match: match form"}))
(def clause (clauses i))
(def [patt guard expr] clause)
(def match? (match-pattern patt value @{:^parent ctx}))
(when (not (match? :success))
(break (match-fn (inc i) value ctx)))
(def body-ctx (match? :ctx))
(def guard? (if guard
(b/bool (interpret guard body-ctx)) true))
(when (not guard?)
(break (match-fn (inc i) value ctx)))
(interpret expr body-ctx))
(set (ast :match) match-fn)
(match-fn 0 value ctx))
(defn- script [ast ctx]
(def lines (ast :data))
(def last-line (last lines))
(for i 0 (-> lines length dec)
(interpret (lines i) ctx))
(interpret last-line ctx))
(defn- block [ast parent]
(def lines (ast :data))
(def last-line (last lines))
(def ctx @{:^parent parent})
(for i 0 (-> lines length dec)
(interpret (lines i) ctx))
(interpret last-line ctx))
(defn- to_string [ctx] (fn [x]
(if (buffer? x)
(string x)
(b/stringify (interpret x ctx)))))
(defn- interpolated [ast ctx]
(def terms (ast :data))
(def interpolations (map (to_string ctx) terms))
(string/join interpolations))
(defn- iff [ast ctx]
(def [condition then else] (ast :data))
(if (b/bool (interpret condition ctx))
(interpret then ctx)
(interpret else ctx)))
# TODO: use a tail call here
(defn- whenn [ast ctx]
(def clauses (ast :data))
(var result :^nothing)
(each clause clauses
(def [lhs rhs] clause)
(when (b/bool (interpret lhs ctx))
(set result (interpret rhs ctx))
(break)))
(when (= result :^nothing)
(error {:node ast :msg "no match: when form"}))
result)
(defn- word [ast ctx]
(def resolved (resolve-name (ast :data) ctx))
(if (= :^not-found resolved)
(error {:node ast :msg "unbound name"})
resolved))
(defn- tup [ast ctx]
(def members (ast :data))
(def the-tup @[])
(each member members
(array/push the-tup (interpret member ctx)))
[;the-tup])
(defn- args [ast ctx]
(def members (ast :data))
(def the-args @[])
(each member members
(array/push the-args (interpret member ctx)))
(if (ast :partial)
{:^type :partial :args the-args}
[;the-args]))
(defn- sett [ast ctx]
(def members (ast :data))
(def the-set @{:^type :set})
(each member members
(def value (interpret member ctx))
(set (the-set value) true))
the-set)
(defn- list [ast ctx]
(def members (ast :data))
(def the-list @[])
(each member members
(if (= :splat (member :type))
(do
(def splatted (interpret (member :data) ctx))
(when (not= :array (type splatted))
(error {:node member :msg "cannot splat non-list into list"}))
(array/concat the-list splatted))
(array/push the-list (interpret member ctx))))
the-list)
(defn- dict [ast ctx]
(def members (ast :data))
(def the-dict @{})
(each member members
(if (= :splat (member :type))
(do
(def splatted (interpret (member :data) ctx))
(when (or
(not= :table (type splatted))
(:^type splatted))
(error {:node member :msg "cannot splat non-dict into dict"}))
(merge-into the-dict splatted))
(do
(def [key-ast value-ast] (member :data))
# (print "dict key")
# (pp key-ast)
# (print "dict value")
# (pp value-ast)
(def key (interpret key-ast ctx))
(def value (interpret value-ast ctx))
(set (the-dict key) value))))
the-dict)
(defn- box [ast ctx]
(def {:data value-ast :name name} ast)
(def value (interpret value-ast ctx))
(def box @{:^type :box :^value value :name name})
(set (ctx name) box)
box)
(defn- repeatt [ast ctx]
(def [times-ast body] (ast :data))
(def times (interpret times-ast ctx))
(when (not (number? times))
(error {:node times-ast :msg (string "repeat needs a `number` of times; you gave me a " (type times))}))
(repeat times (interpret body ctx)))
(defn- panic [ast ctx]
(def info (interpret (ast :data) ctx))
(error {:node ast :msg info}))
# TODO: add docstrings & pattern docs to fns
# Depends on: good string representation of patterns
# For now, this should be enough to tall the thing
(defn- fnn [ast ctx]
(def {:name name :data clauses :doc doc} ast)
# (print "defining fn " name)
(def closure (merge ctx))
(def the-fn @{:name name :^type :fn :body clauses :ctx closure :doc doc})
(when (not= :^not-found (resolve-name name ctx))
# (print "fn "name" was forward declared")
(def fwd (resolve-name name ctx))
(set (fwd :body) clauses)
(set (fwd :ctx) closure)
(set (fwd :doc) doc)
# (print "fn " name " has been defined")
# (pp fwd)
(break fwd))
# (pp the-fn)
(set (closure name) the-fn)
(set (ctx name) the-fn)
the-fn)
(defn- is_placeholder [x] (= x :_))
(var call-fn nil)
(defn- partial [root-ast the-fn partial-args]
(when (the-fn :applied)
(error {:msg "cannot partially apply a partially applied function"
:node root-ast :called the-fn :args partial-args}))
# (print "calling partially applied function")
(def args (partial-args :args))
# (pp args)
(def pos (find-index is_placeholder args))
(def name (string (the-fn :name) " *partial*"))
(defn partial-fn [root-ast missing]
# (print "calling function with arg " (b/show missing))
# (pp partial-args)
(def full-args (array/slice args))
(set (full-args pos) missing)
# (print "all args: " (b/show full-args))
(call-fn root-ast the-fn [;full-args]))
{:^type :fn :applied true :name name :body partial-fn})
(defn- call-fn* [root-ast the-fn args]
# (print "on line " (get-in root-ast [:token :line]))
# (print "calling " (b/show the-fn))
# (print "with args " (b/show args))
# (pp args)
(when (or
(= :function (type the-fn))
(= :cfunction (type the-fn)))
# (print "Janet function")
(break (the-fn ;args)))
(def clauses (the-fn :body))
(when (= :nothing clauses)
(error {:node root-ast :called the-fn :value args :msg "cannot call function before it is defined"}))
(when (= :function (type clauses))
(break (clauses root-ast ;args)))
(def len (length clauses))
(when (the-fn :match) (break ((the-fn :match) root-ast 0 args)))
(defn match-fn [root-ast i args]
(when (= len i)
(error {:node root-ast :called the-fn :value args :msg "no match: function call"}))
(def clause (clauses i))
(def [patt guard expr] clause)
(def match?
(match-pattern patt args @{:^parent (the-fn :ctx)}))
(when (not (match? :success))
(break (match-fn root-ast (inc i) args)))
# (print "matched!")
(def body-ctx (match? :ctx))
(def guard? (if guard
(b/bool (interpret guard body-ctx)) true))
# (print "passed guard")
(when (not guard?)
(break (match-fn root-ast (inc i) args)))
(interpret expr body-ctx))
(set (the-fn :match) match-fn)
(match-fn root-ast 0 args))
(set call-fn call-fn*)
(defn- call-partial [root-ast the-fn arg] ((the-fn :body) root-ast ;arg))
(defn- apply-synth-term [root-ast prev curr]
# (print "applying " (b/show prev))
# (print "to" (b/show curr))
(def types [(b/ludus/type prev) (b/ludus/type curr)])
# (print "typle:")
# (pp types)
(match types
[:fn :tuple] (call-fn root-ast prev curr)
[:fn :partial] (partial root-ast prev curr)
[:function :tuple] (call-fn root-ast prev curr)
# [:applied :tuple] (call-partial root-ast prev curr)
[:keyword :args] (get (first curr) prev :^nil)
[:keyword :tuple] (get (first curr) prev :^nil)
[:dict :keyword] (get prev curr :^nil)
[:nil :keyword] :^nil
[:pkg :keyword] (get prev curr :^nil)
[:pkg :pkg-kw] (get prev curr :^nil)
(error (string "cannot call " (b/ludus/type prev) " `" (b/show prev) "`"))))
(defn- synthetic [ast ctx]
(def terms (ast :data))
# (print "interpreting synthetic")
# (pp ast)
# (pp terms)
(def first-term (first terms))
(def last-term (last terms))
(var prev (interpret first-term ctx))
# (print "root term: ")
# (pp prev)
(for i 1 (-> terms length dec)
(def curr (interpret (terms i) ctx))
# (print "term " i ": " curr)
(set prev (apply-synth-term first-term prev curr)))
# (print "done with inner terms, applying last term")
(apply-synth-term first-term prev (interpret last-term ctx)))
(defn- doo [ast ctx]
(def terms (ast :data))
(var prev (interpret (first terms) ctx))
(def last-term (last terms))
(for i 1 (-> terms length dec)
(def curr (interpret (terms i) ctx))
(set prev (apply-synth-term (first terms) curr [prev])))
(def last-fn (interpret last-term ctx))
(apply-synth-term (first terms) last-fn [prev]))
(defn- pkg [ast ctx]
(def members (ast :data))
(def the-pkg @{:^name (ast :name) :^type :pkg})
(each member members
(def [key-ast value-ast] (member :data))
(def key (interpret key-ast ctx))
(def value (interpret value-ast ctx))
(set (the-pkg key) value))
# (pp the-pkg)
(def out (table/to-struct the-pkg))
(set (ctx (ast :name)) out)
out)
(defn- loopp [ast ctx]
# (print "looping!")
(def data (ast :data))
(def args (interpret (data 0) ctx))
# this doesn't work: context persists between different interpretations
# we want functions to work this way, but not loops (I think)
# (when (ast :match) (break ((ast :match) 0 args)))
(def clauses (data 1))
(def len (length clauses))
(var loop-ctx @{:^parent ctx})
(defn match-fn [i args]
(when (= len i)
(error {:node ast :value args :msg "no match: loop"}))
(def clause (clauses i))
(def [patt guard expr] clause)
(def match?
(match-pattern patt args loop-ctx))
(when (not (match? :success))
# (print "no match")
(break (match-fn (inc i) args)))
# (print "matched!")
(def body-ctx (match? :ctx))
(def guard? (if guard
(b/bool (interpret guard body-ctx)) true))
# (print "passed guard")
(when (not guard?)
(break (match-fn (inc i) args)))
(interpret expr body-ctx))
(set (ast :match) match-fn)
(set (loop-ctx :^recur) match-fn)
# (print "ATTACHED MATCH-FN")
(match-fn 0 args))
(defn- recur [ast ctx]
# (print "recurring!")
(def passed (ast :data))
(def args (interpret passed ctx))
(def match-fn (resolve-name :^recur ctx))
# (print "match fn in ctx:")
# (pp (ctx :^recur))
# (pp match-fn)
# (pp ctx)
(match-fn 0 args))
# TODO for 0.1.0
(defn- testt [ast ctx] (todo "test"))
(defn- ns [ast ctx] (todo "nses"))
(defn- importt [ast ctx] (todo "imports"))
(defn- withh [ast ctx] (todo "with"))
(defn- usee [ast ctx] (todo "use"))
(defn- interpret* [ast ctx]
# (print "interpreting node " (ast :type))
(case (ast :type)
# literals
:nil :^nil
:number (ast :data)
:bool (ast :data)
:string (ast :data)
:keyword (ast :data)
:placeholder :_
# collections
:tuple (tup ast ctx)
:args (args ast ctx)
:list (list ast ctx)
:set (sett ast ctx)
:dict (dict ast ctx)
# composite forms
:if (iff ast ctx)
:block (block ast ctx)
:when (whenn ast ctx)
:script (script ast ctx)
:panic (panic ast ctx)
# looping forms
:loop (loopp ast ctx)
:recur (recur ast ctx)
:repeat (repeatt ast ctx)
# named/naming forms
:word (word ast ctx)
:interpolated (interpolated ast ctx)
:box (box ast ctx)
:pkg (pkg ast ctx)
:pkg-name (word ast ctx)
# patterned forms
:let (lett ast ctx)
:match (matchh ast ctx)
# functions
:fn (fnn ast ctx)
# synthetic
:synthetic (synthetic ast ctx)
# do
:do (doo ast ctx)
# deferred until after computer class
# :with (withh ast ctx)
# :import (importt ast ctx)
# :ns (ns ast ctx)
# :use (usee ast ctx)
# :test (testt ast ctx)
))
(set interpret interpret*)
# # repl
# (import /src/scanner :as s)
# (import /src/parser :as p)
# (import /src/validate :as v)
# (var source nil)
# (defn- has-errors? [{:errors errors}] (and errors (not (empty? errors))))
# (defn run []
# (def scanned (s/scan source))
# (when (has-errors? scanned) (break (scanned :errors)))
# (def parsed (p/parse scanned))
# (when (has-errors? parsed) (break (parsed :errors)))
# (def validated (v/valid parsed b/ctx))
# # (when (has-errors? validated) (break (validated :errors)))
# # (def cleaned (get-in parsed [:ast :data 1]))
# # # (pp cleaned)
# (interpret (parsed :ast) @{:^parent b/lett})
# # (try (interpret (parsed :ast) @{:^parent b/ctx})
# # ([e] (if (struct? e) (error (e :msg)) (error e))))
# )
# # (do
# (comment
# (set source `
# let foo = 42
# "{foo} bar baz"
# `)
# (def result (run))
# )

131
src/json.janet Normal file
View File

@ -0,0 +1,131 @@
# pulled from cfiggers/jayson
(defmacro- letv [bindings & body]
~(do ,;(seq [[k v] :in (partition 2 bindings)] ['var k v]) ,;body))
(defn- read-hex [n]
(scan-number (string "0x" n)))
(defn- check-utf-16 [capture]
(let [u (read-hex capture)]
(if (and (>= u 0xD800)
(<= u 0xDBFF))
capture
false)))
(def- utf-8->bytes
(peg/compile
~{:double-u-esc (/ (* "\\u" (cmt (<- 4) ,|(check-utf-16 $)) "\\u" (<- 4))
,|(+ (blshift (- (read-hex $0) 0xD800) 10)
(- (read-hex $1) 0xDC00) 0x10000))
:single-u-esc (/ (* "\\u" (<- 4)) ,|(read-hex $))
:unicode-esc (/ (+ :double-u-esc :single-u-esc)
,|(string/from-bytes
;(cond
(<= $ 0x7f) [$]
(<= $ 0x7ff)
[(bor (band (brshift $ 6) 0x1F) 0xC0)
(bor (band (brshift $ 0) 0x3F) 0x80)]
(<= $ 0xffff)
[(bor (band (brshift $ 12) 0x0F) 0xE0)
(bor (band (brshift $ 6) 0x3F) 0x80)
(bor (band (brshift $ 0) 0x3F) 0x80)]
# Otherwise
[(bor (band (brshift $ 18) 0x07) 0xF0)
(bor (band (brshift $ 12) 0x3F) 0x80)
(bor (band (brshift $ 6) 0x3F) 0x80)
(bor (band (brshift $ 0) 0x3F) 0x80)])))
:escape (/ (* "\\" (<- (set "avbnfrt\"\\/")))
,|(get {"a" "\a" "v" "\v" "b" "\b"
"n" "\n" "f" "\f" "r" "\r"
"t" "\t"} $ $))
:main (+ (some (+ :unicode-esc :escape (<- 1))) -1)}))
(defn decode
``
Returns a janet object after parsing JSON. If `keywords` is truthy,
string keys will be converted to keywords. If `nils` is truthy, `null`
will become `nil` instead of the keyword `:json/null`.
``
[json-source &opt keywords nils]
(def json-parser
{:null (if nils
~(/ (<- (+ "null" "Null")) nil)
~(/ (<- (+ "null" "Null")) :json/null))
:bool-t ~(/ (<- (+ "true")) true)
:bool-f ~(/ (<- (+ "false")) false)
:number ~(/ (<- (* (? "-") :d+ (? (* "." :d+)))) ,|(scan-number $))
:string ~(/ (* "\"" (<- (to (* (> -1 (not "\\")) "\"")))
(* (> -1 (not "\\")) "\""))
,|(string/join (peg/match utf-8->bytes $)))
:array ~(/ (* "[" :s* (? (* :value (any (* :s* "," :value)))) "]") ,|(array ;$&))
:key-value (if keywords
~(* :s* (/ :string ,|(keyword $)) :s* ":" :value)
~(* :s* :string :s* ":" :value))
:object ~(/ (* "{" :s* (? (* :key-value (any (* :s* "," :key-value)))) "}")
,|(from-pairs (partition 2 $&)))
:value ~(* :s* (+ :null :bool-t :bool-f :number :string :array :object) :s*)
:unmatched ~(/ (<- (to (+ :value -1))) ,|[:unmatched $])
:main ~(some (+ :value "\n" :unmatched))})
(first (peg/match (peg/compile json-parser) json-source)))
(def- bytes->utf-8
(peg/compile
~{:four-byte (/ (* (<- (range "\xf0\xff")) (<- 1) (<- 1) (<- 1))
,|(bor (blshift (band (first $0) 0x07) 18)
(blshift (band (first $1) 0x3F) 12)
(blshift (band (first $2) 0x3F) 6)
(blshift (band (first $3) 0x3F) 0)))
:three-byte (/ (* (<- (range "\xe0\xef")) (<- 1) (<- 1))
,|(bor (blshift (band (first $0) 0x0F) 12)
(blshift (band (first $1) 0x3F) 6)
(blshift (band (first $2) 0x3F) 0)))
:two-byte (/ (* (<- (range "\x80\xdf")) (<- 1))
,|(bor (blshift (band (first $0) 0x1F) 6)
(blshift (band (first $1) 0x3F) 0)))
:multi-byte (/ (+ :two-byte :three-byte :four-byte)
,|(if (< $ 0x10000)
(string/format "\\u%04X" $)
(string/format "\\u%04X\\u%04X"
(+ (brshift (- $ 0x10000) 10) 0xD800)
(+ (band (- $ 0x10000) 0x3FF) 0xDC00))))
:one-byte (<- (range "\x20\x7f"))
:0to31 (/ (<- (range "\0\x1F"))
,|(or ({"\a" "\\u0007" "\b" "\\u0008"
"\t" "\\u0009" "\n" "\\u000A"
"\v" "\\u000B" "\f" "\\u000C"
"\r" "\\u000D"} $)
(string/format "\\u%04X" (first $))))
:backslash (/ (<- "\\") "\\\\")
:quote (/ (<- "\"") "\\\"")
:main (+ (some (+ :0to31 :backslash :quote :one-byte :multi-byte)) -1)}))
(defn- encodeone [x depth]
(if (> depth 1024) (error "recurred too deeply"))
(cond
(= x :json/null) "null"
(= x nil) "null"
(bytes? x) (string "\"" (string/join (peg/match bytes->utf-8 x)) "\"")
(indexed? x) (string "[" (string/join (map |(encodeone $ (inc depth)) x) ",") "]")
(dictionary? x) (string "{" (string/join
(seq [[k v] :in (pairs x)]
(string "\"" (string/join (peg/match bytes->utf-8 k)) "\"" ":" (encodeone v (inc depth)))) ",") "}")
(case (type x)
:nil "null"
:boolean (string x)
:number (string x)
(error "type not supported"))))
(defn encode
``
Encodes a janet value in JSON (utf-8). If `buf` is provided, the formated
JSON is append to `buf` instead of a new buffer. Returns the modifed buffer.
``
[x &opt buf]
(letv [ret (encodeone x 0)]
(if (and buf (buffer? buf))
(buffer/push ret)
(thaw ret))))

106
src/ludus.janet Normal file
View File

@ -0,0 +1,106 @@
# an integrated Ludus interpreter
# devised in order to run under wasm
# takes a string, returns a string with a json object
# (try (os/cd "janet") ([_] nil)) # for REPL
(import /src/scanner :as s)
(import /src/parser :as p)
(import /src/validate :as v)
(import /src/interpreter :as i)
(import /src/errors :as e)
(import /src/base :as b)
(import /src/prelude :as prelude)
(import /src/json :as j)
(defn ludus [source]
# if we can't load prelude, bail
(when (= :error prelude/pkg) (error "could not load prelude"))
# get us a clean working slate
(def ctx @{:^parent prelude/ctx})
(def errors @[])
(var result @"")
(def console @"")
# capture all `print`s
(setdyn :out console)
# an output table
# this will change: the shape of our output
# at the moment, there's only one stack of turtle graphics
# we will be getting more
(def out @{:errors errors :result result
:io @{
:stdout @{:proto [:text-stream "0.1.0"] :data console}
:turtle @{:proto [:turtle-graphics "0.1.0"] :data @[]}}})
### start the program
# first, scanning
(def scanned (s/scan source))
(when (any? (scanned :errors))
(each err (scanned :errors)
(e/scan-error err))
(break (-> out j/encode string)))
# then, parsing
(def parsed (p/parse scanned))
(when (any? (parsed :errors))
(each err (parsed :errors)
(e/parse-error err))
(break (-> out j/encode string)))
# then, validation
(def validated (v/valid parsed ctx))
(when (any? (validated :errors))
(each err (validated :errors)
(e/validation-error err))
(break (-> out j/encode string)))
# and, finally, try interpreting the program
(try (do
# we need to do this every run or we get the very same sequence of "random" numbers every time we run a program
(math/seedrandom (os/cryptorand 8))
(set result (i/interpret (parsed :ast) ctx)))
([err]
(e/runtime-error err)
(break (-> out j/encode string))))
# stop capturing output
(setdyn :out stdout)
# update our output table with our output
(set (out :result) (b/show result))
(set (((out :io) :turtle) :data) (get-in prelude/pkg [:turtle_commands :^value]))
# run the "postlude": any Ludus code that needs to run after each program
# right now this is just resetting the boxes that hold turtle commands and state
(try
(i/interpret prelude/post/ast ctx)
([err] (e/runtime-error err)))
# json-encode our output table, and convert it from a buffer to a string (which we require for playing nice with WASM/C)
(-> out j/encode string))
#### REPL
(comment
# (do
# (def start (os/clock))
(def source `
fd! (100)
rt! (0.25)
fd! (100)
lt! (0.25)
fd! (100)
setheading! (0.75)
unbox (turtle_state)
`)
(def out (-> source
ludus
j/decode
))
# (def end (os/clock))
(setdyn :out stdout)
(pp out)
(def console (out "console"))
(print console)
(def result (out "result"))
(print result)
# (print (- end start))
)

View File

@ -1,2 +0,0 @@
(ns ludus.ast)

View File

@ -1,430 +0,0 @@
(ns ludus.base
(:require
[ludus.data :as data]
[ludus.show :as show]
[clojure.math :as math]
;[ludus.draw :as d]
#?(:cljs [cljs.reader])
#?(:cljs [goog.object :as o])
))
;; TODO: make eq, and, or special forms that short-circuit
;; Right now, they evaluate all their args
(def eq {:name "eq"
::data/type ::data/clj
:body =})
(defn- id [x] x)
(def and- {:name "and"
::data/type ::data/clj
:body (fn [& args] (every? id args))})
(def or- {:name "or"
::data/type ::data/clj
:body (fn [& args] (some id args))})
(def add {:name "add"
::data/type ::data/clj
:body +})
(def sub {:name "sub"
::data/type ::data/clj
:body -})
(def mult {:name "mult"
::data/type ::data/clj
:body *})
(def div {:name "div"
::data/type ::data/clj
:body /})
(def gt {:name "gt"
::data/type ::data/clj
:body >})
(def gte {:name "gte"
::data/type ::data/clj
:body >=})
(def lt {:name "lt"
::data/type ::data/clj
:body <})
(def lte {:name "lte"
::data/type ::data/clj
:body <=})
(def inc- {:name "inc"
::data/type ::data/clj
:body inc})
(def dec- {:name "dec"
::data/type ::data/clj
:body dec})
(def not- {:name "not"
::data/type ::data/clj
:body not})
(defn- print-show [lvalue]
(if (string? lvalue) lvalue (show/show lvalue)))
(defn- stringify-args [arglist]
(apply str (interpose " " (into [] (map print-show) (rest arglist)))))
(def panic! {:name "panic!"
::data/type ::data/clj
:body (fn panic-inner
([] (panic-inner [::data/list]))
([args] (throw (ex-info (stringify-args args) {}))))})
(def print- {:name "print"
::data/type ::data/clj
:body (fn [args]
(println (stringify-args args))
:ok)})
(def deref- {:name "deref"
::data/type ::data/clj
:body (fn [ref]
(if (::data/ref ref)
(deref (::data/value ref))
(throw (ex-info "Cannot deref something that is not a ref" {}))))})
(def set!- {:name "set!"
::data/type ::data/clj
:body (fn [ref value]
(if (::data/ref ref)
(reset! (::data/value ref) value)
(throw (ex-info "Cannot set! something that is not a ref" {}))))})
(def show {:name "show"
::data/type ::data/clj
:body ludus.show/show})
(def conj- {:name "conj"
::data/type ::data/clj
:body conj})
(def assoc- {:name "assoc"
::data/type ::data/clj
:body assoc})
(def dissoc- {name "dissoc"
::data/type ::data/clj
:body dissoc})
(def get- {:name "get"
::data/type ::data/clj
:body (fn
([key, map]
(if (map? map)
(get map key)
nil))
([key, map, default]
(if (map? map)
(get map key default)
default)))})
(def rest- {:name "rest"
::data/type ::data/clj
:body (fn [v]
(into [::data/list] (nthrest v 2)))})
(def nth- {:name "nth"
::data/type ::data/clj
:body nth})
(def slice {:name "slice"
::data/type ::data/clj
:body subvec})
(def types {
:keyword
#?(
:clj clojure.lang.Keyword
:cljs cljs.core/Keyword
)
:long
#?(
:clj java.lang.Long
:cljs js/Number
)
:double
#?(
:clj java.lang.Double
:cljs js/Number
)
:integer
#?(
:clj java.lang.Integer
:cljs js/Number
)
:ratio
#?(
:clj clojure.lang.Ratio
:cljs js/Number
)
:string
#?(
:clj java.lang.String
:cljs js/String
)
:boolean
#?(
:clj java.lang.Boolean
:cljs js/Boolean
)
:set
#?(
:clj clojure.lang.PersistentHashSet
:cljs cljs.core/PersistentHashSet
)
:vector
#?(
:clj clojure.lang.PersistentVector
:cljs cljs.core/PersistentVector
)
:map
#?(
:clj clojure.lang.PersistentArrayMap
:cljs cljs.core/PersistentArrayMap
)
})
(defn get-type [value]
(let [t (type value)]
(cond
(nil? value) :nil
(= (:keyword types) t) :keyword
(= (:long types) t) :number
(= (:double types) t) :number
(= (:integer types) t) :number
(= (:ratio types) t) :number
(= (:string types) t) :string
(= (:boolean types) t) :boolean
(= (:set types) t) :set
;; tuples and lists
(= (:vector types) t)
(if (= ::data/tuple (first value)) :tuple :list)
;; structs dicts namespaces refs
(= (:map types) t)
(cond
(::data/type value) (case (::data/type value)
(::data/fn ::data/clj) :fn
::data/ns :ns)
(::data/dict value) :dict
(::data/struct value) :struct
(::data/ref value) :ref
:else :none
))))
(def type- {:name "type"
::data/type ::data/clj
:body get-type})
(defn- kv->tuple [[k v]] [::data/tuple k v])
(def to_list {name "to_list"
::data/type ::data/clj
:body (fn [item]
(case (get-type item)
(:number :nil :boolean :fn :string :ref :keyword) [::data/list item]
:list item
:set (into [::data/list] item)
:tuple (into [::data/list] (rest item))
:dict (into [::data/list] (map kv->tuple) (dissoc item ::data/dict))
:struct (into [::data/list] (map kv->tuple) (dissoc item ::data/struct))
:ns (into [::data/list] (map kv->tuple) (dissoc item ::data/struct ::data/type ::data/name))
))})
(def to_dict {name "to_dict"
::data/type ::data/clj
:body (fn [struct] (-> struct (assoc ::data/dict true) (dissoc ::data/struct ::data/type ::data/name)))})
(defn strpart [kw] (->> kw str rest (apply str)))
(def readstr
#?(
:clj read-string
:cljs cljs.reader/read-string
))
(defn- resolve-str [str]
#?(
:clj (eval str)
:cljs (.bind (o/get js/window str) js/window)
))
(def extern {:name "extern"
::data/type ::data/clj
:body (fn [& args]
;(println "Args passed: " args)
(let [called (-> args first strpart readstr resolve-str)
fn-args (rest args)]
;(println "Fn: " called)
;(println "Args: " (clj->js fn-args))
#?(
:clj (apply called fn-args)
:cljs (.apply called js/window (clj->js fn-args)))))})
(def count- {:name "count"
::data/type ::data/clj
:body count})
(def into- {:name "into"
::data/type ::data/clj
:body into})
(def to_vec {:name "to_vec"
::data/type ::data/clj
:body (fn [xs] (into [] (dissoc xs ::data/type ::data/struct ::data/name)))})
(def fold {:name "fold"
::data/type ::data/clj
:body reduce})
(def map- {:name "map"
::data/type ::data/clj
:body map})
(def prn- {:name "raw"
::data/type ::data/clj
:body println})
(def concat- {:name "concat"
::data/type ::data/clj
:body (fn [xs ys]
(if (= ::data/list (first xs))
(into [::data/list] (concat (rest xs) (rest ys)))
(into #{} (concat xs ys))))})
(def str- {:name "str"
::data/type ::data/clj
:body str})
(def doc- {:name "doc"
::data/type ::data/clj
:body (fn [f]
(let [name (:name f)
docstring (:doc f)
clauses (:clauses f)
patterns (map first clauses)
pretty-patterns (map show/show-pattern patterns)
doc (into [name docstring] pretty-patterns)]
(apply str (interpose "\n" doc)))
)})
(def sin {:name "sin"
::data/type ::data/clj
:body math/sin})
(def cos {:name "cos"
::data/type ::data/clj
:body math/cos})
(def tan {:name "tan"
::data/type ::data/clj
:body math/tan})
(def atan_2 {:name "atan_2"
::data/type ::data/clj
:body math/atan2})
(def sqrt {:name "sqrt"
::data/type ::data/clj
:body math/sqrt})
(def random {:name "random"
::data/type ::data/clj
:body rand})
(def floor {:name "floor"
::data/type ::data/clj
:body math/floor})
(def ceil {:name "ceil"
::data/type ::data/clj
:body math/ceil})
(def round {:name "round"
::data/type ::data/clj
:body math/round})
(def range- {:name "range"
::data/type ::data/clj
:body (fn [start end] (into [::data/list] (range (-> start math/ceil int) end)))})
(def base {
:id id
:eq eq
:add add
:print print-
:sub sub
:mult mult
:div div
:gt gt
:gte gte
:lt lt
:lte lte
:inc inc-
:dec dec-
:not not-
:show show
:deref deref-
:set! set!-
:and and-
:or or-
:assoc assoc-
:dissoc dissoc-
:conj conj-
:get get-
:type type-
:extern extern
:rest rest-
:nth nth-
:slice slice
:count count-
:into into-
:to_vec to_vec
:fold fold
:map map
:panic! panic!
:prn prn-
:concat concat-
:str str-
:to_list to_list
:doc doc-
:pi math/PI
:sin sin
:cos cos
:tan tan
:atan_2 atan_2
:sqrt sqrt
:random random
:ceil ceil
:floor floor
:round round
:range range-
})

View File

@ -1 +0,0 @@
(ns ludus.collections)

View File

@ -1,38 +0,0 @@
(ns ludus.core
"A tree-walk interpreter for the Ludus language."
(:require
[ludus.scanner :as scanner]
[ludus.parser :as p]
[ludus.grammar :as g]
[ludus.interpreter :as interpreter]
[ludus.show :as show]
[clojure.pprint :as pp]
[ludus.loader :as loader]
[ludus.repl :as repl])
(:gen-class))
(defn- run [file source]
(let [scanned (scanner/scan source)]
(if (not-empty (:errors scanned))
(do
(println "I found some scanning errors!")
(pp/pprint (:errors scanned))
(System/exit 65))
(let [parsed (p/apply-parser g/script (:tokens scanned))]
(if (p/fail? parsed)
(do
(println "I found some parsing errors!")
(println (p/err-msg parsed))
(System/exit 66))
(let [interpreted (interpreter/interpret source file parsed)]
(println (show/show interpreted))
(System/exit 0)))))))
(defn -main [& args]
(cond
(= (count args) 1)
(let [file (first args)
source (loader/load-import file)]
(run file source))
:else (repl/launch)))

View File

@ -1,2 +0,0 @@
(ns ludus.data)

View File

@ -1,126 +0,0 @@
(ns ludus.doc
(:require [ludus.interpreter :as interpreter]
[ludus.base :as base]
[ludus.data :as data]
[clojure.string :as string]))
(def prelude interpreter/ludus-prelude)
(def exports-only (dissoc prelude ::data/type ::data/struct))
(defn map-values [f] (fn [[k v]] [k (f v)]))
(def ludus-doc (base/doc- :body))
(def with-docs (into {} (map (map-values ludus-doc)) exports-only))
(def sorted-names (-> with-docs keys sort))
(defn escape-underscores [the-str] (string/replace the-str #"_" "\\_"))
(defn escape-punctuation [the-str] (string/replace the-str #"[\!\?]" ""))
(defn toc-entry [name] (let [escaped (escape-underscores name)] (str "[" escaped "](#" (escape-punctuation escaped) ")")))
(def alphabetical-list (string/join "&nbsp;&nbsp;&nbsp; " (map toc-entry sorted-names)))
(def topics {
"math" ["abs" "add" "angle" "atan/2" "ceil" "cos" "dec" "deg/rad" "deg/turn" "dist" "div"
"div/0" "div/safe" "even?" "floor" "gt?" "gte?" "heading/vector" "inc" "lt?" "lte?" "mod"
"mult" "neg" "neg?" "odd?" "pi" "pos?" "rad/deg" "rad/turn" "random" "range" "round"
"sin" "square" "sub" "sum_of_squares" "tan" "tau" "turn/deg" "turn/rad" "zero?"]
"boolean" ["and" "bool" "bool?" "false?" "or" "not"]
"dicts" ["assoc" "assoc?" "dict" "diff" "dissoc" "get" "keys" "update" "values"]
"lists" ["append" "at" "butlast" "concat" "count" "each!" "first" "fold" "last" "list" "list?" "map" "ordered?" "range"
"rest" "second" "slice"]
"sets" ["set" "set?"]
"strings" ["count" "join" "show" "string" "string?"]
"types and values" ["bool?" "coll?" "dict?" "eq?" "fn?" "keyword?" "list?" "neq?" "nil?" "number?" "ordered?" "show" "some" "some?" "type"]
"references and state" ["deref" "make!" "update!"]
"results" ["err" "err?" "ok" "ok?" "unwrap!" "unwrap_or"]
"errors" ["assert!" "panic!"]
"turtle graphics" ["back!" "background!" "bk!" "clear!" "fd!" "forward!" "goto!" "heading" "heading/vector" "home!" "left!" "lt!" "pc!" "pd!" "pencolor"
"pencolor!" "pendown!" "pendown?" "penup!" "penwidth" "penwidth!" "position" "pu!" "pw!" "render_turtle!" "reset_turtle!"
"right!" "rt!" "turtle_state"]
"environment and i/o" ["doc!" "flush!" "print!" "prn!" "report!"]
})
(defn topic-entry [topic] (str "### " (string/capitalize topic) "\n"
(->> topic (get topics) sort (map toc-entry) (string/join "&nbsp;&nbsp;&nbsp; "))
"\n"))
(def by-topic (let [the-topics (-> topics keys sort)
topics-entries (map topic-entry the-topics)]
(string/join "\n" topics-entries)))
(defn compose-entry [name]
(let [the-doc (get with-docs name)
header (str "### " name "\n")
lines (string/split-lines the-doc)]
(if (empty? lines) (str header "No documentation available.\n")
(let [
description (second lines)
pattern-lines (subvec lines 2)
patterns (string/join "\n" pattern-lines)
]
(str header description "\n```\n" patterns "\n```")
))))
(def entries (string/join "\n\n" (map compose-entry sorted-names)))
(def doc-file
(str
"# Ludus prelude documentation
These functions are available in every Ludus script.
The documentation for any function can be found within Ludus by passing the function to `doc!`,
e.g., running `doc! (add)` will send the documentation for `add` to the console.
For more information on the syntax & semantics of the Ludus language, see [language.md](./language.md).
## A few notes
**Naming conventions.** Functions whose name ends with a question mark, e.g., `eq?`, return booleans.
Functions whose name ends with an exclamation point, e.g., `make!`, change state in some way.
In other words, they _do things_ rather than _calculating values_.
Functions whose name includes a slash either convert from one value to another, e.g. `deg/rad`,
or they are variations on a function, e.g. `div/0` as a variation on `div`.
**How entries are formatted.** Each entry has a brief (sometimes too brief!) description of what it does.
It is followed by the patterns for each of its function clauses.
This should be enough to indicate order of arguments, types, and so on.
**Patterns often, but do not always, indicate types.** Typed patterns are written as `foo as :bar`,
where the type is indicated by the keyword.
Possible ludus types are: `:nil`, `:boolean`, `:number`, `:keyword` (atomic values);
`:string` (strings are their own beast); `:tuple` and `:list` (indexed collections); `:set` (sets are specific),
`:dict` and `:ns` (associative collections); and `:ref` (references).
**Conventional types.** Ludus has two types based on conventions.
* _Result tuples._ Results are a way of modeling the result of a calculation that might fail.
The two possible values are `(:ok, value)` and `(:err, msg)`.
`msg` is usually a string describing what went wrong.
To work with result tuples, see [`unwrap!`](#unwrap) and [`unwrap_or`](#unwrap_or).
That said, usually you work with these using pattern matching.
* _Vectors._ Vectors are 2-element tuples of x and y coordinates.
The origin is `(0, 0)`.
Many math functions take vectors as well as numbers, e.g., `add` and `mult`.
You will see vectors indicated in patterns by an `(x, y)` tuple.
You can see what this looks like in the last clause of `add`: `((x1, y1), (x2, y2))`.
## Functions by topic
"
by-topic
"
## All functions, alphabetically
"
alphabetical-list
"
## Function documentation
"
entries
))
(spit "prelude.md" doc-file)

View File

@ -1,15 +0,0 @@
(ns ludus.draw)
(defn background
([x] (js/background x))
([r g b] (js/background r g b))
([r g b a] (js/background r g b a)))
(defn rect [[x y] [w h]]
(js/rect x y w h))
(defn ellipse [[x y] [w h]])
(def draw {
})

View File

@ -1,42 +0,0 @@
(ns ludus.error
(:require [clojure.string :as string]))
(defn get-line [source {:keys [line]}]
(let [lines (string/split-lines source)
the_line (nth lines (dec line))]
the_line))
(string/split-lines "abcd")
(defn get-underline [source {:keys [line start lexeme]} prefix]
(let [lines (string/split-lines source)
lines-before (subvec lines 0 (dec line))
line-start (reduce (fn [len line] (+ len (count line))) (count lines-before) lines-before)
from-start (- start line-start)
underline-length (count lexeme)
padding (string/join (take (+ prefix from-start) (repeat "-")))
underline (string/join (take underline-length (repeat "^")))]
(apply str padding underline)
))
(defn scan-error [] :TODO)
(defn parse-error [source {:keys [trace token]}]
(let [line (get-line source token)
line-num (:line token)
prefix (str line-num ": ")
underline (get-underline source token (count prefix))
expected (first trace)
got (:type token)
message (str "Ludus found a parsing error on line " line-num ".\nExpected: " expected "\nGot: " got "\n")
]
(str message "\n" prefix line "\n" underline)
)
)
(defn run-error [source {:keys [line message]}]
(if line
(str "Ludus panicked on line " line ":\n" (get-line source {:line line}) "\n" message)
(str "Ludus panicked!\n" message)
))

View File

@ -1,270 +0,0 @@
(ns ludus.grammar
(:require
#?(
:clj [ludus.parser :refer :all]
:cljs [ludus.parser
:refer [choice quiet one+ zero+ group order-0 order-1 flat maybe weak-order]
:refer-macros [defp]
]
)
[ludus.scanner :as s]
))
(declare expression pattern binding-expr non-binding simple)
(defp separator choice [:comma :newline :break])
(defp separators quiet one+ separator)
(defp terminator choice [:newline :semicolon :break])
(defp terminators quiet one+ terminator)
(defp nls? quiet zero+ :newline)
(defp splat group order-1 [(quiet :splat) :word])
(defp patt-splat-able flat choice [:word :ignored :placeholder])
(defp splattern group order-1 [(quiet :splat) (maybe patt-splat-able)])
(defp literal flat choice [:nil :true :false :number :string])
(defp tuple-pattern-term flat choice [pattern splattern])
(defp tuple-pattern-entry weak-order [tuple-pattern-term separators])
(defp tuple-pattern group order-1 [(quiet :lparen)
(quiet (zero+ separator))
(zero+ tuple-pattern-entry)
(quiet :rparen)])
(defp list-pattern group order-1 [(quiet :lbracket)
(quiet (zero+ separator))
(zero+ tuple-pattern-entry)
(quiet :rbracket)])
(defp pair-pattern group weak-order [:keyword pattern])
(defp typed group weak-order [:word (quiet :as) :keyword])
(defp dict-pattern-term flat choice [pair-pattern typed :word splattern])
(defp dict-pattern-entry weak-order [dict-pattern-term separators])
(defp dict-pattern group order-1 [(quiet :startdict)
(quiet (zero+ separator))
(zero+ dict-pattern-entry)
(quiet :rbrace)
])
; (defp struct-pattern group order-1 [(quiet :startstruct)
; (quiet (zero+ separator))
; (zero+ dict-pattern-entry)
; (quiet :rbrace)
; ])
(defp guard order-0 [(quiet :if) simple])
(defp pattern flat choice [literal
:ignored
:placeholder
typed
:word
:keyword
:else
tuple-pattern
dict-pattern
;struct-pattern
list-pattern])
(defp match-clause group weak-order [pattern (maybe guard) (quiet :rarrow) expression])
(defp match-entry weak-order [match-clause terminators])
(defp match group order-1 [(quiet :match) simple nls?
(quiet :with) (quiet :lbrace)
(quiet (zero+ terminator))
(one+ match-entry)
(quiet :rbrace)
])
(defp when-lhs flat choice [simple :placeholder :else])
(defp when-clause group weak-order [when-lhs (quiet :rarrow) expression])
(defp when-entry weak-order [when-clause terminators])
(defp when-expr group order-1 [(quiet :when) (quiet :lbrace)
(quiet (zero+ terminator))
(one+ when-entry)
(quiet :rbrace)])
(defp let-expr group order-1 [(quiet :let)
pattern
(quiet :equals)
nls?
non-binding])
(defp condition flat choice [simple let-expr])
(defp if-expr group order-1 [(quiet :if)
nls?
condition
nls?
(quiet :then)
expression
nls?
(quiet :else)
expression])
(defp tuple-entry weak-order [non-binding separators])
(defp tuple group order-1 [(quiet :lparen)
(quiet (zero+ separator))
(zero+ tuple-entry)
(quiet :rparen)])
(defp list-term flat choice [splat non-binding])
(defp list-entry order-1 [list-term separators])
(defp list-literal group order-1 [(quiet :lbracket)
(quiet (zero+ separator))
(zero+ list-entry)
(quiet :rbracket)])
(defp set-literal group order-1 [(quiet :startset)
(quiet (zero+ separator))
(zero+ list-entry)
(quiet :rbrace)])
(defp pair group order-0 [:keyword non-binding])
;; "struct-term" and "struct-entry" are necessary for nses
(defp struct-term flat choice [:word pair])
(defp struct-entry order-1 [struct-term separators])
; (defp struct-literal group order-1 [(quiet :startstruct)
; (quiet (zero+ separator))
; (zero+ struct-entry)
; (quiet :rbrace)])
(defp dict-term flat choice [splat :word pair])
(defp dict-entry order-1 [dict-term separators])
(defp dict group order-1 [(quiet :startdict)
(quiet (zero+ separator))
(zero+ dict-entry)
(quiet :rbrace)])
(defp arg-expr flat choice [:placeholder non-binding])
(defp arg-entry weak-order [arg-expr separators])
(defp args group order-1 [(quiet :lparen)
(quiet (zero+ separator))
(zero+ arg-entry)
(quiet :rparen)])
(defp recur-call group order-1 [(quiet :recur) tuple])
(defp synth-root flat choice [:keyword :word])
(defp synth-term flat choice [args :keyword])
(defp synthetic group order-1 [synth-root (zero+ synth-term)])
(defp fn-clause group order-1 [tuple-pattern (maybe guard) (quiet :rarrow) expression])
(defp fn-entry order-1 [fn-clause terminators])
(defp fn-compound group order-1 [(quiet :lbrace)
nls?
(maybe :string)
(quiet (zero+ terminator))
(one+ fn-entry)
(quiet :rbrace)
])
(defp clauses flat choice [fn-clause fn-compound])
(defp fn-named group order-1 [(quiet :fn) :word clauses])
(defp lambda group order-1 [(quiet :fn) fn-clause])
(defp block-line weak-order [expression terminators])
(defp block group order-1 [(quiet :lbrace)
(quiet (zero+ terminator))
(one+ block-line)
(quiet :rbrace)])
(defp pipeline quiet order-0 [nls? :pipeline])
(defp do-entry order-1 [pipeline expression])
(defp do-expr group order-1 [(quiet :do)
expression
(one+ do-entry)
])
(defp ref-expr group order-1 [(quiet :ref) :word (quiet :equals) expression])
; (defp spawn group order-1 [(quiet :spawn) expression])
; (defp receive group order-1 [(quiet :receive) (quiet :lbrace)
; (quiet (zero+ terminator))
; (one+ match-entry)
; (quiet :rbrace)
; ])
(defp compound-loop group order-0 [(quiet :lbrace)
(quiet (zero+ terminator))
(one+ fn-entry)
(quiet :rbrace)])
(defp loop-expr group order-1 [(quiet :loop) tuple (quiet :with)
(flat (choice :loop-body [fn-clause compound-loop]))])
(defp repeat-expr group order-1 [(quiet :repeat) (choice :times [:word :number]) block])
(defp collection flat choice [;struct-literal
dict list-literal set-literal tuple])
(defp simple flat choice [literal collection synthetic recur-call lambda])
(defp compound flat choice [match loop-expr if-expr when-expr do-expr block repeat-expr])
(defp binding-expr flat choice [fn-named let-expr ref-expr])
(defp non-binding flat choice [simple compound])
(defp expression flat choice [binding-expr non-binding])
(defp test-expr group order-1 [(quiet :test) :string non-binding])
(defp import-expr group order-1 [(quiet :import) :string (quiet :as) :word])
(defp ns-expr group order-1 [(quiet :ns)
:word
(quiet :lbrace)
(quiet (zero+ separator))
(zero+ struct-entry)
(quiet :rbrace)])
(defp use-expr group order-1 [(quiet :use) :word])
(defp toplevel flat choice [import-expr
ns-expr
expression
test-expr
use-expr])
(defp script-line weak-order [toplevel terminators])
(defp script order-0 [nls?
(one+ script-line)
(quiet :eof)])

File diff suppressed because it is too large Load Diff

View File

@ -1,16 +0,0 @@
(ns ludus.loader
(:require [babashka.fs :as fs]))
(defn cwd [] (fs/cwd))
(defn load-import
([file]
(let [path (-> file (fs/canonicalize) (fs/file))]
(try (slurp path)
(catch java.io.FileNotFoundException _
(throw (ex-info (str "File " path " not found") {:path path ::error true}))))))
([file from]
(load-import
(fs/path
(if (= from :cwd) (fs/cwd) (fs/parent (fs/canonicalize from)))
(fs/path file)))))

View File

@ -1,62 +0,0 @@
(ns ludus.node
(:require [ludus.interpreter :as i]
[ludus.grammar :as g]
[ludus.parser :as p]
[ludus.scanner :as s]
[ludus.prelude :as pre]
[ludus.show :as show]
[ludus.base :as base]
[ludus.data :as data]
[ludus.error :as error]
)
)
(declare ld->clj)
(defn cljify [[k v]] [k (ld->clj v)])
(defn ld->clj [value]
(case (base/get-type value)
(:nil :number :string :boolean :keyword :set) value
(:list :tuple) (into [] (map ld->clj) (rest value))
(:dict :struct :ns) (into {} (map cljify) (dissoc value ::data/dict ::data/struct ::data/type ::data/name))
:ref (ld->clj @(::value value))
:fn (throw (ex-info (str "Cannot export functions from Ludus to Clojure. You tried exporting " (show/show value)) {}))))
(defn clean-out [value]
#?(:clj value :cljs (clj->js value)))
(defn run [source]
(let [user_scanned (s/scan source)
user_tokens (:tokens user_scanned)
_ (println "Tokens: " user_tokens)
user_parsed (p/apply-parser g/script user_tokens)
_ (println "Ast: " (i/prettify-ast user_parsed))
user_result (i/interpret-safe source user_parsed {})
result_str (show/show user_result)
post_scanned (s/scan pre/postlude)
post_tokens (:tokens post_scanned)
post_parsed (p/apply-parser g/script post_tokens)
post_result (i/interpret-safe source post_parsed {})
ludus_result (assoc post_result :result result_str)
clj_result (ld->clj ludus_result)
]
(cond
(not-empty (:errors user_tokens))
(clean-out {:errors (:errors user_tokens)})
(= :err (:status user_parsed))
(clean-out {:errors [(error/parse-error source user_parsed)]})
(::data/error user_result)
(clean-out (assoc (ld->clj post_result) :errors [(error/run-error source user_result)]))
:else
(clean-out clj_result)
)
))

View File

@ -1,316 +0,0 @@
(ns ludus.parser)
(defn ? [val default] (if (nil? val) default val))
(defn ok? [{status :status}]
(= status :ok))
(def failing #{:err :none})
(def passing #{:ok :group :quiet})
(defn pass? [{status :status}] (contains? passing status))
(defn fail? [{status :status}] (contains? failing status))
(defn data [{d :data}] d)
(defn remaining [{r :remaining}] r)
(defn pname [parser] (? (:name parser) parser))
(defn str-part [kw] (apply str (next (str kw))))
(defn kw+str [kw mystr] (keyword (str (str-part kw) mystr)))
(defn value [token]
(if (= :none (:literal token)) (:lexeme token) (:literal token)))
(defn apply-kw-parser [kw tokens]
(let [token (first tokens)]
;(if (= kw (:type token)) (println "Matched " kw))
(if (= kw (:type token))
{:status :ok
:type kw
:data (if (some? (value token)) [(value token)] [])
:token token
:remaining (rest tokens)}
{:status :none :token token :trace [kw] :remaining (rest tokens)})))
(defn apply-fn-parser [parser tokens]
(let [rule (:rule parser) name (:name parser) result (rule tokens)]
;(if (pass? result) (println "Matched " (:name parser)))
result))
(defn apply-parser [parser tokens]
;(println "Applying parser " (? (:name parser) parser))
(let [result (cond
(keyword? parser) (apply-kw-parser parser tokens)
(:rule parser) (apply-fn-parser parser tokens)
(fn? parser) (apply-fn-parser (parser) tokens)
:else (throw (ex-info "`apply-parser` requires a parser" {})))]
;(println "Parser result " (? (:name parser) parser) (:status result))
result
))
(defn choice [name parsers]
{:name name
:rule (fn choice-fn [tokens]
(loop [ps parsers]
(let [result (apply-parser (first ps) tokens)
rem-ts (remaining result)
rem-ps (rest ps)]
(cond
(pass? result)
{:status :ok :type name :data [result] :token (first tokens) :remaining rem-ts}
(= :err (:status result))
(update result :trace #(conj % name))
(empty? rem-ps)
{:status :none :token (first tokens) :trace [name] :remaining rem-ts}
:else (recur rem-ps)))))})
(defn order-1 [name parsers]
{:name name
:rule (fn order-fn [tokens]
(let [origin (first tokens)
first-result (apply-parser (first parsers) tokens)]
(case (:status first-result)
(:err :none)
(assoc (update first-result :trace #(conj % name)) :status :none)
(:ok :quiet :group)
(loop [ps (rest parsers)
results (case (:status first-result)
:ok [first-result]
:quiet []
:group (:data first-result))
ts (remaining first-result)]
(let [result (apply-parser (first ps) ts)
res-rem (remaining result)]
(if (empty? (rest ps))
(case (:status result)
:ok {:status :group
:type name
:data (conj results result)
:token origin
:remaining res-rem}
:quiet {:status :group
:type name
:data results
:token origin
:remaining res-rem}
:group {:status :group
:type name
:data (vec (concat results (:data result)))
:token origin
:remaining res-rem}
(:err :none)
(assoc (update result :trace #(conj % name)) :status :err))
(case (:status result)
:ok (recur (rest ps) (conj results result) res-rem)
:group (recur (rest ps)
(vec (concat results (:data result)))
res-rem)
:quiet (recur (rest ps) results res-rem)
(:err :none)
(assoc (update result :trace #(conj % name)) :status :err))))))))})
(defn order-0 [name parsers]
{:name name
:rule (fn order-fn [tokens]
(let [origin (first tokens)]
(loop [ps parsers
results []
ts tokens]
(let [result (apply-parser (first ps) ts)
res-rem (remaining result)]
(if (empty? (rest ps))
;; Nothing more: return
(case (:status result)
:ok {:status :group
:type name
:data (conj results result)
:token origin
:remaining res-rem}
:quiet {:status :group
:type name
:data results
:token origin
:remaining res-rem}
:group {:status :group
:type name
:data (vec (concat results (:data result)))
:token origin
:remaining res-rem}
(:err :none)
(assoc (update result :trace #(conj % name)) :status :err))
;; Still parsers left in the vector: recur
(case (:status result)
:ok (recur (rest ps) (conj results result) res-rem)
:group (recur (rest ps)
(vec (concat results (:data result)))
res-rem)
:quiet (recur (rest ps) results res-rem)
(:err :none)
(assoc (update result :trace #(conj % name)) :status :err)
(throw (ex-info (str "Got bad result: " (:status result)) result))))))))})
(defn weak-order [name parsers]
{:name name
:rule (fn order-fn [tokens]
(let [origin (first tokens)]
(loop [ps parsers
results []
ts tokens]
(let [result (apply-parser (first ps) ts)
res-rem (remaining result)]
(if (empty? (rest ps))
;; Nothing more: return
(case (:status result)
:ok {:status :group
:type name
:data (conj results result)
:token origin
:remaining res-rem}
:quiet {:status :group
:type name
:data results
:token origin
:remaining res-rem}
:group {:status :group
:type name
:data (vec (concat results (:data result)))
:token origin
:remaining res-rem}
(:err :none)
(update result :trace #(conj % name)))
;; Still parsers left in the vector: recur
(case (:status result)
:ok (recur (rest ps) (conj results result) res-rem)
:group (recur (rest ps)
(vec (concat results (:data result)))
res-rem)
:quiet (recur (rest ps) results res-rem)
(:err :none)
(update result :trace #(conj % name))))))))})
(defn quiet [parser]
{:name (kw+str (? (:name parser) parser) "-quiet")
:rule (fn quiet-fn [tokens]
(let [result (apply-parser parser tokens)]
(if (pass? result)
(assoc result :status :quiet)
result)))})
(defn zero+
([parser] (zero+ (pname parser) parser))
([name parser]
{:name (kw+str name "-zero+")
:rule (fn zero+fn [tokens]
(loop [results []
ts tokens]
(let [result (apply-parser parser ts)]
(case (:status result)
:ok (recur (conj results result) (remaining result))
:group (recur (vec (concat results (:data result))) (remaining result))
:quiet (recur results (remaining result))
:err (update result :trace #(conj % name))
:none {:status :group
:type name
:data results
:token (first tokens)
:remaining ts}))))}))
(defn one+
([parser] (one+ (pname parser) parser))
([name parser]
{:name (kw+str name "-one+")
:rule (fn one+fn [tokens]
(let [first-result (apply-parser parser tokens)
rest-parser (zero+ name parser)]
(case (:status first-result)
(:ok :group)
(let [rest-result (apply-parser rest-parser (remaining first-result))]
(case (:status rest-result)
(:ok :group :quiet)
{:status :group
:type name
:data (vec (concat (:data first-result) (data rest-result)))
:token (first tokens)
:remaining (remaining rest-result)}
:none {:status :group :type name
:data first-result
:token (first tokens)
:remaining (remaining rest-result)}
:err (update rest-result :trace #(conj % name))))
:quiet
(let [rest-result (apply-parser rest-parser (remaining first-result))]
{:status :quiet
:type name
:data []
:token (first tokens)
:remaining (remaining rest-result)})
(:err :none) first-result)))}))
(defn maybe
([parser] (maybe (pname parser) parser))
([name parser]
{:name (kw+str name "-maybe")
:rule (fn maybe-fn [tokens]
(let [result (apply-parser parser tokens)]
(if (pass? result)
result
{:status :group :type name :data [] :token (first tokens) :remaining tokens}
)))}))
(defn flat
([parser] (flat (pname parser) parser))
([name parser]
{:name (kw+str name "-flat")
:rule (fn flat-fn [tokens]
(let [result (apply-parser parser tokens)]
(if (pass? result) (first (:data result)) result)))}))
(defn group
([parser] (group (pname parser) parser))
([name parser]
{:name (kw+str name "-group")
:rule (fn group-fn [tokens]
(let [result (apply-parser parser tokens)]
(if (= :group (:status result))
(assoc result :status :ok)
result)))}))
(defn err-msg [{token :token trace :trace}]
(println "Unexpected token " (:type token) " on line " (:line token))
(println "Expected token " (first trace)))
(defmacro defp [name & items]
(let [arg (last items)
fns (into [] (butlast items))]
`(defn ~name [] ((apply comp ~fns) (keyword '~name) ~arg))))

View File

@ -1,25 +0,0 @@
& this file runs after any given interpretation
& even if the original interpretation panics
& the goal is to output any global state held in Ludus
& this does not have base loaded into it, only prelude: must be pure Ludus
if turtle_state() :visible? then render_turtle! () else nil
reset_turtle! ()
let console_msgs = flush! ()
let (r, g, b, a) = deref (bgcolor)
make! (bgcolor, colors :black)
let draw_calls = deref (p5_calls)
make! (p5_calls, [])
#{
& :result result is provided elsewhere
& :errors [] & if we get here there are no errors
:console console_msgs
:draw concat (
[(:background, r, g, b, a), (:stroke, 255, 255, 255, 255)]
draw_calls)
}

View File

@ -1,15 +0,0 @@
(ns ludus.prelude
#?(:cljs (:require [shadow.resource :as r]))
)
(def prelude
#?(
:clj (slurp "src/ludus/prelude.ld")
:cljs (r/inline "./prelude.ld")
))
(def postlude
#?(
:clj (slurp "src/ludus/postlude.ld")
:cljs (r/inline "./postlude.ld")
))

View File

@ -1,118 +0,0 @@
(ns ludus.repl
(:require
[ludus.scanner :as scanner]
[ludus.parser :as p]
[ludus.grammar :as g]
[ludus.interpreter :as interpreter]
[ludus.base :as base]
[ludus.show :as show]
[ludus.data :as data]
;[ludus.process :as process]
))
(declare repl-prelude new-session)
(def sessions (atom {}))
(def current-session (atom nil))
(def prompt "=> ")
(defn- exit []
(println "\nGoodbye!")
(System/exit 0))
(def repl-ctx (merge interpreter/ludus-prelude
{::repl true
"repl"
{::data/struct true
::data/type ::data/ns
::data/name "repl"
:flush
{:name "flush"
::data/type ::data/clj
:body (fn
([]
(let [session @current-session]
(swap! session #(assoc % :ctx (volatile! repl-ctx)))
:ok))
([name]
(if-let [session (get @sessions name)]
(do
(swap! session #(assoc % :ctx (volatile! repl-ctx)))
:ok)
(do
(println "No session named" name)
:error))))}
:new
{:name "new"
::data/type ::data/clj
:body (fn [name]
(let [session (new-session name)]
(reset! current-session session)
:ok))}
:switch
{:name "switch"
::data/type ::data/clj
:body (fn [name]
(if-let [session (get @sessions name)]
(do
(reset! current-session session)
:ok)
(do
(println "No session named" name)
:error)))}
:quit
{:name "quit"
::data/type ::data/clj
:body (fn [] (exit))}
}}))
(defn- new-session [name]
(let [session (atom {:name name
:ctx (volatile! repl-ctx)
:history []})]
(swap! sessions #(assoc % name session))
session))
(defn repl-loop []
(let [session-atom @current-session
session @session-atom
orig-ctx (:ctx session)]
(print (str (:name session) prompt))
(flush)
(let [input (read-line)]
(cond
(= nil input) (exit)
(= "" input) (recur)
:else
(let [parsed (->> input
(scanner/scan)
:tokens
(p/apply-parser g/script))]
(if (= :err (:status parsed))
(do
(println (p/err-msg parsed))
(recur))
(let [{result :result ctx :ctx}
(interpreter/interpret-repl parsed orig-ctx)]
(if (= result :error)
(recur)
(do
(println (show/show result))
(when (not (= @ctx @orig-ctx))
(swap! session-atom #(assoc % :ctx ctx)))
(recur))))))))))
(defn launch []
(println "Welcome to Ludus (v. 0.1.0-alpha)")
(let [session (new-session :ludus)]
(reset! current-session session)
(repl-loop)))

View File

@ -1,332 +0,0 @@
(ns ludus.scanner
(:require
[ludus.token :as token]
;; [clojure.pprint :as pp]
[clojure.edn :as edn]))
(def reserved-words
"List of Ludus reserved words."
;; see ludus-spec repo for more info
{"as" :as ;; impl for `import`; not yet for patterns
;"cond" :cond ;; impl
"do" :do ;; impl
"else" :else ;; impl
"false" :false ;; impl -> literal word
"fn" :fn ;; impl
"if" :if ;; impl
"import" :import ;; impl
"let" :let ;; impl
"loop" :loop ;; impl
"match" :match ;; impl
"nil" :nil ;; impl -> literal word
"ns" :ns ;; impl
;; "panic!" :panic ;; impl (should be a function)
"recur" :recur ;; impl
"ref" :ref ;; impl
"then" :then ;; impl
"true" :true ;; impl -> literal word
"use" :use ;; wip
"with" :with ;; impl
"when" :when ;; impl, replaces cond
;; actor model/concurrency
;"receive" :receive
;;"self" :self ;; maybe not necessary?: self() is a function
;;"send" :send ;; not necessary: send(pid, message) is a function
;"spawn" :spawn
;;"to" :to ;; not necessary if send is a function
;; type system
;; "data" :data ;; we are going to tear out datatypes for now: see if dynamism works for us
;; others
"repeat" :repeat ;; syntax sugar over "loop": still unclear what this syntax could be
"test" :test
;; "module" :module ;; not necessary if we don't have datatypes
})
(def literal-words {
"true" true
"false" false
"nil" nil
})
(defn- new-scanner
"Creates a new scanner."
[source]
{:source source
:length (count source)
:errors []
:start 0
:current 0
:line 1
:tokens []})
(defn- at-end?
"Tests if a scanner is at end of input."
[scanner]
(>= (:current scanner) (:length scanner)))
(defn- current-char
"Gets the current character of the scanner."
[scanner]
(nth (:source scanner) (:current scanner) nil))
(defn- advance
"Advances the scanner by a single character."
[scanner]
(update scanner :current inc))
(defn- next-char
"Gets the next character from the scanner."
[scanner]
(current-char (advance scanner)))
(defn- current-lexeme
[scanner]
(subs (:source scanner) (:start scanner) (:current scanner)))
(defn- char-code [char]
#?(
:clj (int char)
:cljs (.charCodeAt char 0)
))
(defn- char-in-range? [start end char]
(and char
(>= (char-code char) (char-code start))
(<= (char-code char) (char-code end))))
(defn- digit? [c]
(char-in-range? \0 \9 c))
(defn- nonzero-digit? [c]
(char-in-range? \1 \9 c))
;; for now, use very basic ASCII charset in words
;; TODO: research the implications of using the whole
;; (defn- alpha? [c] (boolean (re-find #"\p{L}" (str c))))
(defn- alpha? [c]
(or (char-in-range? \a \z c) (char-in-range? \A \Z c)))
(defn- lower? [c] (char-in-range? \a \z c))
(defn- upper? [c] (char-in-range? \A \Z c))
;; legal characters in words
(def word-chars #{\_ \? \! \* \/})
(defn- word-char? [c]
(or (alpha? c) (digit? c) (contains? word-chars c)))
(defn- whitespace? [c]
(or (= c \space) (= c \tab)))
(def terminators #{\: \; \newline \{ \} \( \) \[ \] \$ \# \- \= \& \, \> nil \\})
(defn- terminates? [c]
(or (whitespace? c) (contains? terminators c)))
(defn- add-token
([scanner token-type]
(add-token scanner token-type nil))
([scanner token-type literal]
(update scanner :tokens conj
(token/token
token-type
(current-lexeme scanner)
literal
(:line scanner)
(:start scanner)))))
;; TODO: errors should also be in the vector of tokens
;; The goal is to be able to be able to hand this to an LSP?
;; Do we need a different structure
(defn- add-error [scanner msg]
(let [token (token/token
:error
(current-lexeme scanner)
nil
(:line scanner)
(:start scanner))
err-token (assoc token :message msg)]
(-> scanner
(update :errors conj err-token)
(update :tokens conj err-token))))
(defn- add-keyword
[scanner]
(loop [scanner scanner
key ""]
(let [char (current-char scanner)]
(cond
(terminates? char) (add-token scanner :keyword (keyword key))
(word-char? char) (recur (advance scanner) (str key char))
:else (add-error scanner (str "Unexpected " char "after keyword :" key))))))
;; TODO: improve number parsing?
;; Currently this uses Clojure's number formatting rules (since we use the EDN reader)
;; These rules are here: https://cljs.github.io/api/syntax/number
(defn- add-number [char scanner]
(loop [scanner scanner
num (str char)
float? false]
(let [curr (current-char scanner)]
(cond
(= curr \_) (recur (advance scanner) num float?) ;; consume underscores unharmed
(= curr \.) (if float?
(add-error scanner (str "Unexpected second decimal point after " num "."))
(recur (advance scanner) (str num curr) true))
(terminates? curr) (add-token scanner :number (edn/read-string num))
(digit? curr) (recur (advance scanner) (str num curr) float?)
:else (add-error scanner (str "Unexpected " curr " after number " num "."))))))
;; TODO: activate string interpolation
(defn- add-string
[scanner]
(loop [scanner scanner
string ""
interpolate? false]
(let [char (current-char scanner)]
(case char
\{ (recur (advance scanner) (str string char) true)
; allow multiline strings
\newline (recur (update (advance scanner) :line inc) (str string char) interpolate?)
\" (if interpolate?
;(add-token (advance scanner) :interpolated string)
(add-token (advance scanner) :string string)
(add-token (advance scanner) :string string))
\\ (let [next (next-char scanner)
scanner (if (= next \newline)
(update scanner :line inc)
scanner)]
(recur (advance (advance scanner)) (str string next) interpolate?))
(if (at-end? scanner)
(add-error scanner "Unterminated string.")
(recur (advance scanner) (str string char) interpolate?))))))
(defn- add-word
[char scanner]
(loop [scanner scanner
word (str char)]
(let [curr (current-char scanner)]
(cond
(terminates? curr) (add-token scanner
(get reserved-words word :word)
(get literal-words word :none))
(word-char? curr) (recur (advance scanner) (str word curr))
:else (add-error scanner (str "Unexpected " curr " after word " word "."))))))
(defn- add-data
[char scanner]
(loop [scanner scanner
word (str char)]
(let [curr (current-char scanner)]
(cond
(terminates? curr) (add-token scanner :datatype)
(word-char? curr) (recur (advance scanner) (str word curr))
:else (add-error scanner (str "Unexpected " curr " after datatype " word "."))))))
(defn- add-ignored
[scanner]
(loop [scanner scanner
ignored "_"]
(let [char (current-char scanner)]
(cond
(terminates? char) (add-token scanner :ignored)
(word-char? char) (recur (advance scanner) (str ignored char))
:else (add-error scanner (str "Unexpected " char " after word " ignored "."))))))
(defn- add-comment [char scanner]
(loop [scanner scanner
comm (str char)]
(let [char (current-char scanner)]
(if (= \newline char)
(update scanner :line inc)
(recur (advance scanner) (str comm char))))))
(defn- scan-token [scanner]
(let [char (current-char scanner)
scanner (advance scanner)
next (current-char scanner)]
(case char
;; one-character tokens
\( (add-token scanner :lparen)
;; :break is a special zero-char token before closing braces
;; it makes parsing much simpler
\) (add-token (add-token scanner :break) :rparen)
\{ (add-token scanner :lbrace)
\} (add-token (add-token scanner :break) :rbrace)
\[ (add-token scanner :lbracket)
\] (add-token (add-token scanner :break) :rbracket)
\; (add-token scanner :semicolon)
\, (add-token scanner :comma)
\newline (add-token (update scanner :line inc) :newline)
\\ (add-token scanner :backslash)
\= (add-token scanner :equals)
\> (add-token scanner :pipeline)
;; two-character tokens
;; ->
\- (cond
(= next \>) (add-token (advance scanner) :rarrow)
(digit? next) (add-number char scanner)
:else (add-error scanner (str "Expected -> or negative number after `-`. Got `" char next "`")))
;; dict #{
\# (if (= next \{)
(add-token (advance scanner) :startdict)
(add-error scanner (str "Expected beginning of dict: #{. Got " char next)))
;; set ${
\$ (if (= next \{)
(add-token (advance scanner) :startset)
(add-error scanner (str "Expected beginning of set: ${. Got " char next)))
;; struct @{: Deleted from the language in December 2023
; \@ (if (= next \{)
; (add-token (advance scanner) :startstruct)
; (add-error scanner (str "Expected beginning of struct: @{. Got " char next)))
;; placeholders
;; there's a flat _, and then ignored words
\_ (cond
(terminates? next) (add-token scanner :placeholder)
(alpha? next) (add-ignored scanner)
:else (add-error scanner (str "Expected placeholder: _. Got " char next)))
;; comments
;; & starts an inline comment
\& (add-comment char scanner)
;; keywords
\: (cond
(alpha? next) (add-keyword scanner)
:else (add-error scanner (str "Expected keyword. Got " char next)))
;; splats
\. (let [after_next (current-char (advance scanner))]
(if (= ".." (str next after_next))
(add-token (advance (advance scanner)) :splat)
(add-error scanner (str "Expected splat: ... . Got " (str "." next after_next)))))
;; strings
\" (add-string scanner)
;; word matches
(cond
(whitespace? char) scanner ;; for now just skip whitespace characters
(digit? char) (add-number char scanner)
(upper? char) (add-word char scanner) ;; no datatypes for now
(lower? char) (add-word char scanner)
:else (add-error scanner (str "Unexpected character: " char))))))
(defn- next-token [scanner]
(assoc scanner :start (:current scanner)))
(defn scan [source]
(loop [scanner (new-scanner source)]
(if (at-end? scanner)
(let [scanner (add-token (add-token scanner :break) :eof)]
{:tokens (:tokens scanner)
:errors (:errors scanner)})
(recur (-> scanner (scan-token) (next-token))))))

View File

@ -1,122 +0,0 @@
(ns ludus.show
(:require
[ludus.data :as data]
; [ludus.scanner :as s]
; [ludus.parser :as p]
; [ludus.grammar :as g]
; [ludus.interpreter :as i]
[clojure.pprint :as pp]))
(declare show show-linear show-keyed)
(defn- show-vector [v]
(if (= (first v) ::data/tuple)
(str "(" (apply str (into [] show-linear (next v))) ")")
(str "[" (apply str (into [] show-linear (next v))) "]")))
(defn- show-map [v]
(cond
(or (= (::data/type v) ::data/fn)
(= (::data/type v) ::data/clj))
(str "fn " (:name v))
(= (::data/type v) ::data/ns)
(str "ns " (::data/name v) " {"
(apply str (into [] show-keyed (dissoc v ::data/struct ::data/type ::data/name)))
"}")
(::data/struct v)
(str "@{" (apply str (into [] show-keyed (dissoc v ::data/struct))) "}")
(::data/ref v) ;; TODO: reconsider this
(str "ref: " (::data/name v) " {" (-> v ::data/value deref show) "}")
(::data/dict v)
(str "#{" (apply str (into [] show-keyed (dissoc v ::data/dict))) "}")
:else
(with-out-str (pp/pprint v))))
(defn- show-set [v]
(str "${" (apply str (into [] show-linear v)) "}"))
(defn show
([v]
(cond
(string? v) (str "\"" v "\"")
(number? v) (str v)
(keyword? v) (str v)
(boolean? v) (str v)
(nil? v) "nil"
(vector? v) (show-vector v)
(set? v) (show-set v)
(map? v) (show-map v)
:else
(with-out-str (pp/pprint v))
))
([v & vs] (apply str (into [] (comp (map show) (interpose " ")) (concat [v] vs))))
)
(def show-linear (comp (map show) (interpose ", ")))
(def show-keyed (comp
(map #(str (show (first %)) " " (show (second %))))
(interpose ", ")))
(declare show-pattern)
(defn show-coll-pattern [pattern [start end]]
(let [data (:data pattern)
members (map show-pattern data)
output (apply str (interpose ", " members))]
(str start output end)))
(defn show-pattern [pattern]
(case (:type pattern)
nil ""
:placeholder "_"
:else "else"
:true "true"
:false "false"
:nil "nil"
:string (-> pattern :data first show)
(:word :number :keyword) (-> pattern :data first str)
:typed
(let [word (-> pattern :data first :data first)
type (-> pattern :data second :data first)]
(str word " as " type))
:splattern
(let [splatted (-> pattern :data first show-pattern)]
(str "..." splatted))
:pair-pattern
(let [key (-> pattern :data first)
value (-> pattern :data second)]
(str (show-pattern key) " " (show-pattern value)))
:tuple-pattern (show-coll-pattern pattern ["(" ")"])
:list-pattern (show-coll-pattern pattern ["[" "]"])
:dict-pattern (show-coll-pattern pattern ["#{" "}"])
:struct-pattern (show-coll-pattern pattern ["@{" "}"])
))
(comment
(def source "let 1 = 0")
(def tokens (-> source s/scan :tokens))
(def ast (p/apply-parser g/script tokens))
(println (i/prettify-ast ast))
(println (-> ast :data first :data first show-pattern))
)

View File

@ -1,9 +0,0 @@
(ns ludus.token)
(defn token
[type text literal line start]
{:type type
:lexeme text
:literal literal
:line line
:start start})

View File

@ -1,44 +0,0 @@
(ns ludus.web
(:require
[ludus.core :as core]
[goog.object :as o]
)
)
(defn get-element [id]
(.getElementById (.-document js/window) id))
(def canv (get-element "canv"))
(def code (get-element "code"))
(def out (get-element "output"))
(def play (get-element "play"))
(defn run-code []
(let [source (.-value code)
result (core/run source)]
(println "Running code:" source)
(o/set out "value" result)))
(.addEventListener play "click" run-code)
(defn setup []
(js/createCanvas 640 240 canv)
(js/background 235)
)
(defn draw []
(if js/mouseIsPressed
(js/fill 255)
(js/fill 155))
(js/ellipse js/mouseX js/mouseY 80 80))
(defn init []
(doto js/window
(o/set "setup" setup)
(o/set "draw" draw)))
(o/set js/window "ludus_init" init)

1181
src/parser.janet Normal file

File diff suppressed because it is too large Load Diff

42
src/prelude.janet Normal file
View File

@ -0,0 +1,42 @@
(import /src/base :as b)
(import /src/scanner :as s)
(import /src/parser :as p)
(import /src/validate :as v)
(import /src/interpreter :as i)
(import /src/errors :as e)
(def pkg (do
(def pre-ctx @{:^parent {"base" b/base}})
(def pre-src (slurp "prelude.ld"))
(def pre-scanned (s/scan pre-src :prelude))
(def pre-parsed (p/parse pre-scanned))
(def parse-errors (pre-parsed :errors))
(when (any? parse-errors) (each err parse-errors (e/parse-error err)) (break :error))
(def pre-validated (v/valid pre-parsed pre-ctx))
(def validation-errors (pre-validated :errors))
(when (any? validation-errors) (each err validation-errors (e/validation-error err)) (break :error))
(try
(i/interpret (pre-parsed :ast) pre-ctx)
([err] (e/runtime-error err) :error))))
(def ctx (do
(def ctx @{})
(each [k v] (pairs pkg)
(set (ctx (string k)) v))
(set (ctx "^name") nil)
(set (ctx "^type") nil)
ctx))
(def post/src (slurp "postlude.ld"))
(def post/ast (do
(def post-ctx @{:^parent ctx})
(def post-scanned (s/scan post/src :postlude))
(def post-parsed (p/parse post-scanned))
(def parse-errors (post-parsed :errors))
(when (any? parse-errors) (each err parse-errors (e/parse-error err)) (break :error))
(def post-validated (v/valid post-parsed post-ctx))
(def validation-errors (post-validated :errors))
(when (any? validation-errors) (each err validation-errors (e/validation-error err)) (break :error))
(post-parsed :ast)))

9
src/project.janet Normal file
View File

@ -0,0 +1,9 @@
(declare-project
:dependencies [
{:url "https://github.com/ianthehenry/judge.git"
:tag "v2.8.1"}
{:url "https://github.com/janet-lang/spork"}
])
(declare-source
:source ["ludus.janet"])

355
src/scanner.janet Normal file
View File

@ -0,0 +1,355 @@
(def reserved-words
"List of Ludus reserved words."
## see ludus-spec repo for more info
{
"as" :as ## impl
"box" :box
"do" :do ## impl
"else" :else ## impl
"false" :false ## impl -> literal word
"fn" :fn ## impl
"if" :if ## impl
"import" :import ## impl
"let" :let ## impl
"loop" :loop ## impl
"match" :match ## impl
"nil" :nil ## impl -> literal word
"ns" :ns ## impl
"panic!" :panic ## impl (should _not_ be a function)
"pkg" :pkg
"recur" :recur ## impl
"repeat" :repeat ## impl
"test" :test
"then" :then ## impl
"true" :true ## impl -> literal word
"use" :use ## wip
"when" :when ## impl, replaces cond
"with" :with ## impl
})
(def literal-words {"true" true
"false" false
"nil" nil
})
(defn- new-scanner
"Creates a new scanner."
[source input]
@{:source source
:input input
:length (length source)
:errors @[]
:start 0
:current 0
:line 1
:tokens @[]})
(defn- at-end?
"Tests if a scanner is at end of input."
[scanner]
(>= (get scanner :current) (get scanner :length)))
(defn- current-char
"Gets the current character of the scanner."
[scanner]
(let [source (get scanner :source)
current (get scanner :current)
length (length source)]
(if (>= current length)
nil
(string/from-bytes (get source current)))))
(defn- advance
"Advances the scanner by a single character."
[scanner]
(update scanner :current inc))
(defn- next-char
"Gets the next character from the scanner."
[scanner]
(let [source (get scanner :source)
current (get scanner :current)
next (inc current)
length (length source)]
(if (>= next length)
nil
(string/from-bytes (get source next)))))
(defn- current-lexeme
[scanner]
(slice (get scanner :source) (get scanner :start) (get scanner :current)))
(defn- char-code [char] (get char 0))
(defn- char-in-range? [start end char]
(and char
(>= (char-code char) (char-code start))
(<= (char-code char) (char-code end))))
(defn- digit? [c]
(char-in-range? "0" "9" c))
(defn- nonzero-digit? [c]
(char-in-range? "1" "9" c))
## for now, use very basic ASCII charset in words
## TODO: research the implications of using the whole
## (defn- alpha? [c] (boolean (re-find #"\p{L}" (string c))))
(defn- alpha? [c]
(or (char-in-range? "a" "z" c) (char-in-range? "A" "Z" c)))
(defn- lower? [c] (char-in-range? "a" "z" c))
(defn- upper? [c] (char-in-range? "A" "Z" c))
## legal characters in words
(def word-chars {"_" true "?" true "!" true "*" true "/" true})
(defn- word-char? [c]
(or (alpha? c) (digit? c) (get word-chars c)))
(defn- whitespace? [c]
(or (= c " ") (= c "\t")))
(def terminators {
":" true
";" true
"\n" true
"{" true
"}" true
"(" true
")" true
"[" true
"]" true
"$" true
"#" true
"-" true
"=" true
"&" true
"," true
">" true
"\"" true})
(defn- terminates? [c]
(or (nil? c) (whitespace? c) (get terminators c)))
(defn- add-token
[scanner token-type &opt literal]
(update scanner :tokens array/push
{:type token-type
:lexeme (current-lexeme scanner)
:literal literal
:line (get scanner :line)
:start (get scanner :start)
:source (get scanner :source)
:input (get scanner :input)}))
## TODO: errors should also be in the vector of tokens
## The goal is to be able to be able to hand this to an LSP?
## Do we need a different structure
(defn- add-error [scanner msg]
(let [token {:type :error
:lexeme (current-lexeme scanner)
:literal nil
:line (get scanner :line)
:start (get scanner :start)
:source (get scanner :source)
:input (get scanner :input)
:msg msg}]
(-> scanner
(update :errors array/push token)
(update :tokens array/push token))))
(defn- add-keyword
[scanner]
(defn recur [scanner key]
(let [char (current-char scanner)]
(cond
(terminates? char) (add-token scanner :keyword (keyword key))
(word-char? char) (recur (advance scanner) (string key char))
:else (add-error scanner (string "Unexpected " char "after keyword :" key)))))
(recur scanner ""))
(defn- add-pkg-kw [scanner]
(defn recur [scanner key]
(let [char (current-char scanner)]
(cond
(terminates? char) (add-token scanner :pkg-kw (keyword key))
(word-char? char) (recur (advance scanner) (string key char))
:else (add-error scanner (string "Unexpected " char " after pkg keyword :" key)))))
(recur scanner ""))
(defn- read-literal [lit] (-> lit parse-all first))
### TODO: consider whether Janet's number rules are right for Ludus
(defn- add-number [char scanner]
(defn recur [scanner num float?]
(let [curr (current-char scanner)]
(cond
(= curr "_") (recur (advance scanner) num float?) ## consume underscores unharmed
(= curr ".") (if float?
(add-error scanner (string "Unexpected second decimal point after " num "."))
(recur (advance scanner) (buffer/push num curr) true))
(terminates? curr) (add-token scanner :number (read-literal num))
(digit? curr) (recur (advance scanner) (buffer/push num curr) float?)
:else (add-error scanner (string "Unexpected " curr " after number " num ".")))))
(recur scanner (buffer char) false))
(def escape {
"\"" "\""
"n" "\n"
"{" "{"
"t" "\t"
"r" "\r"
"\\" "\\"
})
(defn- add-string
[scanner]
(defn recur [scanner buff interpolate?]
(let [char (current-char scanner)]
(case char
"{" (recur (advance scanner) (buffer/push buff char) true)
# allow multiline strings
"\n" (recur (update (advance scanner) :line inc) (buffer/push buff char) interpolate?)
"\"" (add-token (advance scanner) (if interpolate? :interpolated :string) (string buff))
"\\" (let [next (next-char scanner)]
(recur
(advance (advance scanner))
(buffer/push buff (get escape next next))
interpolate?))
(if (at-end? scanner)
(add-error scanner "Unterminated string.")
(recur (advance scanner) (buffer/push buff char) interpolate?)))))
(recur scanner @"" false))
(defn- add-word
[char scanner]
(defn recur [scanner word]
(let [curr (current-char scanner)]
(cond
(terminates? curr) (add-token scanner
(get reserved-words (string word) :word)
(get literal-words (string word) :none))
(word-char? curr) (recur (advance scanner) (buffer/push word curr))
:else (add-error scanner (string "Unexpected " curr " after word " word ".")))))
(recur scanner (buffer char)))
(defn- add-pkg
[char scanner]
(defn recur [scanner pkg]
(let [curr (current-char scanner)]
(cond
(terminates? curr) (add-token scanner :pkg-name :none)
(word-char? curr) (recur (advance scanner) (buffer/push pkg curr))
:else (add-error scanner (string "unexpected " curr " after pkg name " pkg)))))
(recur scanner (buffer char)))
(defn- add-ignored
[scanner]
(defn recur [scanner ignored]
(let [char (current-char scanner)]
(cond
(terminates? char) (add-token scanner :ignored)
(word-char? char) (recur (advance scanner) (buffer/push ignored char))
:else (add-error scanner (string "Unexpected " char " after word " ignored ".")))))
(recur scanner @"_"))
(defn- add-comment [char scanner]
(defn recur [scanner comm]
(let [char (current-char scanner)]
(if (or (= "\n" char) (at-end? scanner))
scanner # for now, we don't do anything with comments; can be added later
(recur (advance scanner) (buffer/push comm char)))))
(recur scanner (buffer char)))
(defn- scan-token [scanner]
(let [char (current-char scanner)
scanner (advance scanner)
next (current-char scanner)]
(case char
## one-character tokens
## :break is a special zero-char token before closing braces
## it makes parsing much simpler
"(" (add-token scanner :lparen)
")" (add-token (add-token scanner :break) :rparen)
"{" (add-token scanner :lbrace)
"}" (add-token (add-token scanner :break) :rbrace)
"[" (add-token scanner :lbracket)
"]" (add-token (add-token scanner :break) :rbracket)
";" (add-token scanner :semicolon)
"," (add-token scanner :comma)
"\n" (add-token (update scanner :line inc) :newline)
"\\" (add-token scanner :backslash)
"=" (add-token scanner :equals)
">" (add-token scanner :pipeline)
## two-character tokens
## ->
"-" (cond
(= next ">") (add-token (advance scanner) :arrow)
(digit? next) (add-number char scanner)
:else (add-error scanner (string "Expected > or negative number after `-`. Got `" char next "`")))
## dict #{
"#" (if (= next "{")
(add-token (advance scanner) :startdict)
(add-error scanner (string "Expected beginning of dict: #{. Got " char next)))
## set ${
"$" (if (= next "{")
(add-token (advance scanner) :startset)
(add-error scanner (string "Expected beginning of set: ${. Got " char next)))
## placeholders
## there's a flat _, and then ignored words
"_" (cond
(terminates? next) (add-token scanner :placeholder)
(alpha? next) (add-ignored scanner)
:else (add-error scanner (string "Expected placeholder: _. Got " char next)))
## comments
## & starts an inline comment
"&" (add-comment char scanner)
## keywords
# XXX: make sure we want only lower-only keywords
":" (cond
(lower? next) (add-keyword scanner)
(upper? next) (add-pkg-kw scanner)
:else (add-error scanner (string "Expected keyword or pkg keyword. Got " char next)))
## splats
"." (let [after_next (current-char (advance scanner))]
(if (= ".." (string next after_next))
(add-token (advance scanner) :splat)
(add-error scanner (string "Expected splat: ... . Got " (string "." next after_next)))))
## strings
"\"" (add-string scanner)
## word matches
(cond
(whitespace? char) scanner ## for now just skip whitespace characters
(digit? char) (add-number char scanner)
(upper? char) (add-pkg char scanner)
(lower? char) (add-word char scanner)
:else (add-error scanner (string "Unexpected character: " char))))))
(defn- next-token [scanner]
(put scanner :start (get scanner :current)))
(defn scan [source &opt input]
(default input :input)
(defn recur [scanner]
(if (at-end? scanner)
(let [scanner (add-token (add-token scanner :break) :eof)]
{:tokens (get scanner :tokens)
:errors (get scanner :errors [])})
(recur (-> scanner (scan-token) (next-token)))))
(recur (new-scanner source input)))
# (comment
(do
(def source " -123 ")
(length ((scan source) :tokens)))

793
src/validate.janet Normal file
View File

@ -0,0 +1,793 @@
### A validator for a Ludus AST
(comment
Tracking here, before I start writing this code, the kinds of validation we're hoping to accomplish:
* [x] ensure called keywords are only called w/ one arg
* [x] first-level property access with pkg, e.g. `Foo :bar`--bar must be on Foo
- [x] accept pkg-kws
* [x] validate dict patterns
* [x] compile string-patterns
* [x] `loop` form arity checking
* [x] arity checking of explicit named function calls
* [x] flag tail calls
* [x] no re-bound names
* [x] no unbound names
* [x] no unbound names with `use` forms
* [x] recur in tail position in `loop` forms
* [x] recur not called outside of `loop` forms
* [x] splats come at the end of list, tuple, and dict patterns
Deferred until a later iteration of Ludus:
* [ ] no circular imports DEFERRED
* [ ] correct imports DEFERRED
* [ ] validate `with` forms
)
(def- package-registry @{})
# (try (os/cd "janet") ([_] nil))
(import ./scanner :as s)
(import ./parser :as p)
(defn- new-validator [parser]
(def ast (parser :ast))
@{:ast ast
:errors @[]
:ctx @{}
:status @{}}
)
(var validate nil)
(def terminals [:number :string :bool :nil :placeholder])
(def simple-colls [:list :tuple :set :args])
(defn- simple-coll [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(set (validator :ast) node)
(validate validator))
validator)
(defn- iff [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(set (validator :ast) node)
(validate validator))
validator)
(defn- script [validator]
(def ast (validator :ast))
(def data (ast :data))
(def status (validator :status))
(set (status :toplevel) true)
(each node data
(set (validator :ast) node)
(validate validator))
validator)
(defn- block [validator]
(def ast (validator :ast))
(def data (ast :data))
(when (= 0 (length data))
(array/push (validator :errors)
{:node ast :msg "blocks may not be empty"})
(break validator))
(def status (validator :status))
(set (status :toplevel) nil)
(def tail? (status :tail))
(set (status :tail) false)
(def parent (validator :ctx))
(def ctx @{:^parent parent})
(set (validator :ctx) ctx)
(for i 0 (-> data length dec)
(set (validator :ast) (data i))
(validate validator))
(set (status :tail) tail?)
(set (validator :ast) (last data))
(validate validator)
(set (validator :ctx) parent)
validator)
(defn- resolve-local [ctx name]
(get ctx name))
(defn- resolve-name [ctx name]
(when (nil? ctx) (break nil))
(def node (get ctx name))
(if node node (resolve-name (get ctx :^parent) name)))
(defn- resolve-name-in-script [ctx name]
(when (ctx :^toplevel) (break nil))
(def node (ctx name))
(if node node (resolve-name-in-script (ctx :^parent) name)))
(defn- word [validator]
(def ast (validator :ast))
(def name (ast :data))
(def ctx (validator :ctx))
(def resolved (resolve-name ctx name))
(when (not resolved)
(array/push (validator :errors)
{:node ast :msg "unbound name"}))
validator)
### patterns
(var pattern nil)
(defn- lett [validator]
(def ast (validator :ast))
(def [lhs rhs] (ast :data))
# evaluate the expression first
# otherwise lhs names will appear bound
(set (validator :ast) rhs)
(validate validator)
(set (validator :ast) lhs)
(pattern validator)
validator)
(defn- splattern [validator]
(def ast (validator :ast))
(def status (validator :status))
(when (not (status :last))
(array/push (validator :errors)
{:node ast :msg "splats may only come last in collection patterns"}))
(def data (ast :data))
(when data
(set (validator :ast) data)
(pattern validator))
validator)
(defn- simple-coll-pattern [validator]
(def ast (validator :ast))
(def data (ast :data))
(when (empty? data) (break validator))
(def status (validator :status))
(for i 0 (-> data length dec)
(set (validator :ast) (get data i))
(pattern validator))
(set (status :last) true)
(set (validator :ast) (last data))
(pattern validator)
(set (status :last) nil)
validator)
(defn- word-pattern [validator]
(def ast (validator :ast))
(def name (ast :data))
(def ctx (validator :ctx))
### XXX TODO: this resolution should ONLY be for userspace, NOT prelude
(def resolved (resolve-name-in-script ctx name))
(when resolved
(def {:line line :input input} resolved)
(array/push (validator :errors)
{:node ast :msg (string "name " name " is already bound on line "
line " of " input)}))
(set (ctx name) ast)
# (pp ctx)
validator)
(def types [
:nil
:bool
:number
:keyword
:string
:set
:tuple
:dict
:list
:fn
:box
:pkg
])
(defn typed [validator]
(def ast (validator :ast))
(def [kw-type word] (ast :data))
(def type (kw-type :data))
(when (not (has-value? types type))
(array/push (validator :errors)
{:node kw-type :msg "unknown type"}))
(set (validator :ast) word)
(pattern validator))
(defn- str-pattern [validator]
(def ast (validator :ast))
(def data (ast :data))
(def last-term (-> data array/pop string))
(def grammar @{})
(def bindings @[])
(var current 0)
(each node data
(when (not (buffer? node))
(set (validator :ast) node)
(pattern validator))
(if (buffer? node)
(set (grammar (keyword current)) (string node))
(do
(set (grammar (keyword current))
~(<- (to ,(keyword (inc current)))))
(array/push bindings (node :data))))
(set current (inc current)))
(set (grammar (keyword current)) ~(* ,last-term -1))
(def rules (map keyword (range (length grammar))))
(set (grammar :main) ~(* ,;rules))
(set (ast :grammar) grammar)
(set (ast :compiled) (peg/compile grammar))
(set (ast :bindings) bindings))
(defn- pair [validator]
(def ast (validator :ast))
(def [_ patt] (ast :data))
(set (validator :ast) patt)
(pattern validator))
(defn- pattern* [validator]
# (print "PATTERN*")
(def ast (validator :ast))
(def type (ast :type))
# (print "validating pattern " type)
(cond
(has-value? terminals type) validator
(case type
:word (word-pattern validator)
:placeholder validator
:ignored validator
:word (word-pattern validator)
:list (simple-coll-pattern validator)
:tuple (simple-coll-pattern validator)
:dict (simple-coll-pattern validator)
:splat (splattern validator)
:typed (typed validator)
:interpolated (str-pattern validator)
:pair (pair validator)
)))
(set pattern pattern*)
# XXX: ensure guard includes only allowable names
# XXX: what to include here? (cf Elixir)
(defn- guard [validator])
(defn- match-clauses [validator clauses]
# (print "validating clauses in match-clauses")
(each clause clauses
(def parent (validator :ctx))
(def ctx @{:^parent parent})
(set (validator :ctx) ctx)
(def [lhs guard rhs] clause)
(set (validator :ast) lhs)
(pattern validator)
# (pp (validator :ctx))
# (pp (validator :ctx))
(when guard
(set (validator :ast) guard)
(validate validator))
(set (validator :ast) rhs)
(validate validator)
(set (validator :ctx) parent)))
(defn- matchh [validator]
# (print "validating in matchh")
(def ast (validator :ast))
(def [to-match clauses] (ast :data))
# (print "validating expression:")
# (pp to-match)
(set (validator :ast) to-match)
(validate validator)
# (print "validating clauses")
(match-clauses validator clauses)
validator)
(defn- declare [validator fnn]
(def status (validator :status))
(def declared (get status :declared @{}))
(set (declared fnn) true)
(set (status :declared) declared)
# (print "declared function " (fnn :name))
# (pp declared)
validator)
(defn- define [validator fnn]
(def status (validator :status))
(def declared (get status :declared @{}))
(set (declared fnn) nil)
(set (status :declared) declared)
# (print "defined function " (fnn :name))
# (pp declared)
validator)
(defn- fnn [validator]
(def ast (validator :ast))
(def name (ast :name))
# (print "function name: " name)
(def status (validator :status))
(def tail? (status :tail))
(set (status :tail) true)
(when name
(def ctx (validator :ctx))
(def resolved (ctx name))
(when (and resolved (not= :nothing (resolved :data)))
(def {:line line :input input} (get-in ctx [name :token]))
(array/push (validator :errors)
{:node ast :msg (string "name is already bound on line " line " of " input)}))
(when (and resolved (= :nothing (resolved :data)))
(define validator resolved))
(set (ctx name) ast))
(def data (ast :data))
(when (= data :nothing)
(break (declare validator ast)))
(match-clauses validator data)
(set (status :tail) tail?)
(def rest-arities @{})
(def arities @{:rest rest-arities})
(each clause data
# (print "CLAUSE:")
# (pp clause)
(def patt (first clause))
(def params (patt :data))
(def arity (length params))
# (print "checking clause with arity " arity)
(def rest-param? (and (> arity 0) (= :splat ((last params) :type))))
(if rest-param?
(set (rest-arities arity) true)
(set (arities arity) true)))
# (pp arities)
(set (ast :arities) arities)
validator)
(defn- box [validator]
(def ast (validator :ast))
(def ctx (validator :ctx))
(def expr (ast :data))
(set (validator :ast) expr)
(validate validator)
(def name (ast :name))
(def resolved (ctx name))
(when resolved
(def {:line line :input input} (get-in ctx [name :token]))
(array/push (validator :errors)
{:node ast :msg (string "name is already bound on line " line " of " input)}))
(set (ctx name) ast)
validator)
(defn- interpolated [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(when (not (buffer? node))
(set (validator :ast) node)
(validate validator))))
### TODO:
# * [ ] ensure properties are on pkgs (if *only* pkgs from root)
(defn- pkg-root [validator]
# (print "validating pkg-root access")
(def ast (validator :ast))
(def ctx (validator :ctx))
(def terms (ast :data))
(def pkg-name ((first terms) :data))
(def the-pkg (resolve-name ctx pkg-name))
(when (not the-pkg)
(array/push (validator :errors)
{:node ast :msg "unbound pkg name"})
(break validator))
(def member (get terms 1))
(def accessed (case (member :type)
:keyword (get-in the-pkg [:pkg (member :data)])
:pkg-kw (get-in the-pkg [:pkg (member :data)])
:args (do
(array/push (validator :errors)
{:node member :msg "cannot call a pkg"}
(break validator)))))
(when (not accessed)
# (print "no member " (member :data) " on " pkg-name)
(array/push (validator :errors)
{:node member :msg "invalid pkg access"})
(break validator))
# TODO: validate nested pkg access
)
# (defn- tail-call [validator]
# (def ast (validator :ast))
# (when (ast :partial) (break validator))
# (def status (validator :status))
# (when (not (status :tail)) (break validator))
# (def data (ast :data))
# (def args (last data))
# (set (args :tail-call) true))
(defn- check-arity [validator]
# (print "CHECKING ARITY")
(def ast (validator :ast))
# (when (ast :partial) (break validator))
(def ctx (validator :ctx))
(def data (ast :data))
(def fn-word (first data))
# (pp fn-word)
(def the-fn (resolve-name ctx (fn-word :data)))
# (print "the called function: " the-fn)
# (pp the-fn)
(when (not the-fn) (break validator))
# (print "the function is not nil")
# (print "the function type is " (type the-fn))
(when (= :function (type the-fn)) (break validator))
(when (= :cfunction (type the-fn)) (break validator))
# (print "the function is not a janet fn")
# (print "fn type: " (the-fn :type))
(when (not= :fn (the-fn :type)) (break validator))
# (print "fn name: " (the-fn :name))
(def arities (the-fn :arities))
# when there aren't arities yet, break, since that means we're making a recursive function call
# TODO: enahnce this so that we can determine arities *before* all function bodies; this ensures arity-checking for self-recursive calls
(when (not arities) (break validator))
# (print "arities: ")
# (pp arities)
(def args (get data 1))
(def num-args (length (args :data)))
# (print "called with #args " num-args)
# (pp (get (validator :ctx) "bar"))
(when (has-key? arities num-args) (break validator))
# (print "arities: ")
# (pp arities)
(when (not arities) (break validator))
(def rest-arities (keys (arities :rest)))
(when (empty? rest-arities)
(array/push (validator :errors)
{:node ast :msg "wrong number of arguments"})
(break validator))
(def rest-min (min ;rest-arities))
(when (< num-args rest-min)
(array/push (validator :errors)
{:node ast :msg "wrong number of arguments"}))
validator)
(defn- kw-root [validator]
(def ast (validator :ast))
(def data (ast :data))
(def [_ args] data)
(when (not= :args (args :type))
(break (array/push (validator :errors)
{:node args :msg "called keyword expects an argument"})))
(when (not= 1 (length (args :data)))
(array/push (validator :errors)
{:node args :msg "called keywords take one argument"})))
(defn- synthetic [validator]
(def ast (validator :ast))
(def data (ast :data))
(def status (validator :status))
(def ftype ((first data) :type))
(def stype ((get data 1) :type))
(def ltype ((last data) :type))
(set (status :pkg-access?) nil)
(when (= ftype :pkg-name)
(set (status :pkg-access?) true))
(each node data
(set (validator :ast) node)
(validate validator))
(set (validator :ast) ast)
# (print "ftype " ftype)
# (print "stype " stype)
# (print "ltype " ltype)
(when (= ftype :pkg-name) (pkg-root validator))
(when (= ftype :keyword) (kw-root validator))
# (when (= ltype :args) (tail-call validator))
(when (and (= ftype :word) (= stype :args))
(check-arity validator))
validator)
(defn- pair [validator]
(def ast (validator :ast))
(def [k v] (ast :data))
(set (validator :ast) k)
(validate validator)
(set (validator :ast) v)
(validate validator))
(defn- splat [validator]
(def ast (validator :ast))
(when (get-in validator [:status :pkg])
(array/push (validator :errors)
{:node ast :msg "splats are not allowed in pkgs"})
(break validator))
(def data (ast :data))
(when data
(set (validator :ast) data)
(validate validator))
validator)
(defn- dict [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(set (validator :ast) node)
(validate validator))
validator)
(defn- whenn [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(def [lhs rhs] node)
(set (validator :ast) lhs)
(validate validator)
(set (validator :ast) rhs)
(validate validator))
validator)
# XXX: do this!
(defn- withh [validator])
# XXX: tail calls in last position
(defn- doo [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(set (validator :ast) node)
(validate validator))
validator)
(defn- usee [validator]
(def ast (validator :ast))
(def data (ast :data))
(set (validator :ast) data)
(validate validator)
(def name (data :data))
(def ctx (validator :ctx))
(def pkg (get-in ctx [name :pkg] @{}))
(loop [[k v] :pairs pkg]
(set (ctx (string k)) v))
validator)
(defn- pkg-entry [validator pkg]
(def ast (validator :ast))
(def status (validator :status))
(when (= :pkg-pair (ast :type))
(set (status :pkg-access?) true))
(def data (ast :data))
(def [key value] (ast :data))
# (print "PKG ENTRY***")
# (pp key)
# (pp value)
(set (validator :ast) key)
(validate validator)
(set (validator :ast) value)
(validate validator)
(def entry (if (= :pkg-name (value :type))
(resolve-name (validator :ctx) (string (value :data)))
value))
# (print "entry at " (key :data))
# (pp entry)
(set (status :pkg-access?) nil)
(def kw (key :data))
# (pp kw)
(set (pkg kw) entry)
# (pp pkg)
validator)
(defn- pkg [validator]
(def ast (validator :ast))
(def data (ast :data))
(def name (ast :name))
(def pkg @{})
(each node data
(set (validator :ast) node)
(pkg-entry validator pkg))
(set (ast :pkg) pkg)
# (print "THE PACKAGE")
# (pp pkg)
(def ctx (validator :ctx))
(set (ctx name) ast)
validator)
(defn- ns [validator]
(def ast (validator :ast))
(def data (ast :data))
(def name (ast :name))
(def parent (validator :ctx))
(def ctx @{:^parent parent})
(def block (data :data))
(each node block
(set (validator :ast) node)
(validate validator))
(set (ast :pkg) ctx)
(set (parent name) ast)
validator)
(defn- loopp [validator]
(def ast (validator :ast))
(def status (validator :status))
(def data (ast :data))
(def input (first data))
# (print "LOOP INPUT")
# (pp input)
(def clauses (get data 1))
(def input-arity (length (input :data)))
(set (ast :arity) input-arity)
# (print "input arity to loop " input-arity)
(set (validator :ast) input)
(validate validator)
# harmonize arities
(def rest-arities @{})
(each clause clauses
# (print "CLAUSE:")
# (pp clause)
(def patt (first clause))
(def params (patt :data))
(def clause-arity (length params))
# (print "checking clause with arity " clause-arity)
(def rest-param? (= :splat (get (last params) :type)))
(when (and
(not rest-param?) (not= clause-arity input-arity))
(array/push (validator :errors)
{:node patt :msg "arity mismatch"}))
(when rest-param?
(set (rest-arities clause-arity) patt)))
# (pp rest-arities)
(loop [[arity patt] :pairs rest-arities]
(when (< input-arity arity)
(array/push (validator :errors)
{:node patt :msg "arity mismatch"})))
(def loop? (status :loop))
(set (status :loop) input-arity)
(def tail? (status :tail))
(set (status :tail) true)
(match-clauses validator clauses)
(set (status :loop) loop?)
(set (status :tail) tail?)
validator)
(defn- recur [validator]
(def ast (validator :ast))
(def status (validator :status))
(def loop-arity (status :loop))
(when (not loop-arity)
(array/push (validator :errors)
{:node ast :msg "recur may only be used inside a loop"})
(break validator))
(def called-with (get-in ast [:data :data]))
(def recur-arity (length called-with))
# (print "loop arity " loop-arity)
# (print "recur arity" recur-arity)
(when (not= recur-arity loop-arity)
(array/push (validator :errors)
{:node ast :msg "recur must have the same number of args as its loop"}))
(when (not (status :tail))
(array/push (validator :errors)
{:node ast :msg "recur must be in tail position"}))
(set (validator :ast) (ast :data))
(validate validator))
(defn- repeatt [validator]
(def ast (validator :ast))
(def [times body] (ast :data))
(set (validator :ast) times)
(validate validator)
(set (validator :ast) body)
(validate validator))
(defn- panic [validator]
(def ast (validator :ast))
(def data (ast :data))
(set (validator :ast) data)
(validate validator))
(defn- testt [validator]
(def ast (validator :ast))
(def [_ body] (ast :data))
(set (validator :ast) body)
(validate validator))
(defn- pkg-name [validator]
(def ast (validator :ast))
(def name (ast :data))
(def ctx (validator :ctx))
(def pkg (resolve-name ctx name))
(when (not pkg)
(array/push (validator :errors)
{:node ast :msg "unbound name"}))
validator)
(defn- pkg-kw [validator]
# (print "validating pkg-kw")
(def ast (validator :ast))
(def pkg-access? (get-in validator [:status :pkg-access?]))
# (print "pkg-access? " pkg-access?)
(when (not pkg-access?)
(array/push (validator :errors)
{:node ast :msg "cannot use pkg-kw here"}))
validator)
(defn- pkg-pair [validator]
# (print "validating pkg-pair")
(def ast (validator :ast))
(def status (validator :status))
(def [_ pkg] (ast :data))
(set (status :pkg-access?) true)
(set (validator :ast) pkg)
(validate validator)
(set (status :pkg-access?) nil)
validator)
(defn- kw [validator]
(def status (validator :status))
(set (status :pkg-access?) nil)
validator)
(defn- validate* [validator]
(def ast (validator :ast))
(def type (ast :type))
# (print "validating node " type)
(cond
(has-value? terminals type) validator
(has-value? simple-colls type) (simple-coll validator)
(case type
:keyword (kw validator)
:if (iff validator)
:let (lett validator)
:script (script validator)
:block (block validator)
:word (word validator)
:fn (fnn validator)
:match (matchh validator)
:interpolated (interpolated validator)
:synthetic (synthetic validator)
:do (doo validator)
:dict (dict validator)
:test (testt validator)
:panic (panic validator)
:repeat (repeatt validator)
:when (whenn validator)
:splat (splat validator)
:pair (pair validator)
:pkg-pair (pkg-pair validator)
:ns (ns validator)
:pkg (pkg validator)
:pkg-name (pkg-name validator)
:pkg-kw (pkg-kw validator)
:use (usee validator)
:loop (loopp validator)
:recur (recur validator)
:box (box validator)
(error (string "unknown node type " type)))))
(set validate validate*)
(defn- cleanup [validator]
(def declared (get-in validator [:status :declared] {}))
(when (any? declared)
(each declaration (keys declared)
(array/push (validator :errors) {:node declaration :msg "declared fn, but not defined"})))
validator)
(defn valid [ast &opt ctx]
(default ctx @{})
(set (ctx :^toplevel) true)
(def validator (new-validator ast))
(def base-ctx @{:^parent ctx})
(set (validator :ctx) base-ctx)
(validate validator)
(cleanup validator))
(import ./base :as b)
# (do
(comment
(def source `
dec (12)
`)
(def scanned (s/scan source))
(def parsed (p/parse scanned))
(def validated (valid parsed b/ctx))
# (get-in validated [:status :declared])
# (validated :ctx)
)

View File

@ -1 +0,0 @@
51500

9
test/judgy.fish Executable file
View File

@ -0,0 +1,9 @@
#!/opt/homebrew/bin/fish
set FILE $argv[1]
set TESTFILE (string join "" $FILE ".tested")
judge $FILE
if test -e $TESTFILE
cp $TESTFILE $FILE
rm $TESTFILE
end

371
test/language.test.janet Normal file
View File

@ -0,0 +1,371 @@
# testing Ludus langauge constructs
(try (os/cd "janet") ([_] nil)) # for REPL
(import /scanner :as s)
(import /parser :as p)
(import /validate :as v)
(import /interpreter :as i)
(import /errors :as e)
(import /base :as b)
(use judge)
(defn run [source]
(def ctx @{})
(def scanned (s/scan source :test))
(when (any? (scanned :errors))
(e/scan-error (scanned :errors)) (error "scanning errors"))
(def parsed (p/parse scanned))
(when (any? (parsed :errors))
(e/parse-error (parsed :errors)) (error "parsing errors"))
(def valid (v/valid parsed ctx))
(when (any? (valid :errors)) (each err (valid :errors)
(e/validation-error err)) (error "validation errors"))
(i/interpret (parsed :ast) ctx))
(deftest "returns bare values from single-line scripts"
(test (run "true") true)
(test (run "false") false)
(test (run "nil") :^nil)
(test (run "12.34") 12.34)
(test (run "-32") -32)
(test (run "0") 0)
(test (run ":foo") :foo)
(test (run ":bar") :bar)
(test (run `"a string, a text, a language"`) "a string, a text, a language"))
(deftest "returns empty collections from single-line scripts"
(test (run "()") [])
(test (run "#{}") @{})
(test (run "${}") @{:^type :set})
(test (run "[]") @[]))
(deftest "returns populated collections from single-line scripts"
(test (run "(1, 2, 3)") [1 2 3])
(test (run "[:a, :b, :c]") @[:a :b :c])
(test (run "${1, 2, 3, 3}") @{1 true 2 true 3 true :^type :set})
(test (run "#{:a 1, :b 2}") @{:a 1 :b 2}))
(deftest "returns nested collections from single-line scripts"
(test (run "((), (1, 2), [:a, (:b)], #{:foo true, :bar false})")
[[]
[1 2]
@[:a [:b]]
@{:bar false :foo true}])
(test (run `#{:foo #{:bar "thing", :baz (1, :foo, nil)}}`) @{:foo @{:bar "thing" :baz [1 :foo :^nil]}}))
(deftest "binds names in let bindings with various patterns"
(test (run `let foo = :bar; foo`) :bar)
(test (run `let 42 = 42`) 42)
(test (run `let foo = :bar; let quux = 42; (foo, quux)`) [:bar 42])
(test (run `let (:ok, value) = (:ok, 42); value`) 42)
(test (run `let #{:a x, ...} = #{:a 1, :b 2}; x`) 1))
(deftest "executes if/then/else properly"
(test (run `if nil then :foo else :bar`) :bar)
(test (run `if false then :foo else :bar`) :bar)
(test (run `if true then :foo else :bar`) :foo)
(test (run `if 42 then :foo else panic! "oops"`) :foo))
(deftest "panics"
(test-error (run `panic! "oops"`)
{:msg "oops"
:node {:data {:data "oops"
:token {:input :test
:lexeme "\"oops\""
:line 1
:literal "oops"
:source "panic! \"oops\""
:start 7
:type :string}
:type :string}
:token {:input :test
:lexeme "panic!"
:line 1
:literal :none
:source "panic! \"oops\""
:start 0
:type :panic}
:type :panic}})
)
(deftest "no match in let panics"
(test-error (run "let :foo = :bar")
{:msg "no match: let binding"
:node {:data @[{:data :foo
:token {:input :test
:lexeme ":foo"
:line 1
:literal :foo
:source "let :foo = :bar"
:start 4
:type :keyword}
:type :keyword}
{:data :bar
:token {:input :test
:lexeme ":bar"
:line 1
:literal :bar
:source "let :foo = :bar"
:start 11
:type :keyword}
:type :keyword}]
:token {:input :test
:lexeme "let"
:line 1
:literal :none
:source "let :foo = :bar"
:start 0
:type :let}
:type :let}
:value :bar})
)
(deftest "blocks execute code and work"
(test (run `
let bar = 12
let foo = {
let bar = 42
let baz = :quux
:foo
}
(foo, bar)
`)
[:foo 12])
(test (run `
let foo = {
let bar = 12
{
let bar = 15
bar
}
}
`)
15))
(deftest "unbound name panics"
(test-error (run `foo`) "validation errors"))
(deftest "rebinding name panics"
(test-error (run `let foo = 42; let foo = 23`) "validation errors"))
(deftest "when forms work as expected"
(test (run `
when {
false -> :nope
nil -> :nope
12 -> :yes
}
`)
:yes)
(test-error (run `
when {
false -> :nope
nil -> :nope
}
`)
{:msg "no match: when form"
:node {:data @[[{:data false
:token {:input :test
:lexeme "false"
:line 2
:literal false
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
:start 12
:type :false}
:type :bool}
{:data :nope
:token {:input :test
:lexeme ":nope"
:line 2
:literal :nope
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
:start 21
:type :keyword}
:type :keyword}]
[{:token {:input :test
:lexeme "nil"
:line 3
:literal :none
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
:start 30
:type :nil}
:type :nil}
{:data :nope
:token {:input :test
:lexeme ":nope"
:line 3
:literal :nope
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
:start 37
:type :keyword}
:type :keyword}]]
:token {:input :test
:lexeme "when"
:line 1
:literal :none
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
:start 2
:type :when}
:type :when}})
)
(deftest "match forms work as expected"
(test (run `
match :foo with {
:bar -> :nope
:baz -> :nope
x -> x
}
`)
:foo)
(test (run `
let foo = 42
match (:ok, foo) with {
(:err, _) -> :nope
(:ok, :foo) -> :nope
(:ok, _) -> :yes
}
`)
:yes)
(test-error (run `
let foo = "foo"
match foo with {
"bar" -> :nope
"baz" -> :nope
12.34 -> :nope
}
`)
{:msg "no match: match form"
:node @{:data [{:data "foo"
:token {:input :test
:lexeme "foo"
:line 2
:literal :none
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 26
:type :word}
:type :word}
@[[{:data "bar"
:token {:input :test
:lexeme "\"bar\""
:line 3
:literal "bar"
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 40
:type :string}
:type :string}
nil
{:data :nope
:token {:input :test
:lexeme ":nope"
:line 3
:literal :nope
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 49
:type :keyword}
:type :keyword}]
[{:data "baz"
:token {:input :test
:lexeme "\"baz\""
:line 4
:literal "baz"
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 58
:type :string}
:type :string}
nil
{:data :nope
:token {:input :test
:lexeme ":nope"
:line 4
:literal :nope
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 67
:type :keyword}
:type :keyword}]
[{:data 12.34
:token {:input :test
:lexeme "12.34"
:line 5
:literal 12.34
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 76
:type :number}
:type :number}
nil
{:data :nope
:token {:input :test
:lexeme ":nope"
:line 5
:literal :nope
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 85
:type :keyword}
:type :keyword}]]]
:match @match-fn
:token {:input :test
:lexeme "match"
:line 2
:literal :none
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 20
:type :match}
:type :match}
:value "foo"})
)
(deftest "string patterns work as expected"
(test (run `let "I {verb} the {noun}" = "I am the walrus"; (verb, noun)`) ["am" "walrus"])
(test (run `let "a {b} c {d}" = "a because I love you c yourself out the door"; (b, d)`)
["because I love you"
"yourself out the door"])
)
(deftest "lambdas may be defined and called"
(test (run `
let foo = fn () -> :foo
foo ()
`)
:foo)
(test (run `
let pair = fn (x, y) -> (x, y)
pair (:foo, :bar)
`)
[:foo :bar])
(test-error (run `
let foo = fn () -> :foo
foo (:bar)
`)
{:called @{:^type :fn
:body [[{:data @[]
:token {:input :test
:lexeme "("
:line 1
:source " let foo = fn () -> :foo\n foo (:bar)\n "
:start 15
:type :lparen}
:type :tuple}
nil
{:data :foo
:token {:input :test
:lexeme ":foo"
:line 1
:literal :foo
:source " let foo = fn () -> :foo\n foo (:bar)\n "
:start 21
:type :keyword}
:type :keyword}]]
:ctx @{}
:match @match-fn}
:msg "no match: function call"
:node {:data "foo"
:token {:input :test
:lexeme "foo"
:line 2
:literal :none
:source " let foo = fn () -> :foo\n foo (:bar)\n "
:start 28
:type :word}
:type :word}
:value [:bar]})
)

View File

@ -1,7 +0,0 @@
(ns ludus.core-test
(:require [clojure.test :refer :all]
[cludus.core :refer :all]))
(deftest a-test
(testing "FIXME, I fail."
(is (= 0 1))))

34
test/prelude.test.janet Normal file
View File

@ -0,0 +1,34 @@
# testing the prelude
(try (os/cd "janet") ([_] nil))
(import /scanner :as s)
(import /parser :as p)
(import /validate :as v)
(import /interpreter :as i)
(import /errors :as e)
(import /base :as b)
(import /load-prelude :as pre)
(use judge)
(defn run [source]
(when (= :error pre/pkg) (error "could not load prelude"))
(def ctx @{:^parent pre/ctx})
(def scanned (s/scan source :test))
(when (any? (scanned :errors))
(e/scan-error (scanned :errors)) (error "scanning errors"))
(def parsed (p/parse scanned))
(when (any? (parsed :errors))
(e/parse-error (parsed :errors)) (error "parsing errors"))
(def valid (v/valid parsed ctx))
(when (any? (valid :errors)) (each err (valid :errors)
(e/validation-error err)) (error "validation errors"))
(i/interpret (parsed :ast) ctx))
(deftest "debug add_msg"
(test (run `
let msgs = [1, :foo, nil]
let msg = do msgs > map (string, _)
msg
`)
@["1" ":foo" ":^nil"])
# (test (run `print! ("foo", "bar")`) :ok)
)

5
test/watchy.fish Executable file
View File

@ -0,0 +1,5 @@
#!/opt/homebrew/bin/fish
set FILE $argv[1]
fd $FILE | entr ./judgy.fish /_

47
tokens
View File

@ -1,47 +0,0 @@
TOKENS:
:nil
:true
:false
:word
:keyword
:number
:string
:as
:cond
:do
:else
:fn
:if
:import
:let
:loop
:ref
:then
:with
:receive
:spawn
:repeat
:test
:when
:lparen
:rparen
:lbrace
:rbrace
:lbracket
:rbracket
:semicolon
:comma
:newline
:backslash
:equals
:pipeline
:rarrow
:startdict
:startstruct
:startset
:splat
:eof

92
turtle-graphics.md Normal file
View File

@ -0,0 +1,92 @@
# Turtle Graphics protocol
name: "turtle-graphics"
version: 0.1.0
### Description
Turtle graphics describe the movements and drawing behaviours of screen, robot, and print "turtles."
* `proto`: `["turtle-graphics", "{version number}"]`
* `data`: an array of arrays; each array represents a turtle command; the first element of a command array is the verb; any subsequent items are the arguments to the verbs.
* Valid arguments are numbers, strings, and booleans.
* Depending on what we end up doing, we may add arrays of these, representing tuples or lists, and/or objects with string keys whose text are well-formed keywords in Ludus. For now, however, arguments must be atomic values.
* E.g., `["forward", 100]`
* Each turtle has its own stream.
* At current, this protocol describes the behaviour of turtle-like objects, all of which "live" in the same "world"; there is not yet a provision for multiple canvases/worlds. That said, an additional field for "world" in at the top level may well be added in the future to allow for multiple worlds to unfold at the same time.
### Verbs and arguments
* `forward`, steps: number
- Moves the turtle forward by the number of steps/pixels.
* `back`, steps: number
- Moves the turtle backwards by the number of steps/pixels.
* `right`, turns: number
- Turns the turtle right by the number of turns. (1 turn = 360 degrees.)
* `left`, turns: number
- Turns the turtle to the left by the number of turns. (1 turn = 360 degrees.)
* `penup`, no arguments
- "Lifts" the turtle's pen, keeping it from drawing.
* `pendown`, no arguments
- "Lowers" the turtle's pen, starting it drawing a path.
* `pencolor`, red: number, green: number, blue: number, alpha: number, OR: color: string
- Sets the turtle's pen's color to the specified RGBA color.
* `penwidth`, width: number
- Sets the width of the turtle's pen, in pixels (or some other metric).
* `home`, no arguments
- Sends the turtle back to its starting point, with a heading of 0.
* `goto`, x: number, y: number
- Sends the turtle to the specified Cartesian coordinates, where the origin is the turtle's starting position.
* `setheading`, heading: number
- Sets the turtle's heading. 0 is the turtle's starting heading, with increasing numbers turning to the right.
* `show`, no arguments
- Shows the turtle.
* `hide`, no arguments
- Hides the turtle.
* `loadstate`, x: number, y: number, heading: number, visible: boolean, pendown: boolean, width: number, color: string OR r: number, g: number, b: number, a: number
- Loads a turtle state.
* `clear`, no arguments
- Erases any paths drawn and sets the background color to the default.
* `background`, red: number, green: number, blue: number, alpha: number
- Sets the background color to the specified RGBA color, OR: color: string
These last two feel a little weird to me, since the background color is more the property of the **world** the turtle is in, not the turtle itself. Worlds with multiple turtles will be set up so that _any_ turtle will be able to change the background, and erase all paths.
That said, since we don't yet have a world abstraction/entity, then there's no other place to put them. This will likely be shifted around in later versions of the protocol.
### Other considerations
**Not all turtles will know how to do all these things.**
The idea is that this single abstraction will talk to all the turtle-like things we eventually use.
That means that some turtles won't be able to do all the things; that's fine!
They just won't do things they can't do; but warnings should go to `stderr`.
**Errors are not passed back to Ludus.**
These are fire-off commands.
Errors should be _reported_ to `stderr` or equivalent.
But Ludus sending things to its output streams should only cause Ludus panics when there's an issue in Ludus.
**Colors aren't always RGBA.**
For pen-and-paper turtles, we don't have RGBA colors.
Colors should also be specifiable with strings corresponding to CSS basic colors: black, silver, gray, white, maroon, red, purple, fuchsia, green, lime, olive, yellow, navy, blue, teal, and aqua.
**Turtles should communicate states.**
Ludus should have access to turtle states.
This is important for push/pop situations that we use for L-systems.
There are two ways to do this: Ludus does its own bookkeeping for turtle states, or it has a way to get the state from a turtle.
The latter has the value of being instantaneous, and gives us an _expected_ state of the turtle after the commands are all processed.
In particular, this will be necessary for the recursive L-systems that require pushing and popping turtle state.
The latter has the drawback of potentially allowing the turtle state and expected turtle state to fall out of synch.
The former has the value of always giving us the correct, actual state of the turtle.
It has the drawback of requiring such state reporting to be asynchronous, and perhaps wildly asynchronous, as things like moving robots and plotters will take quite some time to actually draw what Ludus tells it to.
(Being able to wait until `eq? (expected, actual)` to do anything else may well be extremely useful.)
That suggests, then, that both forms of turtle state are desirable and necessary.
Thus: turtles should communicate states (and thus there ought to be a protocol for communicating state back to Ludus) and Ludus should always do the bookkeeping of calculating the expected state.
**Turtles use Cartesian, rather than screen, coordinates.**
The starting position of the turtle is `(0, 0)`, which is the origin, and _centred_ in the field of view.
Increasing the x-coordinate moves the turtle to the right; increasing the y-coordinate moves the turtle _up_.
**Turtles use compass headings, not mathematical angles.**
Turtles start pointing vertially, at heading `0`.
Turning right _increases_ the heading; pointing due "east" is `0.25`; south `0.5`, and west, `0.75`.