├── bundle ├── info.jdn └── init.janet ├── test-project ├── test │ └── test-hello.janet ├── .gitignore ├── bin │ ├── bin-no-main │ └── bin-with-main ├── hello │ └── init.janet └── project.janet ├── test ├── assets │ └── 17 │ │ └── test.file ├── templates │ ├── hop.temple │ └── hi.temple ├── suite-declare-cc.janet ├── suite-ev-utils.janet ├── suite-mdz.janet ├── suite-zip.janet ├── suite-msg.janet ├── suite-base64.janet ├── suite-rpc.janet ├── suite-htmlgen.janet ├── suite-crc.janet ├── suite-regex.janet ├── suite-pgp.janet ├── suite-netrepl.janet ├── suite-json.janet ├── suite-pm.janet ├── suite-pmfull.janet ├── suite-fmt.janet ├── suite-sh.janet ├── suite-cron.janet ├── suite-cc.janet ├── suite-schema.janet ├── suite-rawterm.janet ├── suite-temple.janet ├── suite-generators.janet ├── suite-infix.janet ├── suite-utf8.janet ├── suite-test.janet ├── suite-tarray.janet ├── suite-argparse.janet ├── suite-randgen.janet └── suite-data.janet ├── examples ├── temple │ ├── templates │ │ ├── hop.temple │ │ ├── hi.temple │ │ └── foo.temple │ └── example.janet ├── tasker.janet ├── mdzrender.janet ├── rpc-server.janet ├── rawterm.janet ├── example.mdz ├── httpf-simple.janet └── cjanet-rpn.janet ├── test-bundle ├── test │ └── test1.janet ├── .gitignore ├── testexec.janet ├── project.janet ├── testmod2.c ├── testmod.c ├── testmod4.c ├── testmod5.cc └── testmod3.cpp ├── doc ├── api │ ├── cmath.mdz │ ├── sh.mdz │ ├── utf8.mdz │ ├── stream.mdz │ ├── channel.mdz │ ├── json.mdz │ ├── tarray.mdz │ ├── rawterm.mdz │ ├── tasker.mdz │ ├── zip.mdz │ ├── ev-utils.mdz │ ├── mdz.mdz │ ├── index.mdz │ ├── build-rules.mdz │ ├── getline.mdz │ ├── pgp.mdz │ ├── math.mdz │ ├── httpf.mdz │ ├── crc.mdz │ ├── services.mdz │ ├── declare-cc.mdz │ ├── cjanet.mdz │ ├── pm.mdz │ ├── fmt.mdz │ ├── msg.mdz │ ├── randgen.mdz │ ├── base64.mdz │ ├── generators.mdz │ ├── rpc.mdz │ ├── cc.mdz │ ├── regex.mdz │ ├── infix.mdz │ ├── path.mdz │ ├── temple.mdz │ ├── cron.mdz │ ├── http.mdz │ ├── argparse.mdz │ ├── schema.mdz │ ├── htmlgen.mdz │ ├── netrepl.mdz │ ├── data.mdz │ └── test.mdz └── index.mdz ├── .gitignore ├── spork ├── version.janet ├── stream.janet ├── init.janet ├── msg.janet ├── channel.janet ├── data.janet ├── generators.janet ├── htmlgen.janet ├── pm-config.janet ├── infix.janet ├── randgen.janet ├── rpc.janet ├── test.janet ├── temple.janet └── ev-utils.janet ├── CHANGELOG.md ├── LICENSE ├── deps └── miniz │ ├── LICENSE │ └── readme.md ├── project.janet ├── bin ├── janet-format └── janet-netrepl ├── .github └── workflows │ └── test.yml ├── README.md ├── src ├── tarray.h ├── base64.c └── utf8.c ├── man └── janet-pm.1 └── tools └── wchar_procunicode.janet /bundle/info.jdn: -------------------------------------------------------------------------------- 1 | {:name "spork"} 2 | -------------------------------------------------------------------------------- /test-project/test/test-hello.janet: -------------------------------------------------------------------------------- 1 | (assert true) 2 | -------------------------------------------------------------------------------- /test-project/.gitignore: -------------------------------------------------------------------------------- 1 | /build 2 | /bundle 3 | /_build 4 | -------------------------------------------------------------------------------- /test/assets/17/test.file: -------------------------------------------------------------------------------- 1 | this is a test file for suite 17 2 | -------------------------------------------------------------------------------- /test-project/bin/bin-no-main: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env janet 2 | 3 | (print "hello") -------------------------------------------------------------------------------- /test-project/hello/init.janet: -------------------------------------------------------------------------------- 1 | (defn hello [arg] 2 | (string/format "hello %s" arg)) -------------------------------------------------------------------------------- /test/templates/hop.temple: -------------------------------------------------------------------------------- 1 | {$ (import ./hi :as hi) $} 2 | {% (hi/render-dict args) %} 3 | -------------------------------------------------------------------------------- /bundle/init.janet: -------------------------------------------------------------------------------- 1 | (use /spork/declare-cc) 2 | (dofile "project.janet" :env (jpm-shim-env)) 3 | -------------------------------------------------------------------------------- /examples/temple/templates/hop.temple: -------------------------------------------------------------------------------- 1 | {$ (import ./hi :as hi) $} 2 | {% (hi/render-dict args) %} 3 | -------------------------------------------------------------------------------- /test-bundle/test/test1.janet: -------------------------------------------------------------------------------- 1 | (import testmod :as testmod) 2 | 3 | (if (not= 5 (testmod/get5)) (error "testmod/get5 failed")) 4 | -------------------------------------------------------------------------------- /test-project/bin/bin-with-main: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env janet 2 | 3 | (import spork) 4 | 5 | (defn- main 6 | [&] 7 | (printf (root-env :syspath))) -------------------------------------------------------------------------------- /test/templates/hi.temple: -------------------------------------------------------------------------------- 1 | {$ (defn myfn [x] (+ x x)) $} 2 | 3 | {{ (myfn (length (range (+ (args :a) (args :b))))) }} 4 | 5 | -------------------------------------------------------------------------------- /doc/api/cmath.mdz: -------------------------------------------------------------------------------- 1 | {:title "cmath" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | ## Reference 6 | 7 | @api-docs("../../spork" "cmath") 8 | -------------------------------------------------------------------------------- /examples/temple/example.janet: -------------------------------------------------------------------------------- 1 | (import spork/temple :as temple) 2 | (temple/add-loader) 3 | (import ./templates/foo :as foo) 4 | (foo/render) 5 | -------------------------------------------------------------------------------- /examples/temple/templates/hi.temple: -------------------------------------------------------------------------------- 1 | {$ (defn myfn [x] (+ x x)) $} 2 | 3 | {{ (myfn (length (range (+ (args :a) (args :b))))) }} 4 | 5 | -------------------------------------------------------------------------------- /test/suite-declare-cc.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/declare-cc) 3 | 4 | (start-suite) 5 | 6 | (assert-docs "/spork/declare-cc") 7 | 8 | (end-suite) 9 | -------------------------------------------------------------------------------- /doc/api/sh.mdz: -------------------------------------------------------------------------------- 1 | {:title "sh" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | Shell utilities for Janet. 6 | 7 | ## Reference 8 | 9 | @api-docs("../../spork" "sh") 10 | -------------------------------------------------------------------------------- /doc/api/utf8.mdz: -------------------------------------------------------------------------------- 1 | {:title "utf8" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | UTF-8 utilities for Janet. 6 | 7 | ## Reference 8 | 9 | @api-docs("../../spork" "utf8") 10 | -------------------------------------------------------------------------------- /test-bundle/.gitignore: -------------------------------------------------------------------------------- 1 | /build 2 | /bundle 3 | /modpath 4 | .cache 5 | .manifests 6 | json.* 7 | jhydro.* 8 | circlet.* 9 | argparse.* 10 | sqlite3.* 11 | path.* 12 | /_build 13 | -------------------------------------------------------------------------------- /doc/api/stream.mdz: -------------------------------------------------------------------------------- 1 | {:title "stream" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | Stream utilities for Janet. 6 | 7 | ## Reference 8 | 9 | @api-docs("../../spork" "stream") 10 | -------------------------------------------------------------------------------- /doc/api/channel.mdz: -------------------------------------------------------------------------------- 1 | {:title "channel" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | Channel utilities for Janet. 6 | 7 | ## Reference 8 | 9 | @api-docs("../../spork" "channel") 10 | -------------------------------------------------------------------------------- /doc/api/json.mdz: -------------------------------------------------------------------------------- 1 | {:title "json" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | JSON encoding and decoding for Janet. 6 | 7 | ## Reference 8 | 9 | @api-docs("../../spork" "json") 10 | -------------------------------------------------------------------------------- /doc/api/tarray.mdz: -------------------------------------------------------------------------------- 1 | {:title "tarray" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | Typed array abstract type. 6 | 7 | ## Reference 8 | 9 | @api-docs("../../spork" "tarray") 10 | 11 | -------------------------------------------------------------------------------- /doc/api/rawterm.mdz: -------------------------------------------------------------------------------- 1 | {:title "rawterm" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | Raw terminal utilities for Janet. 6 | 7 | ## Reference 8 | 9 | @api-docs("../../spork" "rawterm") 10 | -------------------------------------------------------------------------------- /doc/api/tasker.mdz: -------------------------------------------------------------------------------- 1 | {:title "tasker" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | A simple task executor library/server. 6 | 7 | ## Reference 8 | 9 | @api-docs("../../spork" "tasker") 10 | -------------------------------------------------------------------------------- /doc/api/zip.mdz: -------------------------------------------------------------------------------- 1 | {:title "zip" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | Wrapper around miniz for compression functionality. 6 | 7 | ## Reference 8 | 9 | @api-docs("../../spork" "zip") 10 | -------------------------------------------------------------------------------- /doc/api/ev-utils.mdz: -------------------------------------------------------------------------------- 1 | {:title "ev-utils" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | Module for parallel execution utilities with Janet. 6 | 7 | ## Reference 8 | 9 | @api-docs("../../spork" "ev-utils") 10 | -------------------------------------------------------------------------------- /doc/api/mdz.mdz: -------------------------------------------------------------------------------- 1 | {:title "mdz" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | Re-implementation of mendoza markup. Designed to work with htmlgen. 6 | 7 | ## Reference 8 | 9 | @api-docs("../../spork" "mdz") 10 | -------------------------------------------------------------------------------- /doc/api/index.mdz: -------------------------------------------------------------------------------- 1 | {:title "Spork API" 2 | :nav-title "API" 3 | :template "mdzdoc/main.html"} 4 | --- 5 | 6 | ## Index 7 | 8 | @api-index[../../spork] 9 | 10 | ## Reference 11 | 12 | @api-docs[../../spork] 13 | 14 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.tmp 2 | build/ 3 | site/ 4 | /tags 5 | /tasks 6 | temp.janet 7 | _develop 8 | _release 9 | _out 10 | _debug 11 | /tmp 12 | temp.html 13 | temp.mdz 14 | *.a 15 | *.o 16 | *.lib 17 | *.obj 18 | /_build 19 | jpm_tree 20 | .vcvars.jdn 21 | lockfile.jdn 22 | -------------------------------------------------------------------------------- /doc/api/build-rules.mdz: -------------------------------------------------------------------------------- 1 | {:title "build-rules" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | Run commands that produce files in an incremental manner. 6 | Use to implement a build system. 7 | 8 | ## Reference 9 | 10 | @api-docs("../../spork" "build-rules") 11 | 12 | -------------------------------------------------------------------------------- /doc/api/getline.mdz: -------------------------------------------------------------------------------- 1 | {:title "getline" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | Module for fiber-based sequence combinators rather than array-based combinators, as are in the core library. 6 | 7 | ## Reference 8 | 9 | @api-docs("../../spork" "getline") 10 | -------------------------------------------------------------------------------- /doc/api/pgp.mdz: -------------------------------------------------------------------------------- 1 | {:title "pgp" 2 | :author "Josef Pospíšil" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | This module contains PGP utils. For now only PGP words and hexs. 8 | 9 | ## Reference 10 | 11 | @api-docs("../../spork" "pgp") 12 | 13 | -------------------------------------------------------------------------------- /spork/version.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### Update the internal version string 3 | ### 4 | 5 | (def text 6 | "Spork version number as a string `major.minor.patch`" 7 | "1.0.1") 8 | 9 | (def parts 10 | "Spork version number as a tuple (major minor patch)" 11 | [1 0 1]) 12 | -------------------------------------------------------------------------------- /test-bundle/testexec.janet: -------------------------------------------------------------------------------- 1 | (use @build/testmod) 2 | (use @build/testmod2) 3 | (use @build/testmod3) 4 | (use @build/test-mod-4) 5 | (use @build/testmod5) 6 | 7 | (defn main [&] 8 | (print "Hello from executable!") 9 | (print (+ (get5) (get6) (get7) (get8) (get9)))) 10 | -------------------------------------------------------------------------------- /doc/api/math.mdz: -------------------------------------------------------------------------------- 1 | {:title "math" 2 | :author "Josef Pospíšil" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | The math module deals with two main areas of mathematics: statistics and linear algebra. 8 | 9 | ## Reference 10 | 11 | @api-docs("../../spork" "math") 12 | 13 | -------------------------------------------------------------------------------- /doc/api/httpf.mdz: -------------------------------------------------------------------------------- 1 | {:title "httpf" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | A simple, opinionated HTTP framework for HTML, JDN, and JSON servers. 6 | Servers can easily be configured from defn bindings with 7 | appropriate metadata. 8 | 9 | ## Reference 10 | 11 | @api-docs("../../spork" "httpf") 12 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | All notable changes to this project will be documented in this file. 3 | 4 | ## 1.1.1 - 2025-10-10 5 | - Fix `janet-pm quickbin` 6 | - Fix PATH separator in ps activate script 7 | - Prevent nested janet-pm environments on POSIX 8 | 9 | ## 1.0.1 - 2025-09-16 10 | - Initial release 11 | -------------------------------------------------------------------------------- /test/suite-ev-utils.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/ev-utils :as eu) 3 | 4 | (start-suite) 5 | 6 | (var x 0) 7 | (eu/pcall (fn workerf [&] (++ x)) 10) 8 | (assert (= x 10) "pcall 1") 9 | (set x 0) 10 | (eu/pcall (fn workerf [i] (+= x i)) 10) 11 | (assert (= x 45) "pcall 2") 12 | 13 | (end-suite) 14 | -------------------------------------------------------------------------------- /examples/tasker.janet: -------------------------------------------------------------------------------- 1 | (import spork/tasker) 2 | 3 | (def t (tasker/new-tasker)) 4 | 5 | (ev/spawn 6 | (tasker/run-executors t)) 7 | 8 | (tasker/queue-task t ["echo" "hello," "world"]) 9 | (tasker/queue-task t ["echo" "hello," "world"]) 10 | (tasker/queue-task t ["echo" "hello," "world"]) 11 | (tasker/queue-task t ["sleep" "5"]) 12 | -------------------------------------------------------------------------------- /doc/api/crc.mdz: -------------------------------------------------------------------------------- 1 | {:title "crc" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | Generate CRC (Cyclic Redundancy Check) variants. 6 | Rather than compile separate variants, we have code to generate the needed tables. 7 | Keeps build simple, footprint small but with many variants accessible. 8 | 9 | ## Reference 10 | 11 | @api-docs("../../spork" "crc") 12 | -------------------------------------------------------------------------------- /examples/temple/templates/foo.temple: -------------------------------------------------------------------------------- 1 | {$ (def n 20) # Run at template compile time $} 2 | 3 | 4 | {{ (string/repeat "<>" n) # HTML escaped }} 5 | 8 | {- (string/repeat "" n) # No HTML escape -} 9 | 10 | 11 | -------------------------------------------------------------------------------- /test/suite-mdz.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/mdz) 3 | 4 | (start-suite) 5 | (assert-docs "../spork/mdz") 6 | (assert (= [:img {:src "test.jpg" :alt "test"}] 7 | (mdz/image "test.jpg" "test")) "image alt") 8 | 9 | (assert (= [:pre {} "test"] (mdz/pre "test")) "pre string") 10 | (assert (= [:pre {} [:div "test"]] (mdz/pre [:div "test"])) "pre element") 11 | (end-suite) 12 | -------------------------------------------------------------------------------- /examples/mdzrender.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### Render an MDZ document to HTML. 3 | ### Run from the repository root and run `janet examples/mdzrender.janet` 4 | ### to generate a file temp.html in the repository root. 5 | ### 6 | 7 | (import spork/htmlgen) 8 | (import spork/mdz) 9 | 10 | (def mu (mdz/markup (slurp "examples/example.mdz"))) 11 | (def dom (get mu :markup-dom)) 12 | (def html (htmlgen/html dom)) 13 | (spit "temp.html" html) 14 | 15 | -------------------------------------------------------------------------------- /examples/rpc-server.janet: -------------------------------------------------------------------------------- 1 | (import spork/rpc) 2 | 3 | (rpc/server 4 | {:print (fn [self x] (print x)) 5 | :eval (fn [self x] 6 | # By default, server fibers are in an empty 7 | # environment, so eval is pretty much useless 8 | # (compile will almost always fail) 9 | (fiber/setenv 10 | (fiber/current) 11 | (table/setproto @{} root-env)) 12 | (eval x))}) 13 | -------------------------------------------------------------------------------- /doc/api/services.mdz: -------------------------------------------------------------------------------- 1 | {:title "services" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | Module for running a number of background processes in a controlled manner. 6 | Similar to @link[ev-utils.html][ev-utils], but more involved with defaults for IO and naming fibers for debugging purposes. 7 | 8 | Services can also implicitly launch sibling or child services if needed. 9 | 10 | ## Reference 11 | 12 | @api-docs("../../spork" "services") 13 | -------------------------------------------------------------------------------- /doc/api/declare-cc.mdz: -------------------------------------------------------------------------------- 1 | {:title "declare-cc" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | The declare-cc module provides a DSL to the @code`cc` module for compiling C and C++ projects that 8 | eliminates boilerplate, provides incremental builds, and re-implements support for building @code`project.janet` projects outside of JPM. 9 | 10 | ## Reference 11 | 12 | @api-docs("../../spork" "declare-cc") 13 | -------------------------------------------------------------------------------- /doc/api/cjanet.mdz: -------------------------------------------------------------------------------- 1 | {:title "cjanet" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | A DSL that compiles to C. 6 | Improved version of jpm/cgen that is more amenable to Janet integration, macros, and meta-programming. 7 | 8 | The semantics of the language are basically the 9 | same as C so a higher level language (or type system) should be built on top of this. 10 | This IR emits a very useful subset of valid C 99. 11 | 12 | ## Reference 13 | 14 | @api-docs("../../spork" "cjanet") 15 | -------------------------------------------------------------------------------- /doc/api/pm.mdz: -------------------------------------------------------------------------------- 1 | {:title "pm" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | The PM module (short for package manager) contains a number of utilities for downloading 8 | bundles from the internet, managing dependencies, and building projects. It works in tandem 9 | with Janet's built-in @code`bundle/` module, as well as supporting legacy JPM projects on a 10 | best-effort basis. 11 | 12 | ## Reference 13 | 14 | @api-docs("../../spork" "pm") 15 | 16 | -------------------------------------------------------------------------------- /test/suite-zip.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import spork/zip) 3 | 4 | (start-suite) 5 | 6 | (os/mkdir "tmp") 7 | (def file-contents (string/repeat "abc123" 1000)) 8 | (def w (zip/write-file "tmp/out.zip")) 9 | (zip/add-bytes w "file.txt" file-contents) 10 | (zip/writer-finalize w) 11 | (zip/writer-close w) 12 | 13 | (def r (zip/read-file "tmp/out.zip")) 14 | (def bytes (zip/extract r "file.txt")) 15 | (assert (= file-contents (string bytes)) "compress -> decompress round trip") 16 | 17 | (end-suite) 18 | -------------------------------------------------------------------------------- /doc/api/fmt.mdz: -------------------------------------------------------------------------------- 1 | {:title "fmt" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | Provides a way to format Janet code strings and files. 8 | 9 | ## Examples 10 | 11 | ### Strings 12 | 13 | @codeblock[janet]``` 14 | (import spork/fmt) 15 | 16 | (fmt/format "(def a\n 3 )") => @"(def a\n 3)\n" 17 | ``` 18 | 19 | ### Files 20 | 21 | @codeblock[janet]``` 22 | (import spork/fmt) 23 | 24 | (fmt/format-file "main.janet") 25 | ``` 26 | 27 | ## Reference 28 | 29 | @api-docs("../../spork" "fmt") 30 | -------------------------------------------------------------------------------- /examples/rawterm.janet: -------------------------------------------------------------------------------- 1 | (import spork/rawterm) 2 | 3 | (defn on-winch 4 | [rows cols] 5 | (printf "winch - rows: %d, cols: %d" rows cols)) 6 | 7 | (print "press z to quit") 8 | 9 | (defer (rawterm/end) 10 | (rawterm/begin on-winch) 11 | (forever 12 | (def [c] (rawterm/getch)) 13 | (case c 14 | (chr "a") (print "Got an A an for Alan!") 15 | (chr "b") (print "Got a B for Bobby!") 16 | (chr "c") (print "Got a C for Calvin") 17 | (chr "z") (do (print "quitting...") (break)) 18 | (printf "got a %c for something..." c)))) 19 | -------------------------------------------------------------------------------- /test/suite-msg.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/msg) 3 | 4 | (start-suite) 5 | 6 | (defn handler [s] 7 | (def recv (msg/make-recv s)) 8 | (def send (msg/make-send s)) 9 | (while (def msg (recv)) 10 | (assert (= msg "spork") "Message 1") 11 | (send msg))) 12 | 13 | (with [wt (net/server "localhost" 8000 handler)] 14 | (with [s (net/connect "localhost" 8000)] 15 | (def recv (msg/make-recv s)) 16 | (def send (msg/make-send s)) 17 | (send "spork") 18 | (assert (= (recv) "spork") "Message 2"))) 19 | 20 | (end-suite) 21 | -------------------------------------------------------------------------------- /examples/example.mdz: -------------------------------------------------------------------------------- 1 | {:title "Example document"} 2 | --- 3 | 4 | # Header 1 5 | 6 | Bulleted lists only use a hyphen. Lists must come at the beginning of a line. 7 | (Ignoring whitespace). 8 | 9 | ## Header 2 10 | 11 | - abc 12 | - 123 13 | - 456 14 | 15 | @``` 16 | Escape other markup characters here using Janet's long strings. @``\\`` 17 | ``` 18 | 19 | 1. first list element must start with 1. 20 | 2. once upon a time 21 | 3. eat more food! @{ 22 | 1. mested lists 23 | 2. more text 24 | } 25 | 4. @em{Loud!!!} 26 | 27 | 28 | @ul{@li{You can still make lists the long way} 29 | @li{another element}} 30 | -------------------------------------------------------------------------------- /doc/api/msg.mdz: -------------------------------------------------------------------------------- 1 | {:title "msg" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | Provide a symmetric way to send and receive seqential messages over a 8 | networked stream. Useful for building more complicated application 9 | level protocols on top of TCP. 10 | 11 | ## Examples 12 | 13 | @codeblock[janet]``` 14 | (import spork/msg) 15 | 16 | (def stream (net/connect "http://example.com" "1234")) 17 | 18 | (def send (msg/make-send stream)) 19 | (def recv (msg/make-recv stream)) 20 | 21 | (send "blob1") 22 | (def blob-respose (recv)) 23 | ``` 24 | 25 | ## Reference 26 | 27 | @api-docs("../../spork" "msg") 28 | -------------------------------------------------------------------------------- /doc/api/randgen.mdz: -------------------------------------------------------------------------------- 1 | {:title "randgen" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | A small utility for random number generation, especially with a focus on 8 | discrete numbers. The most powerful idea here is the ability to have branches 9 | that execute in a probabilistic manner - i.e. one branch is taken half the time 10 | randomly, and another is taken otherwise. 11 | 12 | ## Example 13 | 14 | @codeblock[janet]``` 15 | # Print either a, b, or c 16 | (import spork/randgen) 17 | (randgen/rand-path 18 | (print "a") 19 | (print "b") 20 | (print "c")) 21 | ``` 22 | 23 | ## Reference 24 | 25 | @api-docs("../../spork" "randgen") 26 | 27 | 28 | -------------------------------------------------------------------------------- /test/suite-base64.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import spork/base64) 3 | 4 | (start-suite) 5 | 6 | (assert-docs "spork/base64") 7 | 8 | (eachp 9 | [decoded encoded] 10 | {"this is a test" "dGhpcyBpcyBhIHRlc3Q=" 11 | "" "" 12 | "f" "Zg==" 13 | "fo" "Zm8=" 14 | "foo" "Zm9v" 15 | "foob" "Zm9vYg==" 16 | "fooba" "Zm9vYmE=" 17 | "foobar" "Zm9vYmFy" 18 | "\x1Cdawdawdadwdaw\xB0" "HGRhd2Rhd2RhZHdkYXew"} 19 | (assert (= (base64/decode encoded) decoded)) 20 | (assert (= (base64/encode decoded) encoded))) 21 | (assert (= "Wrong length: 1" (last (protect (base64/decode "A"))))) 22 | (assert (= "Wrong character: %" (last (protect (base64/decode "A%=="))))) 23 | 24 | (end-suite) 25 | -------------------------------------------------------------------------------- /test/suite-rpc.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/rpc) 3 | 4 | (start-suite) 5 | 6 | (def fns 7 | {:hi (fn [self msg] 8 | (string "Hello " msg))}) 9 | 10 | (with [wt (rpc/server fns "localhost" 8000)] 11 | (with [c (rpc/client "localhost" 8000)] 12 | (assert (= (:hi c "spork") "Hello spork") "RPC client") 13 | # parallel 14 | (ev/gather 15 | (assert (= (:hi c 0) (string "Hello " 0)) "RPC client parallel") 16 | (assert (= (:hi c 1) (string "Hello " 1)) "RPC client parallel") 17 | (assert (= (:hi c 2) (string "Hello " 2)) "RPC client parallel") 18 | (assert (= (:hi c 3) (string "Hello " 3)) "RPC client parallel")))) 19 | 20 | (end-suite) 21 | -------------------------------------------------------------------------------- /test/suite-htmlgen.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/htmlgen :as htmlgen) 3 | 4 | (start-suite) 5 | 6 | (var check-count 0) 7 | (defn check-render 8 | [input expected-output] 9 | (def buf (htmlgen/html input)) 10 | (def msg (string "render check " (++ check-count))) 11 | (assert (= expected-output (string buf)) msg)) 12 | 13 | (check-render "abc" "abc") 14 | (check-render "abc&<>\"'" "abc&<>"'") 15 | (check-render "a b c" "a b c") 16 | (check-render [:div "abc"] "
abc
") 17 | (check-render [:div] "
") 18 | (check-render [:div 123] "
123
") 19 | (check-render [:div {:class "big green"} "thing"] "
thing
") 20 | 21 | (end-suite) 22 | -------------------------------------------------------------------------------- /doc/api/base64.mdz: -------------------------------------------------------------------------------- 1 | {:title "base64" 2 | :author "Josef Pospíšil" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | This module contains Base64 utilities. 8 | 9 | ## Examples 10 | 11 | ### base64/encode 12 | 13 | Converts a string of any format (UTF-8, binary, ..) to base64 encoding. 14 | 15 | @codeblock[janet]``` 16 | (misc/base64/encode "this is a test") 17 | # => "dGhpcyBpcyBhIHRlc3Q=" 18 | ``` 19 | 20 | ### base64/decode 21 | 22 | Converts a base64 encoded string to its binary representation of any format 23 | (UTF-8, binary, ...). 24 | 25 | @codeblock[janet]``` 26 | (misc/base64/decode "dGhpcyBpcyBhIHRlc3Q=") 27 | # => "this is a test" 28 | ``` 29 | 30 | ## Reference 31 | 32 | @api-docs("../../spork" "base64") 33 | -------------------------------------------------------------------------------- /doc/api/generators.mdz: -------------------------------------------------------------------------------- 1 | {:title "generators" 2 | :author "Z. D. Smith" 3 | :license "BSD3" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | A @strong[generator] is an iterable data structure which yields individual values whenever called, potentially until its internal values are exhausted, at which point it's considered @em[dead]. 8 | 9 | This operation makes them very useful for: 10 | 11 | @ul{@li{Asynchronous behaviour} 12 | @li{Memory-sensitive applications, where it's not necessary to keep an entire sequence in memory at once} 13 | @li{Infinite sequences}} 14 | 15 | NB: Certain functions (specifically @code`run` and @code`to-array`) will create an infinite loop if their argument is an infinite generator! 16 | 17 | ## Reference 18 | 19 | @api-docs("../../spork" "generators") 20 | 21 | -------------------------------------------------------------------------------- /doc/api/rpc.mdz: -------------------------------------------------------------------------------- 1 | {:title "rpc" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | A simple remote procedure call tool for Janet. 8 | 9 | ## Server 10 | 11 | @codeblock[janet]``` 12 | (import spork/rpc) 13 | 14 | (def functions 15 | @{:print (fn [self x] (print "remote print: " x)) 16 | :add (fn [self & xs] (sum xs))}) 17 | 18 | (rpc/server functions "127.0.0.1" "9001") 19 | ``` 20 | 21 | 22 | ## Client 23 | 24 | @codeblock[janet]``` 25 | (import spork/rpc) 26 | 27 | (def c (rpc/client "127.0.0.1" "9001" "joe")) 28 | 29 | # Will print on server 30 | (:print c "Hello from client!") 31 | 32 | (:add c 1 3 5 7 9) # -> 25 33 | 34 | # Close the underlying connection 35 | (:close c) 36 | ``` 37 | 38 | ## Reference 39 | 40 | @api-docs("../../spork" "rpc") 41 | 42 | -------------------------------------------------------------------------------- /test/suite-crc.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import spork/crc) 3 | 4 | (start-suite) 5 | 6 | # 8 bit CRCs 7 | (def crc8 (crc/make-variant 8 0x07)) 8 | (assert (= 0x00 (crc8 ""))) 9 | (assert (= 0xA1 (crc8 "abcd"))) 10 | 11 | # 16 bit CRCs 12 | (def crc16/ccitt-false (crc/make-variant 16 0x1021 0xFFFF)) 13 | (def crc16/arc (crc/make-variant 16 0x8005 0x0000 true)) 14 | (assert (= 0x2CF6 (crc16/ccitt-false "abcd"))) 15 | (assert (= 0xFFFF (crc16/ccitt-false ""))) 16 | (assert (= 0xE9D9 (crc16/arc "abcdefg"))) 17 | 18 | # 32 bit CRCs 19 | (def crc32 (crc/make-variant 32 0x04C11DB7 0xFFFFFFFF true 0xFFFFFFFF)) 20 | (def crc32-named (crc/named-variant :crc32)) 21 | (def crc32/bzip2 (crc/make-variant 32 0x04C11DB7 0xFFFFFFFF false 0xFFFFFFFF)) 22 | (assert (= 0 (crc32 "") (crc32-named ""))) 23 | (assert (= 0xED82CD11 (crc32 "abcd"))) 24 | 25 | (end-suite) 26 | -------------------------------------------------------------------------------- /examples/httpf-simple.janet: -------------------------------------------------------------------------------- 1 | (import spork/httpf) 2 | 3 | (defn hello 4 | "Simple hello world route." 5 | {:path "/"} 6 | [&] 7 | "Hello, world!") 8 | 9 | (defn what-time-is-it 10 | "What time is it?" 11 | {:path "/what-time"} 12 | [&] 13 | (ev/sleep 0.1) 14 | @[[:h1 "Current Unix Time"] 15 | [:p (string (os/time))]]) 16 | 17 | (defn post-double 18 | "Post a number and get it back doubled. (also can use GET with ?data=10 for easy testing)." 19 | {:path "/double" 20 | :schema :number} 21 | [req data] 22 | (* data 2)) 23 | 24 | (defn route-static 25 | "Serve some text" 26 | {:path "/text" 27 | :render-mime "text/plain"} 28 | [&] 29 | "Hello, world!<>") 30 | 31 | (defn iterate-directories 32 | "Iterate the current directory." 33 | {:path "/ls"} 34 | [&] 35 | [:ul (seq [dir :in (os/dir ".")] [:li dir])]) 36 | 37 | (-> (httpf/server) 38 | httpf/add-bindings-as-routes 39 | httpf/listen) 40 | -------------------------------------------------------------------------------- /doc/api/cc.mdz: -------------------------------------------------------------------------------- 1 | {:title "cc" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | Improved version of the C Compiler abstraction from JPM that should be more correct, composable, and 6 | have less configuration. 7 | 8 | Wrapper around the system C compiler for compiling Janet native modules and executables. 9 | Opinionated and optimized for use with Janet, and does not actually run 10 | commands unless specified with (dyn *visit*). Also included is package config integration. 11 | Headers, static libraries, and dynamic libraries can all be used from `(dyn *syspath*)`. 12 | 13 | ## Example usage 14 | 15 | @codeblock[janet]``` 16 | (use spork/cc) 17 | 18 | (search-static-libraries "m" "rt" "dl") 19 | (search-dynamic-libraries "janet") 20 | (pkg-config "sdl2" "vulkan") 21 | (with-dyns [*defines* {"GAME_BUILD" "devel-0.0"} 22 | *visit* visit-execute-if-stale] 23 | (compile-and-link-executable "game" "main.c" "sound.c" "graphics.c")) 24 | ``` 25 | 26 | ## Reference 27 | 28 | @api-docs("../../spork" "cc") 29 | -------------------------------------------------------------------------------- /examples/cjanet-rpn.janet: -------------------------------------------------------------------------------- 1 | (import spork/cjanet :as c) 2 | 3 | (c/include ) 4 | 5 | (defn- make-binop 6 | [op] 7 | ~(do 8 | (if (< s 2) (janet_panic "stack empty")) 9 | (-- s) 10 | (set (aref stack (- s 1)) (,(symbol op) (aref stack s) (aref stack (- s 1)))))) 11 | 12 | (c/emit-cfunction 13 | 'rpn :static 14 | "Simple RPN calculator" 15 | ;'[ 16 | [command:cstring] -> double 17 | (def (stack (array double 1024))) 18 | (def s:int 0) 19 | (def (c (* char)) command) 20 | (while (deref c) 21 | (def (oldc (* char)) c) 22 | (def d:double (strtod c (addr c))) 23 | (def x:int (deref c)) 24 | (cond 25 | (not= oldc c) (do (set (aref stack s) d) (++ s)) 26 | (== x ,(chr `+`)) ,(make-binop :+) 27 | (== x ,(chr `-`)) ,(make-binop :-) 28 | (== x ,(chr `*`)) ,(make-binop :*) 29 | (== x ,(chr `/`)) ,(make-binop :/)) 30 | (if (== oldc c) (++ c))) 31 | (return (aref stack (- s 1)))]) 32 | 33 | (c/module-entry "my-module") 34 | -------------------------------------------------------------------------------- /doc/api/regex.mdz: -------------------------------------------------------------------------------- 1 | {:title "regex" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | A module for compiling a subset of regexes to Janet PEGs. 8 | All regex are considered to be anchored, and performance is not going to be competitive with a native regex engine. 9 | 10 | 11 | Supported regex features: 12 | 13 | @ul{ 14 | @li{ single bytes} 15 | @li{ escape characters} 16 | @li{ @code`+`, @code`*`, @code`?`, @code`.`} 17 | @li{ Repetitions, e.g. @code`a{1}`, @code`a{1,3}`. Repetitions are eagerly evaluated.} 18 | @li{ Ranges, e.g. @code`[A-Za-z]`} 19 | @li{ Character classes, inverted character classes, e.g. @code`[abc]`, @code`[^abc]`} 20 | @li{ Alteration (choice), except alteration is ordered, as in pegs -- e.g. @code`a|b|c`} 21 | @li{ Captures using parentheses, e.g. @code`(abc)`} 22 | @li{ Non-capture groups, e.g. @code`(?:abc)`} 23 | } 24 | 25 | Features found in other regex may never be added - for more complex usage, use Janet's native PEG library. 26 | 27 | ## Reference 28 | 29 | @api-docs("../../spork" "regex") 30 | 31 | 32 | -------------------------------------------------------------------------------- /spork/stream.janet: -------------------------------------------------------------------------------- 1 | (defn lines 2 | ``` 3 | Returns a fiber that yields each line from a core/stream value. If separator is not specified, the default separator 4 | is `\n`. After the fiber yields the last line, it returns `nil`. If the fiber is resumed after the stream is closed or 5 | after the fiber returns `nil`, an error is thrown. 6 | ``` 7 | [stream &named separator] 8 | (default separator "\n") 9 | (defn yield-lines 10 | [chunk] 11 | (when-let [idx (string/find separator chunk)] 12 | # Yield the first line 13 | (yield (buffer/slice chunk 0 idx)) 14 | # Eliminate the first line from chunk without creating a new buffer 15 | (def idx+1 (inc idx)) 16 | (buffer/blit chunk chunk 0 idx+1) 17 | (yield-lines (buffer/popn chunk idx+1)))) 18 | (defn fetch-lines 19 | [chunk] 20 | (if (ev/read stream 1024 chunk) 21 | (do 22 | (yield-lines chunk) 23 | (fetch-lines chunk)) 24 | (do 25 | (yield-lines chunk) 26 | (when (not (empty? chunk)) 27 | (yield chunk))))) 28 | (coro (fetch-lines @""))) 29 | -------------------------------------------------------------------------------- /test/suite-regex.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/regex) 3 | 4 | (start-suite) 5 | 6 | (assert (regex/match `abc` `abcdefg`) "match 1") 7 | (assert (regex/match `a.c` `azcdefg`) "match 2") 8 | (assert (regex/match `a\s+c` `a cdefg`) "match 3") 9 | (assert (not (regex/match `a\s+c` `acdefg`)) "match 4") 10 | 11 | (assert (regex/match `(?:abc){4}` "abcabcabcabc") "match 5") 12 | (assert (deep= @["abc" "abc" "abc" "abc"] 13 | (regex/match `(?:(abc)){4}` "abcabcabcabc")) 14 | "match 6") 15 | 16 | (assert (regex/match `\a+` `Xy`) "match 7") 17 | (assert (regex/match `\w+` `Xy0`) "match 8") 18 | (assert (regex/match `cat|dog` "cat") "match 6") 19 | (assert (regex/match `cat|dog` "dog") "match 7") 20 | (assert (not (regex/match `cat|dog` "mouse")) "match 8") 21 | (assert (regex/match `cat|dog|mouse` "mouse") "match 9") 22 | (assert (regex/match `cat|dog|mouse` "cat") "match 10") 23 | (assert (regex/match `cat|dog|mouse` "dog") "match 11") 24 | (assert (regex/match `(cat|dog|mouse)+` "mousecatdog") "match 12") 25 | (assert (regex/match `a(cat|dog|mouse)+` "amousecatdog") "match 13") 26 | 27 | (end-suite) 28 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2022 Calvin Rose and contributors 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of 4 | this software and associated documentation files (the "Software"), to deal in 5 | the Software without restriction, including without limitation the rights to 6 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies 7 | of the Software, and to permit persons to whom the Software is furnished to do 8 | so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in all 11 | copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 19 | SOFTWARE. 20 | -------------------------------------------------------------------------------- /doc/api/infix.mdz: -------------------------------------------------------------------------------- 1 | {:title "infix" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | A macro for infix syntax in Janet. Useful for math. 6 | 7 | ## Examples 8 | 9 | @codeblock[janet]``` 10 | ($$ a + b ** 2) ---> (+ a (math/pow b 2)) 11 | ($$ (a + b) ** 2) ---> (math/pow (+ a b) 2) 12 | ($$ y[2] + y[3]) ---> (+ (in y 2) (in y 3)) 13 | ($$ a > b and ,(good? z)) ---> (and (> a b) (good? z)) 14 | ``` 15 | 16 | ## Syntax 17 | 18 | Syntax is as follows: 19 | 20 | Binary operators <<, >>, >>>, =, !=, <, <=, >, >=, &, ^, bor, band, and, or, 21 | +, -, *, /, %, ** are supported. Operator precedence is in the 22 | `precedence table below (higher means more tightly binding). All 23 | operators are left associative except ** (math/pow), which is right 24 | associative. 25 | 26 | Unary prefix operators !, -, bnot, not, ++, -- are supported. 27 | No unary postfix operators are supported. 28 | 29 | Square brackets can be used for indexing. 30 | 31 | Normal parentheses are used for making subgroups 32 | 33 | You can "escape" infix syntax use a quote or unquote (comma) 34 | 35 | ## Reference 36 | 37 | @api-docs("../../spork" "infix") 38 | -------------------------------------------------------------------------------- /test/suite-pgp.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/pgp) 3 | 4 | (start-suite) 5 | 6 | (assert (string? (pgp/hex->word "01" 0)) "pgp/hex->word returns string") 7 | (assert (= (pgp/hex->word "01" 0) "absurd") "pgp/hex->word returns pgp/word") 8 | (assert (= (pgp/hex->word "0Y" 0) nil) "pgp/hex->word returns nil for wrong hex") 9 | (assert (string? (pgp/word->hex "absurd")) "pgp/hex->word returns string") 10 | (assert (deep= (pgp/hexs->words "01d1 02EE") 11 | @["absurd" "scavenger" "accrue" "universe"]) 12 | "pgp/hex->words returns array of words") 13 | (assert-error "pgp/hex->words errors out on wrong hex" 14 | (pgp/hexs->words "01d1 02YE")) 15 | (assert (nil? (pgp/word->hex "absurdz")) 16 | "pgp/hex->word returns nil for unknown word") 17 | (assert (= (pgp/word->hex "absurd") "01") "pgp/hex->word returns string") 18 | (assert (deep= (pgp/words->hexs "absurd-scavenger accrue_universe upshot.village") 19 | @["01" "D1" "02" "EE" "F4" "F6"]) 20 | "pgp/hex->words returns array of words") 21 | (assert-error "pgp/hex->words errors out when there is unknown pgp/word" 22 | (pgp/words->hexs "absurdz-scavenger accrue_universe")) 23 | 24 | (end-suite) 25 | -------------------------------------------------------------------------------- /deps/miniz/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2013-2014 RAD Game Tools and Valve Software 2 | Copyright 2010-2014 Rich Geldreich and Tenacious Software LLC 3 | 4 | All Rights Reserved. 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in 14 | all copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 22 | THE SOFTWARE. 23 | -------------------------------------------------------------------------------- /test-bundle/project.janet: -------------------------------------------------------------------------------- 1 | (declare-project 2 | :name "testmod") 3 | 4 | (def n1 5 | (declare-native 6 | :name "testmod" 7 | :source @["testmod.c"])) 8 | 9 | (def n2 10 | (declare-native 11 | :name "testmod2" 12 | :source @["testmod2.c"])) 13 | 14 | (def n3 15 | (declare-native 16 | :name "testmod3" 17 | :source @["testmod3.cpp"])) 18 | 19 | (def n4 20 | (declare-native 21 | :name "test-mod-4" 22 | :source @["testmod4.c"])) 23 | 24 | (def n5 25 | (declare-native 26 | :name "testmod5" 27 | :source @["testmod5.cc"])) 28 | 29 | (declare-executable 30 | :name "testexec" 31 | :entry "testexec.janet" 32 | :deps [(n1 :native) 33 | (n2 :native) 34 | (n3 :native) 35 | (n4 :native) 36 | (n5 :native) 37 | (n1 :static) 38 | (n2 :static) 39 | (n3 :static) 40 | (n4 :static) 41 | (n5 :static)]) 42 | 43 | (declare-executable 44 | :name "testexec-static" 45 | :static true 46 | :entry "testexec.janet" 47 | :deps [(n1 :native) 48 | (n2 :native) 49 | (n3 :native) 50 | (n4 :native) 51 | (n5 :native) 52 | (n1 :static) 53 | (n2 :static) 54 | (n3 :static) 55 | (n4 :static) 56 | (n5 :static)]) 57 | -------------------------------------------------------------------------------- /test/suite-netrepl.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/msg) 3 | (import ../spork/netrepl) 4 | 5 | (start-suite) 6 | 7 | (with [wt (netrepl/server "127.0.0.1" "8000")] 8 | (with [s (net/connect "127.0.0.1" "8000")] 9 | (def recv (msg/make-recv s)) 10 | (def send (msg/make-send s)) 11 | (send "test") 12 | 13 | (assert (= (recv) "test:1: ") "Prompt 1") 14 | (send "(+ 1 2)\n") 15 | (assert (= (recv) "\e[32m3\e[0m\n") "Result 1") 16 | 17 | (assert (= (recv) "test:2: ") "Prompt 2") 18 | (send "\xFF(parser/where (dyn :parser) 100)") 19 | (assert (= (recv) "(true (100 0))") "Response 2") 20 | (send "(+ 1 2)\n") 21 | (assert (= (recv) "\e[32m3\e[0m\n") "Result 2") 22 | 23 | (assert (= (recv) "test:101: ") "Prompt 3") 24 | (send "\xFEcancel") 25 | (assert (= (recv) nil) "Response 3") 26 | 27 | (assert (= (recv) "test:101: ") "Prompt 4") 28 | (send "\xFEsource \"foobar.janet\"") 29 | (assert (= (recv) nil) "Response 4") 30 | 31 | (assert (= (recv) "test:101: ") "Prompt 5") 32 | (send "(def foo :bar)\n") 33 | (assert (= (recv) "\e[33m:bar\e[0m\n") "Result 5") 34 | 35 | (assert (= (recv) "test:102: ") "Prompt 6") 36 | (send "(get (dyn 'foo) :source-map)\n") 37 | (assert (= (recv) "(\e[35m\"foobar.janet\"\e[0m \e[32m101\e[0m \e[32m1\e[0m)\n") "Result 6") 38 | 39 | (assert (= (recv) "test:103: ") "Prompt 7"))) 40 | 41 | (end-suite) 42 | -------------------------------------------------------------------------------- /test-project/project.janet: -------------------------------------------------------------------------------- 1 | (declare-project 2 | :name "test-project" 3 | :description "Janet project to test pre/post steps" 4 | :version "0.0.1" 5 | :dependencies []) 6 | 7 | (declare-source 8 | :source @["hello"]) 9 | 10 | (declare-binscript 11 | :main "bin/bin-no-main" 12 | :hardcode-syspath true 13 | :is-janet true) 14 | 15 | (declare-binscript 16 | :main "bin/bin-with-main" 17 | :hardcode-syspath true 18 | :is-janet true) 19 | 20 | (task "pre-build" ["pre-build-test"]) 21 | (task "post-build" ["post-build-test"]) 22 | 23 | (task "pre-check" ["pre-check-test"]) 24 | (task "post-check" ["post-check-test"]) 25 | 26 | (task "pre-install" ["pre-install-test"]) 27 | (task "post-install" ["post-install-test"]) 28 | 29 | (task "pre-clean" ["pre-clean-test"]) 30 | (task "post-clean" ["post-clean-test"]) 31 | 32 | (task "pre-build-test" [] 33 | (printf "****** pre-build")) 34 | 35 | (task "post-build-test" [] 36 | (printf "****** post-build")) 37 | 38 | (task "pre-check-test" [] 39 | (printf "****** pre-check")) 40 | 41 | (task "post-check-test" [] 42 | (printf "****** post-check")) 43 | 44 | (task "pre-install-test" [] 45 | (printf "****** pre-install")) 46 | 47 | (task "post-install-test" [] 48 | (printf "****** post-install")) 49 | 50 | (task "pre-clean-test" [] 51 | (printf "****** pre-clean")) 52 | 53 | (task "post-clean-test" [] 54 | (printf "****** post-clean")) 55 | -------------------------------------------------------------------------------- /doc/api/path.mdz: -------------------------------------------------------------------------------- 1 | {:title "path" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | Simple path manipulation module for Janet. Supports manipulation both 8 | windows and posix paths on any platform, and provides functions that 9 | work according to the current host platform. 10 | 11 | All functions have three forms, under @code`path`, @code`path/win`, and 12 | @code`path/posix`. The prefix indicates which type of path the function 13 | manipulates. 14 | 15 | ## Example 16 | 17 | @codeblock[janet]``` 18 | 19 | (import spork/path) 20 | 21 | # Examples for a non-windows system, use path/win/ for windows and 22 | # path/posix/ for posix. 23 | 24 | (path/ext "my/long/path.txt") # -> ".txt" 25 | path/sep # -> "/" on posix, "\\" on windows 26 | path/delim # -> ":" on posix, ";" on windows 27 | (path/basename "some/path.txt") # -> "path.txt" 28 | (path/dirname "some/path.txt") # -> "some/" 29 | (path/parts "some/path/file.txt") # -> ["some" "path" "file.txt"] 30 | (path/normalize "some/.././thing/file.txt") # -> "thing/file.txt" 31 | (path/join "some/path" "../thing/file.txt") # -> "some/thing/file.txt" 32 | (path/abspath? "/home/blah") # -> true 33 | (path/abspath "file.txt") # -> "/home/me/cwd/file.txt" 34 | (path/relpath 35 | "a/nested/directory/with/a/few/children" 36 | "a/nested/directory/with/different/children") # -> "../../../different/children" 37 | ``` 38 | 39 | ## Reference 40 | 41 | @api-docs("../../spork" "path") 42 | -------------------------------------------------------------------------------- /test/suite-json.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import spork/json :as json) 3 | 4 | (start-suite) 5 | 6 | (defn check-object [x &opt z] 7 | (default z x) 8 | (def y (json/decode (json/encode x))) 9 | (def y1 (json/decode (json/encode x " " "\n"))) 10 | (assert (deep= z y) (string/format "failed roundtrip 1: %p" x)) 11 | (assert (deep= z y1) (string/format "failed roundtrip 2: %p" x))) 12 | 13 | (check-object 1) 14 | (check-object 100) 15 | (check-object true) 16 | (check-object false) 17 | (check-object (range 1000)) 18 | (check-object @{"two" 2 "four" 4 "six" 6}) 19 | (check-object @{"hello" "world"}) 20 | (check-object @{"john" 1 "billy" "joe" "a" @[1 2 3 4 -1000]}) 21 | (check-object @{"john" 1 "∀abcd" "joe" "a" @[1 2 3 4 -1000]}) 22 | (check-object 23 | "ᚠᛇᚻ᛫ᛒᛦᚦ᛫ᚠᚱᚩᚠᚢᚱ᛫ᚠᛁᚱᚪ᛫ᚷᛖᚻᚹᛦᛚᚳᚢᛗ 24 | ᛋᚳᛖᚪᛚ᛫ᚦᛖᚪᚻ᛫ᛗᚪᚾᚾᚪ᛫ᚷᛖᚻᚹᛦᛚᚳ᛫ᛗᛁᚳᛚᚢᚾ᛫ᚻᛦᛏ᛫ᛞᚫᛚᚪᚾ 25 | ᚷᛁᚠ᛫ᚻᛖ᛫ᚹᛁᛚᛖ᛫ᚠᚩᚱ᛫ᛞᚱᛁᚻᛏᚾᛖ᛫ᛞᚩᛗᛖᛋ᛫ᚻᛚᛇᛏᚪᚾ᛬") 26 | (check-object @["šč"]) 27 | (check-object "👎") 28 | 29 | # Decoding utf-8 strings 30 | (assert (deep= "šč" (json/decode `"šč"`)) "did not decode utf-8 string correctly") 31 | 32 | # Recursion guard 33 | (def one @{:links @[]}) 34 | (def two @{:links @[one]}) 35 | (array/push (one :links) two) 36 | (def objects @{:one one :two two}) 37 | (assert-error "error on cycles" (json/encode objects)) 38 | 39 | # null values 40 | (check-object @{"result" :null}) 41 | (check-object {"result" :null} @{"result" :null}) 42 | (check-object :null) 43 | (check-object nil :null) 44 | 45 | (end-suite) 46 | -------------------------------------------------------------------------------- /doc/api/temple.mdz: -------------------------------------------------------------------------------- 1 | {:title "temple" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | HTML templates for Janet. 8 | 9 | Simplified version of Mendoza's template system that is cleaner and 10 | easier to use. Templates can be used recursively, and output is 11 | printed via @code`print`, so goes to @code`(dyn :out)`. 12 | 13 | Expands on the mendoza templates with the @code`{-` ... @code`-}` 14 | brackets, which do non-escaped substitution, so temple can be used for 15 | formats besides HTML. Also exposes the @code`escape` function inside 16 | templates for HTML escaping if you want to manually print to template 17 | output. 18 | 19 | 20 | ## Example 21 | 22 | ### foo.temple 23 | 24 | @codeblock``` 25 | {$ (def n 20) # Run at template compile time $} 26 | 27 | 28 | {{ (string/repeat "<>" n) # HTML escaped }} 29 | 32 | {- (string/repeat "1" n) # Not HTML escaped -} 33 | 34 | 35 | ``` 36 | 37 | ### main.janet 38 | 39 | @codeblock[janet]``` 40 | (import temple) 41 | (temple/add-loader) 42 | 43 | (import ./foo :as foo) 44 | (foo/render :a "hello") 45 | ``` 46 | 47 | There is one more involved example in 48 | /janet-lang/spork/examples/temple/. You can run it with 49 | @code`janet examples/temple/example.janet`. 50 | 51 | ## Reference 52 | 53 | @api-docs("../../spork" "temple") 54 | 55 | -------------------------------------------------------------------------------- /test/suite-pm.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/pm) 3 | (import ../spork/pm-config) 4 | (import ../spork/sh) 5 | 6 | (start-suite) 7 | 8 | (assert true) # smoke test 9 | (assert-docs "/spork/pm") 10 | 11 | # Copy since not exposed in boot.janet 12 | (defn- bundle-rpath 13 | [path] 14 | (string/replace-all "\\" "/" (os/realpath path))) 15 | 16 | (defn randdir 17 | "Get a random directory name" 18 | [] 19 | (string (os/cwd) "/tmp/tmp_dir_" (slice (string (math/random) ".tmp") 2))) 20 | 21 | # Create a temporary directory for our janet tree 22 | (math/seedrandom (os/cryptorand 16)) 23 | (def syspath (randdir)) 24 | (sh/rm syspath) 25 | (os/mkdir "tmp") 26 | (assert (os/mkdir syspath)) 27 | (pm-config/read-env-variables root-env) 28 | (put root-env :build-dir nil) # jpm test sets this and it messes things up 29 | (defer (sh/rm "tmp") 30 | (put root-env *syspath* (bundle-rpath syspath)) 31 | (put root-env :binpath (string syspath "/bin")) 32 | (put root-env :manpath (string syspath "/man")) 33 | (unless (os/getenv "VERBOSE") 34 | (setdyn *out* @"")) 35 | (assert (empty? (bundle/list)) "initial bundle/list") 36 | (assert (empty? (bundle/topolist)) "initial bundle/topolist") 37 | (sh/rm "./test-bundle/bundle") 38 | (sh/rm "./test-bundle/build") 39 | (sh/rm "./test-bundle/_build") 40 | 41 | # Check our project.janet based bundle 42 | (pm/pm-install "file::.") # install spork 43 | (pm/pm-install "file::./test-bundle") 44 | (assert (= 2 (length (bundle/list))) "bundle/list after install")) 45 | 46 | (end-suite) 47 | -------------------------------------------------------------------------------- /test/suite-pmfull.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/pm) 3 | (import ../spork/pm-config) 4 | (import ../spork/sh) 5 | 6 | (start-suite) 7 | 8 | (def enabled (= "1" (os/getenv "SPORK_TEST_ALL_PACKAGES"))) 9 | 10 | # Copy since not exposed in boot.janet 11 | (defn- bundle-rpath 12 | [path] 13 | (string/replace-all "\\" "/" (os/realpath path))) 14 | 15 | (defn randdir 16 | "Get a random directory name" 17 | [] 18 | (string "/tmp/tmp_dir_" (slice (string (math/random) ".tmp") 2))) 19 | 20 | (unless enabled (print "set SPORK_TEST_ALL_PACKAGES=1 to run full pm testing.")) 21 | (when enabled 22 | (assert true) # smoke test 23 | (assert-docs "/spork/pm") 24 | (math/seedrandom (os/cryptorand 16)) 25 | (def syspath (randdir)) 26 | (sh/rm syspath) 27 | (os/mkdir "tmp") 28 | (assert (os/mkdir syspath)) 29 | (pm-config/read-env-variables root-env) 30 | (put root-env *syspath* (bundle-rpath syspath)) 31 | (put root-env :binpath (string (dyn *syspath*) "/bin")) 32 | (put root-env :manpath (string (dyn *syspath*) "/man")) 33 | (defer (sh/rm syspath) 34 | (unless (os/getenv "VERBOSE") 35 | (setdyn *out* @"")) 36 | (assert (empty? (bundle/list)) "initial bundle/list") 37 | (assert (empty? (bundle/topolist)) "initial bundle/topolist") 38 | (pm/pm-install "file::.") # install spork 39 | (pm/pm-install "file::./test-bundle") 40 | (pm/pm-install "pkgs") 41 | (pm/pm-install "circlet") 42 | (pm/pm-install "joy") 43 | (pm/pm-install "sqlite3") 44 | (pm/pm-install "jhydro"))) 45 | 46 | (end-suite) 47 | -------------------------------------------------------------------------------- /test/suite-fmt.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/fmt) 3 | 4 | (start-suite) 5 | 6 | # only testing format-print as other fns are dependent on it 7 | (do 8 | (def res 9 | (capture-stdout 10 | (fmt/format-print "(\n print\n \"HOHOHO\")"))) 11 | (assert (= res [nil "(print\n \"HOHOHO\")\n"]) "format-print")) 12 | 13 | # regresion with comment in the collection literals 14 | (do 15 | (def res 16 | (capture-stdout 17 | (fmt/format-print "{:a 0\n:b 1 # test comment\n}"))) 18 | (assert (= res [nil "{:a 0\n :b 1 # test comment\n}\n"]) "format-print comment in collection 1")) 19 | 20 | (do 21 | (def res 22 | (capture-stdout 23 | (fmt/format-print "[:a 0\n:b\n# test comment\n]"))) 24 | (assert (= res [nil "[:a 0\n :b\n # test comment\n]\n"]) "format-print comment in collection 2")) 25 | 26 | (do 27 | (def res 28 | (capture-stdout 29 | (fmt/format-print "()"))) 30 | (assert (= res [nil "()\n"]) "format-print empty form")) 31 | 32 | (do 33 | (def res 34 | (capture-stdout 35 | (fmt/format-print "( )"))) 36 | (assert (= res [nil "()\n"]) "format-print empty form with whitespace")) 37 | 38 | (do 39 | (def res 40 | (capture-stdout 41 | (fmt/format-print "# a comment"))) 42 | (assert (= res [nil "# a comment\n\n"]) "format-print only comment")) 43 | 44 | (do 45 | (def res 46 | (capture-stdout 47 | (try 48 | (fmt/format-print "print )") 49 | ([err] (print "error"))))) 50 | (assert (= res [nil "error\n"]) "format-print errors with unbalanced parenthesis")) 51 | 52 | (end-suite) 53 | -------------------------------------------------------------------------------- /spork/init.janet: -------------------------------------------------------------------------------- 1 | # make (use spork) useful 2 | 3 | (import ./argparse :export true) 4 | (import ./build-rules :export true) 5 | (import ./cc :export true) 6 | (import ./channel :export true) 7 | (import ./cjanet :export true) 8 | (import ./cron :export true) 9 | (import ./data :export true) 10 | (import ./declare-cc :export true) 11 | (import ./ev-utils :export true) 12 | (import ./fmt :export true) 13 | (import ./generators :export true) 14 | (import ./getline :export true) 15 | (import ./htmlgen :export true) 16 | (import ./http :export true) 17 | (import ./httpf :export true) 18 | (import ./infix :export true) 19 | (import ./math :export true) 20 | (import ./mdz :export true) 21 | (import ./misc :export true) 22 | (import ./msg :export true) 23 | (import ./netrepl :export true) 24 | (import ./path :export true) 25 | (import ./pgp :export true) 26 | (import ./pm :export true) 27 | (import ./pm-config :export true) 28 | (import ./randgen :export true) 29 | (import ./regex :export true) 30 | (import ./rpc :export true) 31 | (import ./schema :export true) 32 | (import ./services :export true) 33 | (import ./sh :export true) 34 | (import ./stream :export true) 35 | (import ./tasker :export true) 36 | (import ./temple :export true) 37 | (import ./test :export true) 38 | (import ./version :export true) 39 | 40 | # native dependencies 41 | (import spork/base64 :export true) 42 | (import spork/cmath :export true) 43 | (import spork/crc :export true) 44 | (import spork/json :export true) 45 | (import spork/rawterm :export true) 46 | (import spork/tarray :export true) 47 | (import spork/utf8 :export true) 48 | (import spork/zip :export true) 49 | -------------------------------------------------------------------------------- /test-bundle/testmod2.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2025 Calvin Rose and contributors 3 | * 4 | * Permission is hereby granted, free of charge, to any person obtaining a copy 5 | * of this software and associated documentation files (the "Software"), to 6 | * deal in the Software without restriction, including without limitation the 7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or 8 | * sell copies of the Software, and to permit persons to whom the Software is 9 | * furnished to do so, subject to the following conditions: 10 | * 11 | * The above copyright notice and this permission notice shall be included in 12 | * all copies or substantial portions of the Software. 13 | * 14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 20 | * IN THE SOFTWARE. 21 | */ 22 | 23 | /* A very simple native module */ 24 | 25 | #include 26 | 27 | static Janet cfun_get_six(int32_t argc, Janet *argv) { 28 | (void) argv; 29 | janet_fixarity(argc, 0); 30 | return janet_wrap_number(6.0); 31 | } 32 | 33 | static const JanetReg array_cfuns[] = { 34 | {"get6", cfun_get_six, NULL}, 35 | {NULL, NULL, NULL} 36 | }; 37 | 38 | JANET_MODULE_ENTRY(JanetTable *env) { 39 | janet_cfuns(env, NULL, array_cfuns); 40 | } 41 | -------------------------------------------------------------------------------- /test-bundle/testmod.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2025 Calvin Rose and contributors 3 | * 4 | * Permission is hereby granted, free of charge, to any person obtaining a copy 5 | * of this software and associated documentation files (the "Software"), to 6 | * deal in the Software without restriction, including without limitation the 7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or 8 | * sell copies of the Software, and to permit persons to whom the Software is 9 | * furnished to do so, subject to the following conditions: 10 | * 11 | * The above copyright notice and this permission notice shall be included in 12 | * all copies or substantial portions of the Software. 13 | * 14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 20 | * IN THE SOFTWARE. 21 | */ 22 | 23 | /* A very simple native module */ 24 | 25 | #include 26 | 27 | static Janet cfun_get_five(int32_t argc, Janet *argv) { 28 | (void) argv; 29 | janet_fixarity(argc, 0); 30 | return janet_wrap_number(5.0); 31 | } 32 | 33 | static const JanetReg array_cfuns[] = { 34 | {"get5", cfun_get_five, NULL}, 35 | {NULL, NULL, NULL} 36 | }; 37 | 38 | JANET_MODULE_ENTRY(JanetTable *env) { 39 | janet_cfuns(env, NULL, array_cfuns); 40 | } 41 | -------------------------------------------------------------------------------- /test-bundle/testmod4.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2025 Calvin Rose and contributors 3 | * 4 | * Permission is hereby granted, free of charge, to any person obtaining a copy 5 | * of this software and associated documentation files (the "Software"), to 6 | * deal in the Software without restriction, including without limitation the 7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or 8 | * sell copies of the Software, and to permit persons to whom the Software is 9 | * furnished to do so, subject to the following conditions: 10 | * 11 | * The above copyright notice and this permission notice shall be included in 12 | * all copies or substantial portions of the Software. 13 | * 14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 20 | * IN THE SOFTWARE. 21 | */ 22 | 23 | /* A very simple native module */ 24 | 25 | #include 26 | 27 | static Janet cfun_get_eight(int32_t argc, Janet *argv) { 28 | (void) argv; 29 | janet_fixarity(argc, 0); 30 | return janet_wrap_number(8.0); 31 | } 32 | 33 | static const JanetReg array_cfuns[] = { 34 | {"get8", cfun_get_eight, NULL}, 35 | {NULL, NULL, NULL} 36 | }; 37 | 38 | JANET_MODULE_ENTRY(JanetTable *env) { 39 | janet_cfuns(env, NULL, array_cfuns); 40 | } 41 | -------------------------------------------------------------------------------- /doc/api/cron.mdz: -------------------------------------------------------------------------------- 1 | {:title "cron" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | Timer library for interfacing with the UNIX crontab format. 6 | 7 | The cron format support is based on the unix cron syntax, with an optional seconds field. 8 | Each field can be a comma separated list of individual values or a range of values. 9 | 10 | A range has three variants as follows: 11 | @ol{ 12 | @li{Two values with a "-" between them, optionally followed by a "/" and a step value.} 13 | @li{An asterisk ("*") followed by a "/" and a step value. This implies every "step" value.} 14 | @li{A single value followed by a "/" and a step value. This implies every "step" value starting with the single value. I.e., 2/3 implies every 3 units from 2 to max units.}} 15 | 16 | A single asterisk ("*") can be used to denote all possible values. 17 | 18 | The fields: 19 | @ul{ 20 | @li{minutes: 0-5 } 21 | @li{hours: 0-2 } 22 | @li{day of month: 1-3 } 23 | @li{month: 1-12. Also allowed are the following month codes in any case } 24 | jan,feb,mar,apr,may,jun,jul,aug,sep,oct,nov,dec 25 | @li{day of week: 0-7, where 0 or 7 is sunday, monday is 1, etc. allows the following day codes (any case)} 26 | sun,mon,tue,wed,thu,fri,sat 27 | @li{ seconds (optional): 0-5}} 28 | 29 | Cron schedules are represented as tuples of 7 values, a string representation, followed 30 | by 6 bitmaps representing matching timestamps. Bitmaps are represented as any byte sequence. 31 | 32 | @codeblock`[string-rep minutes hours day-of-month month day-of-week seconds]` 33 | 34 | Note that we have second precision here as opposed to minute precision. 35 | 36 | ## Reference 37 | 38 | @api-docs("../../spork" "cron") 39 | -------------------------------------------------------------------------------- /project.janet: -------------------------------------------------------------------------------- 1 | (declare-project 2 | :name "spork" 3 | :description "Official contrib library of various Janet utility modules." 4 | :author "Calvin Rose" 5 | :license "MIT" 6 | :dependencies [] 7 | :url "https://github.com/janet-lang/spork" 8 | :repo "git+https://github.com/janet-lang/spork") 9 | 10 | (declare-source 11 | :source @["spork"]) 12 | 13 | # Scripts 14 | 15 | (declare-binscript 16 | :main "bin/janet-format" 17 | :hardcode-syspath true 18 | :is-janet true) 19 | 20 | (declare-binscript 21 | :main "bin/janet-netrepl" 22 | :hardcode-syspath true 23 | :is-janet true) 24 | 25 | (declare-binscript 26 | :main "bin/janet-pm" 27 | :hardcode-syspath :dynamic # allow for JANET_PATH=new_module_tree 28 | :is-janet true) 29 | 30 | # Manual pages 31 | 32 | (declare-manpage "man/janet-pm.1") 33 | 34 | # Natives 35 | 36 | (declare-native 37 | :name "spork/json" 38 | :source @["src/json.c"]) 39 | 40 | (declare-native 41 | :name "spork/rawterm" 42 | :source @["src/rawterm.c"]) 43 | 44 | (declare-native 45 | :name "spork/crc" 46 | :source @["src/crc.c"]) 47 | 48 | (declare-native 49 | :name "spork/utf8" 50 | :source @["src/utf8.c"]) 51 | 52 | (declare-native 53 | :name "spork/tarray" 54 | :headers @["src/tarray.h"] 55 | :source @["src/tarray.c"]) 56 | 57 | (declare-headers 58 | :headers ["src/tarray.h"]) 59 | 60 | (declare-native 61 | :name "spork/zip" 62 | :source @["src/zip.c" "deps/miniz/miniz.c"] 63 | :defines @{"_LARGEFILE64_SOURCE" true} 64 | :headers @["deps/miniz/miniz.h"]) 65 | 66 | (declare-native 67 | :name "spork/cmath" 68 | :source @["src/cmath.c"]) 69 | 70 | (declare-native 71 | :name "spork/base64" 72 | :source @["src/base64.c"]) 73 | -------------------------------------------------------------------------------- /test-bundle/testmod5.cc: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2025 Calvin Rose and contributors 3 | * 4 | * Permission is hereby granted, free of charge, to any person obtaining a copy 5 | * of this software and associated documentation files (the "Software"), to 6 | * deal in the Software without restriction, including without limitation the 7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or 8 | * sell copies of the Software, and to permit persons to whom the Software is 9 | * furnished to do so, subject to the following conditions: 10 | * 11 | * The above copyright notice and this permission notice shall be included in 12 | * all copies or substantial portions of the Software. 13 | * 14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 20 | * IN THE SOFTWARE. 21 | */ 22 | 23 | /* A very simple native module */ 24 | 25 | #include 26 | #include 27 | 28 | static Janet cfun_get_nine(int32_t argc, Janet *argv) { 29 | (void) argv; 30 | janet_fixarity(argc, 0); 31 | std::cout << "Hello!" << std::endl; 32 | return janet_wrap_number(9.0); 33 | } 34 | 35 | static const JanetReg array_cfuns[] = { 36 | {"get9", cfun_get_nine, NULL}, 37 | {NULL, NULL, NULL} 38 | }; 39 | 40 | JANET_MODULE_ENTRY(JanetTable *env) { 41 | janet_cfuns(env, NULL, array_cfuns); 42 | } 43 | -------------------------------------------------------------------------------- /test-bundle/testmod3.cpp: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2025 Calvin Rose and contributors 3 | * 4 | * Permission is hereby granted, free of charge, to any person obtaining a copy 5 | * of this software and associated documentation files (the "Software"), to 6 | * deal in the Software without restriction, including without limitation the 7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or 8 | * sell copies of the Software, and to permit persons to whom the Software is 9 | * furnished to do so, subject to the following conditions: 10 | * 11 | * The above copyright notice and this permission notice shall be included in 12 | * all copies or substantial portions of the Software. 13 | * 14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 20 | * IN THE SOFTWARE. 21 | */ 22 | 23 | /* A very simple native module */ 24 | 25 | #include 26 | #include 27 | 28 | static Janet cfun_get_seven(int32_t argc, Janet *argv) { 29 | (void) argv; 30 | janet_fixarity(argc, 0); 31 | std::cout << "Hello!" << std::endl; 32 | return janet_wrap_number(7.0); 33 | } 34 | 35 | static const JanetReg array_cfuns[] = { 36 | {"get7", cfun_get_seven, NULL}, 37 | {NULL, NULL, NULL} 38 | }; 39 | 40 | JANET_MODULE_ENTRY(JanetTable *env) { 41 | janet_cfuns(env, NULL, array_cfuns); 42 | } 43 | -------------------------------------------------------------------------------- /doc/index.mdz: -------------------------------------------------------------------------------- 1 | {:title "Spork" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html" } 5 | --- 6 | 7 | Spork is a utility library for Janet. It contains a number of small 8 | modules that should be useful for general programming in Janet but do 9 | not "make the cut" for inclusion in the standard library. You can 10 | think of spork as a sort of extended standard library for Janet. 11 | 12 | 13 | ## Source code 14 | 15 | @p{@link[https://github.com/janet-lang/spork]} 16 | 17 | 18 | ## Install 19 | 20 | @codeblock``` 21 | $ [sudo] jpm install spork 22 | ``` 23 | 24 | ## Usage 25 | 26 | Every binding in the spork library will be imported if you @code`(import spork)` in either a Janet source file or at a Janet REPL: 27 | 28 | @codeblock``` 29 | Janet 1.35.2-fda0a081 linux/x64/gcc - '(doc)' for help 30 | repl:1:> (import spork) 31 | @{_ @{:value } spork/argparse/argparse @{:private true} spork/base64/decode @{:private true} spork/base64/encode @{:private true} spork/crc/make-variant @{:private true} spork/crc/named-variant @{:private true} spork/cron/check @{:private true} spork/cron/next-timestamp @{:private true} spork/cron/parse-cron @{:private true} ...} 32 | repl:2:> 33 | ``` 34 | 35 | However, it's usually more practical to only import the specific module you want using @code`(import spork/[module])`, replacing @code`[module]` as appropriate. For example: 36 | 37 | @codeblock``` 38 | Janet 1.35.2-fda0a081 linux/x64/gcc - '(doc)' for help 39 | repl:1:> (import spork/netrepl) 40 | @{_ @{:value } netrepl/client @{:private true} netrepl/default-host @{:private true} netrepl/default-port @{:private true} netrepl/server @{:private true} netrepl/server-single @{:private true}} 41 | repl:2:> 42 | ``` 43 | 44 | -------------------------------------------------------------------------------- /spork/msg.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### msg.janet 3 | ### 4 | ### A simple message protocol for sequential messages 5 | ### over a stream (full duplex channel of strings). 6 | ### 7 | 8 | # Message Protocol 9 | # 10 | # | b0 | b1 | b2 | b3 | ... n bytes | 11 | # n = b0 + b1 * 0x100 + b2 * 0x10000 + b3 * 0x1000000 12 | # 13 | # Messages are a four byte little endian unsigned message prefix 14 | # denoting length followed by a payload of length bytes. 15 | # An interrupted or incomplete message should be converted to nil. 16 | 17 | (defn make-recv 18 | "Get a function that, when invoked, gets the next message from a readable stream. 19 | Provide an optional unpack function that will parse the received buffer." 20 | [stream &opt unpack] 21 | (def buf @"") 22 | (default unpack string) 23 | (fn receiver [] 24 | (buffer/clear buf) 25 | (if-not (:chunk stream 4 buf) (break)) 26 | (def [b0 b1 b2 b3] buf) 27 | (def len (+ b0 (* b1 0x100) (* b2 0x10000) (* b3 0x1000000))) 28 | (buffer/clear buf) 29 | (if-not (:chunk stream len buf) (break)) 30 | (unpack buf))) 31 | 32 | (defn make-send 33 | "Create a function that when called with a msgs sends that msg. 34 | Provide an optional pack function that will convert a message to a string." 35 | [stream &opt pack] 36 | (def buf @"") 37 | (default pack string) 38 | (fn sender [msg] 39 | (def x (pack msg)) 40 | (buffer/clear buf) 41 | (buffer/push-word buf (length x)) 42 | (buffer/push-string buf x) 43 | (:write stream buf) 44 | nil)) 45 | 46 | (defn make-proto 47 | "Create both a send an recv function from a stream, as with 48 | `make-send` and `make-recv`." 49 | [stream &opt pack unpack] 50 | [(make-send stream pack) (make-recv stream unpack)]) 51 | -------------------------------------------------------------------------------- /spork/channel.janet: -------------------------------------------------------------------------------- 1 | (defn from-each 2 | ``` 3 | Returns a channel that gives each item from an iterable data type. `each` macro is used to iterate over all iterable 4 | types. `supervisor` argument is passed to `ev/go` which launches two tasks that feed items to the channel. To finish 5 | the tasks, drain all items from the channel, or close the channel. Otherwise, the tasks remain frozen. When the tasks 6 | finish, the channel is closed. An error caused during iteration finishes the tasks with an error. Writing to the 7 | channel finishes the tasks with an error or freezes the fiber that tries to write to the channel. 8 | ``` 9 | [iterable &named supervisor] 10 | (def ch (ev/chan)) 11 | (def iterable-ch (ev/chan)) 12 | (def iterable-task (ev/go |(try 13 | (defer (:close iterable-ch) 14 | (each item iterable 15 | (ev/give iterable-ch item))) 16 | ([err f] 17 | (unless (= err :cancel) 18 | (propagate err f)))) 19 | nil supervisor)) 20 | (defn give-items [] 21 | (match (ev/select ch iterable-ch) 22 | [:take c item] 23 | (if (= c iterable-ch) 24 | (do 25 | (ev/give ch item) 26 | (give-items)) 27 | (do 28 | (ev/cancel iterable-task :cancel) 29 | (error "Writing to the returned channel is prohibited."))) 30 | [:close c] 31 | # If iterable-ch is closed, give-items exits quietly. 32 | (when (= c ch) 33 | (ev/cancel iterable-task :cancel)))) 34 | (ev/go |(defer (:close ch) 35 | (give-items)) 36 | nil supervisor) 37 | ch) 38 | -------------------------------------------------------------------------------- /doc/api/http.mdz: -------------------------------------------------------------------------------- 1 | {:title "http" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | The @code`http` module is an HTTP/1.1 parser, server and client module. It proves a simple server implementation, client, support for chunked encoding. 8 | The @code`http` module is also non-blocking, so a single thread can run 9 | many clients, servers, and connections at once. 10 | 11 | The @code`http` module supports custom stream transports via the @code`:stream-factory` parameter, 12 | allowing HTTP to work over different underlying protocols (e.g., TLS, QUIC, or custom transports). 13 | The stream factory should accept @code`(host port &opt opts)` and return a Janet stream that supports 14 | @code`:read`, @code`:write`, and @code`:close` methods. 15 | 16 | ## Examples 17 | 18 | ### Server 19 | 20 | @codeblock[janet]``` 21 | (import spork/http) 22 | 23 | (defn handler 24 | [req] 25 | (def method (get req :method)) 26 | (case method 27 | "GET" {:status 200 :body (get req :path)} 28 | "POST" {:status 400 :body (http/read-body req)} 29 | {:status 404})) 30 | 31 | (http/server handler "127.0.0.1" "9000") 32 | ``` 33 | 34 | ### Client 35 | 36 | @codeblock[janet]``` 37 | (import spork/http) 38 | 39 | (def response (http/request "GET" "http://www.example.com")) 40 | (def body (http/read-body response)) 41 | (print body) 42 | ``` 43 | 44 | ### Client with Custom Stream (e.g., HTTPS) 45 | 46 | @codeblock[janet]``` 47 | (import spork/http) 48 | (import jossl/tls) 49 | 50 | # Use TLS for HTTPS 51 | (def response (http/request "GET" "https://www.example.com" 52 | :stream-factory tls/connect)) 53 | (def body (http/read-body response)) 54 | (print body) 55 | ``` 56 | 57 | ## Reference 58 | 59 | @api-docs("../../spork" "http") 60 | -------------------------------------------------------------------------------- /test/suite-sh.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/sh) 3 | (import ../spork/path) 4 | 5 | (start-suite) 6 | 7 | (def base-path "test") 8 | 9 | (do 10 | (assert (deep= (os/dir (path/join base-path "assets/17")) 11 | @["test.file"]) 12 | "test files are wrong, assets/17 should only contain test.file") 13 | (sh/copy-file (path/join base-path "assets/17/test.file") 14 | (path/join base-path "assets/17/test2.file")) 15 | (def new_file (slurp (path/join base-path "assets/17/test2.file"))) 16 | (assert (deep= (sort (sh/list-all-files (path/join base-path "assets"))) 17 | (map |(path/join base-path $0) 18 | @["assets/17/test.file" "assets/17/test2.file"])) 19 | "sh/list-all-files didn't list the correct files") 20 | (sh/rm (path/join base-path "assets/17/test2.file")) 21 | (assert (deep= (os/dir (path/join base-path "assets/17")) 22 | @["test.file"]) 23 | "file test2.file was not removed by sh/rm") 24 | (assert (deep= (slurp (path/join base-path "assets/17/test.file")) 25 | new_file) 26 | "file copied with sh/copy-file is not the same")) 27 | 28 | (do 29 | (sh/create-dirs (path/join base-path "assets/17/some/more/directories/to/test")) 30 | (assert (= ((os/stat (path/join base-path "assets/17/some/more/directories/to/test")) :mode) 31 | :directory) 32 | "sh/create-dirs failed") 33 | (sh/rm (path/join base-path "assets/17/some")) 34 | (assert (= (os/stat (path/join base-path "assets/17/some/more/directories/to/test")) 35 | nil) 36 | "sh/rm didn't work correctly")) 37 | 38 | (assert (deep= 39 | (sh/split ` "c d \" f" ' y z' a b a\ b --cflags `) 40 | @["c d \" f" " y z" "a" "b" "a b" "--cflags"])) 41 | 42 | (end-suite) 43 | -------------------------------------------------------------------------------- /test/suite-cron.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/cron) 3 | 4 | (start-suite) 5 | 6 | (defn format-time 7 | "Convert an integer time since epoch to generally readable string." 8 | [time &opt local] 9 | (unless time (break "")) 10 | (def {:hours hours 11 | :minutes minutes 12 | :seconds seconds 13 | :month month 14 | :month-day month-day 15 | :year year} (os/date time local)) 16 | (string/format "%d-%.2d-%.2d %.2d:%.2d:%.2d" 17 | year (inc month) (inc month-day) 18 | hours minutes seconds)) 19 | 20 | (defn get-sequence 21 | "Print the next n timestamps of a cron sequence" 22 | [cron n &opt start-time local] 23 | (var time start-time) 24 | (def cron (if (bytes? cron) (cron/parse-cron cron) cron)) 25 | (def arr @[]) 26 | (repeat n 27 | (set time (cron/next-timestamp cron time local)) 28 | (array/push arr (format-time time local))) 29 | arr) 30 | 31 | (defn print-sequence 32 | [cron n &opt start-time local] 33 | (map print (get-sequence cron n start-time local))) 34 | 35 | # Pick a stable start time 36 | (def stable-start 1665693600) 37 | 38 | (assert (deep= (get-sequence "10 14 * jan mon,tue" 10 stable-start) 39 | @["2023-01-02 14:10:00" 40 | "2023-01-03 14:10:00" 41 | "2023-01-09 14:10:00" 42 | "2023-01-10 14:10:00" 43 | "2023-01-16 14:10:00" 44 | "2023-01-17 14:10:00" 45 | "2023-01-23 14:10:00" 46 | "2023-01-24 14:10:00" 47 | "2023-01-30 14:10:00" 48 | "2023-01-31 14:10:00"]) "sequence 1") 49 | 50 | (assert (cron/check "40 * * * *" stable-start)) 51 | (assert (cron/check "5,40 * * * *" stable-start)) 52 | (assert (cron/check "10/5 * * * *" stable-start)) 53 | (assert (cron/check "*/5 * * * *" stable-start)) 54 | 55 | (end-suite) 56 | -------------------------------------------------------------------------------- /test/suite-cc.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/cc) 3 | 4 | (start-suite) 5 | 6 | (when (= :windows (os/which)) 7 | 8 | (assert-no-error "no error 1" (cc/msvc-compile-c "a.o" "a.c")) 9 | (assert-no-error "no error 2" (cc/msvc-compile-c++ "a.o" "a.cc")) 10 | (assert-no-error "no error 3" (cc/msvc-link-shared ["a.o" "b.o"] "a.so")) 11 | (assert-no-error "no error 5" (cc/msvc-link-executable ["a.o" "b.o"] "a")) 12 | (assert-no-error "no error 7" (cc/msvc-make-archive ["a.o" "b.o"] "a.a")) 13 | 14 | (assert-no-error "no error 8" (cc/msvc-compile-and-link-shared "a.so" "a.c" "b.c")) 15 | (assert-no-error "no error 9" (cc/msvc-compile-and-link-shared "a.so" "a.cpp" "b.c")) 16 | (assert-no-error "no error 10" (cc/msvc-compile-and-link-executable "a" "a.c" "b.c")) 17 | (assert-no-error "no error 11" (cc/msvc-compile-and-link-executable "a" "a.cpp" "b.c")) 18 | (assert-no-error "no error 12" (cc/msvc-compile-and-make-archive "a.a" "a.cpp" "b.c"))) 19 | 20 | 21 | (unless (= :windows (os/which)) 22 | 23 | (assert-no-error "no error 1" (cc/compile-c "a.o" "a.c")) 24 | (assert-no-error "no error 2" (cc/compile-c++ "a.o" "a.cc")) 25 | (assert-no-error "no error 3" (cc/link-shared-c ["a.o" "b.o"] "a.so")) 26 | (assert-no-error "no error 4" (cc/link-shared-c++ ["a.o" "b.o"] "a.so")) 27 | (assert-no-error "no error 5" (cc/link-executable-c ["a.o" "b.o"] "a")) 28 | (assert-no-error "no error 6" (cc/link-executable-c++ ["a.o" "b.o"] "a")) 29 | (assert-no-error "no error 7" (cc/make-archive ["a.o" "b.o"] "a.a")) 30 | 31 | (assert-no-error "no error 8" (cc/compile-and-link-shared "a.so" "a.c" "b.c")) 32 | (assert-no-error "no error 9" (cc/compile-and-link-shared "a.so" "a.cpp" "b.c")) 33 | (assert-no-error "no error 10" (cc/compile-and-link-executable "a" "a.c" "b.c")) 34 | (assert-no-error "no error 11" (cc/compile-and-link-executable "a" "a.cpp" "b.c")) 35 | (assert-no-error "no error 12" (cc/compile-and-make-archive "a.a" "a.cpp" "b.c"))) 36 | 37 | (end-suite) 38 | -------------------------------------------------------------------------------- /bin/janet-format: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env janet 2 | 3 | (import spork/fmt) 4 | (import spork/argparse) 5 | 6 | (def- default-config ".janet-format.jdn") 7 | 8 | (defn- main 9 | [&] 10 | 11 | (def ap 12 | (argparse/argparse 13 | "Format Janet source code in files and write output to those files." 14 | 15 | :default 16 | {:kind :accumulate 17 | :help "Files to format"} 18 | 19 | "files" 20 | {:short "f" 21 | :help "Format a list of source files." 22 | :kind :flag} 23 | 24 | "output" 25 | {:short "o" 26 | :kind :option 27 | :help "Where to direct output to. By default, output goes to stdout."} 28 | 29 | "input" 30 | {:short "i" 31 | :kind :option 32 | :help "Read from an input file"} 33 | 34 | "config" 35 | {:short "c" 36 | :kind :option 37 | :help "Which configuration file to read" 38 | :default default-config} 39 | 40 | "no-config" 41 | {:short "n" 42 | :kind :flag 43 | :help "Avoid loading any configuration"})) 44 | 45 | # Break on help text 46 | (unless ap (break)) 47 | 48 | (unless (ap "no-config") 49 | (def config (ap "config")) 50 | (def [exists contents] (protect (slurp config))) 51 | (if exists 52 | (setdyn fmt/*user-indent-2-forms* (parse contents)) 53 | (when (not= config default-config) 54 | (eprintf "Configuration file '%s' does not exist" config)))) 55 | 56 | (if (or (ap "files") (ap :default)) 57 | (each file (ap :default) 58 | (eprint "formatting " file "...") 59 | (fmt/format-file file)) 60 | (if-let [ofile (ap "output")] 61 | (with [output (file/open ofile :wb)] 62 | (if-let [ifile (ap "input")] 63 | (xprin output (fmt/format (slurp ifile))) 64 | (xprin output (fmt/format (file/read stdin :all))))) 65 | (if-let [ifile (ap "input")] 66 | (prin (fmt/format (slurp ifile))) 67 | (prin (fmt/format (file/read stdin :all))))))) 68 | -------------------------------------------------------------------------------- /doc/api/argparse.mdz: -------------------------------------------------------------------------------- 1 | {:title "argparse" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | A moderately opinionated argument parser for 8 | @link[https://janet-lang.org][janet]. Use this for writing 9 | CLI scripts that need to have UNIX style switches and 10 | options. 11 | 12 | ## Sample 13 | 14 | @codeblock[janet]``` 15 | #!/usr/bin/env janet 16 | 17 | (import spork/argparse :prefix "") 18 | 19 | (def argparse-params 20 | ["A simple CLI tool. An example to show the capabilities of argparse." 21 | "debug" {:kind :flag 22 | :short "d" 23 | :help "Set debug mode."} 24 | "verbose" {:kind :multi 25 | :short "v" 26 | :help "Print debug information to stdout."} 27 | "key" {:kind :option 28 | :short "k" 29 | :help "An API key for getting stuff from a server." 30 | :required true} 31 | "expr" {:kind :accumulate 32 | :short "e" 33 | :help "Search for all patterns given."} 34 | "thing" {:kind :option 35 | :help "Some option?" 36 | :default "123"}]) 37 | 38 | (let [res (argparse ;argparse-params)] 39 | (unless res 40 | (os/exit 1)) 41 | (pp res)) 42 | ``` 43 | 44 | ## Usage 45 | 46 | Call @code`argparse/argparse` to attempt to parse the command line args 47 | (available at @code`(dyn :args)`). 48 | 49 | The first argument should be a description to be displayed as help 50 | text. 51 | 52 | All subsequent options should be alternating keys and values where the 53 | keys are options to accept and the values are definitions of each option. 54 | 55 | To accept positional arguments, include a definition for the special 56 | value @code`:default`. For instance, to gather all positional arguments 57 | into an array, include @code`:default {:kind :accumulate}` in your 58 | arguments to @code`argparse`. 59 | 60 | Run @code`(doc argparse/argparse)` after importing for more information. 61 | 62 | ## Reference 63 | 64 | @api-docs("../../spork" "argparse") 65 | -------------------------------------------------------------------------------- /test/suite-schema.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/schema :as schema) 3 | 4 | (start-suite) 5 | 6 | (def c1 (schema/predicate :number)) 7 | (assert (not (c1 :test)) "checker c1 1") 8 | (assert (c1 0) "checker c1 2") 9 | (assert (not (c1 :number)) "checker c1 3") 10 | (assert (c1 math/inf) "checker c1 4") 11 | (assert (c1 math/nan) "checker c1 5") 12 | 13 | (def c2 (schema/predicate (or :number (and (or :array :tuple) (length 1 3) (values :number))))) 14 | (assert (c2 2) "checker c2 1") 15 | (assert (c2 -1) "checker c2 2") 16 | (assert (not (c2 [])) "checker c2 3") 17 | (assert (c2 [2 3]) "checker c2 4") 18 | (assert (not (c2 [3 3 :nope])) "checker c2 5") 19 | (assert (not (c2 [3 3 4 5])) "checker c2 6") 20 | 21 | (def v1 (schema/validator :number)) 22 | (assert-no-error "validator v1 1" (v1 0)) 23 | (assert-no-error "validator v1 2" (v1 math/nan)) 24 | (assert-error "validator v1 3" (v1 :hello)) 25 | (assert-error "validator v1 4" (v1 nil)) 26 | 27 | (def v2 28 | (schema/validator 29 | (props 30 | :a :number 31 | :b :number 32 | :c (or :string nil)))) 33 | (assert-no-error "validator v2 1" (v2 {:a 1 :b 2})) 34 | (assert-no-error "validator v2 2" (v2 {:a 1 :b 2 :c "hello"})) 35 | 36 | (defn pos-string? [x] (if-let [y (scan-number x)] (pos? y))) 37 | (def v3 38 | (schema/validator 39 | (or 40 | (and :number (pred pos?)) 41 | (and :string (pred pos-string?))))) 42 | (assert-no-error "validator v3 1" (v3 1)) 43 | (assert-error "validator v3 2" (v3 -1)) 44 | (assert-no-error "validator v3 3" (v3 "1")) 45 | (assert-error "validator v3 4" (v3 "-1")) 46 | (assert-error "validator v3 5" (v3 :-1)) 47 | 48 | # switch "and" and "or" in the v3 validator 49 | (def v4 50 | (schema/validator 51 | (and 52 | (or :number (pred pos?)) 53 | (or :string (pred pos-string?))))) 54 | (assert-error "validator v4 1" (v4 1)) 55 | (assert-error "validator v4 2" (v4 -1)) 56 | (assert-no-error "validator v4 3" (v4 "1")) # strings are considered "pos?" 57 | (assert-no-error "validator v4 4" (v4 "-1")) 58 | 59 | (end-suite) 60 | -------------------------------------------------------------------------------- /doc/api/schema.mdz: -------------------------------------------------------------------------------- 1 | {:title "schema" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | Simple schema validation library. Specify structure declaratively, and get 6 | functions that will check that structure and either raise an error or return a boolean. 7 | While reasonably general, use is intended for data such as one would find 8 | in configuration files or network protocols. 9 | 10 | Currently does not support more advanced features such as: 11 | @ul{ 12 | @li{Recursive schemas} 13 | @li{Full error reporting (only a single error is reported)} 14 | @li{PEG style grammars (used to enable recursion in PEGs)} 15 | @li{Unification (such as in the @code`(match)` macro)} 16 | @li{Parsing/data extraction} 17 | } 18 | 19 | Syntax: 20 | @ul{ 21 | @li{@code`:keyword` - match any value of that type} 22 | @li{Tuples are used to match various combinators: 23 | @ul{ 24 | @li{@code`(any)` - match any one value} 25 | @li{@code`(enum & options)` - match any of the option values} 26 | @li{@code`(or & schemas)` - similar to enum, but each option is considered a schema.} 27 | @li{@code`(and & schemas)` - Only matches if all clauses match} 28 | @li{@code`(values schema)` - Matches only if schema matches all values in a data structure.} 29 | @li{@code`(keys schema)` - Matches only if schema matches all keys in a data structure.} 30 | @li{@code`(props & k v)` - Takes a sequence of keys and values (alternating in order). Only matches} 31 | the data if, for a key, the corresponding schema `v` matches. 32 | @li{@code`(length l)` - Only match if the data has a length of l. Uses of the length combinator should assert the data type before doing a length check.} 33 | @li{@code`(length min max)` - Only match lengths between min and max inclusive} 34 | @li{@code`(peg pattern)` - Matches only if the peg matches} 35 | @li{@code`(not pattern)` - Only matches if pattern does not match} 36 | @li{@code`(pred predicate)` - Use a predicate function (function of 1 argument) to check if the data is valid.} 37 | }} 38 | @li{anything else - match that value literally} 39 | } 40 | 41 | ## Reference 42 | 43 | @api-docs("../../spork" "schema") 44 | -------------------------------------------------------------------------------- /test/suite-rawterm.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import spork/rawterm) 3 | 4 | (start-suite) 5 | 6 | (assert-error "issue #198" (rawterm/getch)) 7 | 8 | # TODO: This tests the reduced set of codepoints based on the original set in 9 | # Bestline: 10 | # https://github.com/jart/bestline/blob/4a09bf4355c15c96526/bestline.c#L274-L287 11 | # Some ranges have carveouts in them to account for unallocated characters or 12 | # unusual ones (U+302A and such) in blocks that the Bestline conditional treats 13 | # as monolithic for simplification's sake. 14 | (each [lo hi] 15 | @[[0x1100 0x115F] 16 | [0x2329 0x2329] 17 | [0x232A 0x232A] 18 | [0x2E80 0x2E99] # U+2E9A unallocated 19 | [0x2E9B 0x2EF3] # U+2EF4..U+2EFF unallocated 20 | [0x2F00 0x2FD5] # U+2FD6..U+2FEF unallocated 21 | [0x2FF0 0x2FFB] # U+2FFC..U+2FFF unallocated 22 | [0x3000 0x3029] # U+302A..U+302D zero-width? 23 | [0x302E 0x303E] # U+303F single-width; U+3040 unallocated 24 | [0x3041 0x3096] # U+3097..U+3098 unallocated; U+3099..U+309A zero-width 25 | [0x309B 0x30FF] # U+3100..U+3104 unallocated 26 | [0x3105 0x312F] # U+3130 unallocated 27 | [0x3131 0x318E] # U+318F unallocated 28 | [0x3190 0x31E3] # U+31E4..U+31EF unallocated 29 | [0x31F0 0x321E] # U+321F unallocated 30 | [0x3220 0x3247] # U+3248..U+324F single-width 31 | [0x3250 0x4DBF] # U+4DC0..U+4DFF single-width 32 | [0x4E00 0xA48C] # U+A48D..U+A48F unallocated 33 | [0xA490 0xA4C6] # U+A4C7..U+A4CF unallocated 34 | [0xAC00 0xD7A3] 35 | [0xF900 0xFAFF] 36 | [0xFE10 0xFE19] 37 | [0xFE30 0xFE52] # U+FE53 unallocated 38 | [0xFE54 0xFE66] # U+FE67 unallocated 39 | [0xFE68 0xFE6B] # U+FE6C..U+FE6F unallocated; U+FF00 unallocated 40 | [0xFF01 0xFF60] 41 | [0xFFE0 0xFFE6] 42 | [0x20000 0x2FFFD] 43 | [0x30000 0x3FFFD]] 44 | (for ch lo (inc hi) 45 | (assert (= 2 (rawterm/rune-monowidth ch)) 46 | (string/format "rune-monowidth: %X (expected 2, got %d)" 47 | ch (rawterm/rune-monowidth ch))))) 48 | 49 | (end-suite) 50 | -------------------------------------------------------------------------------- /test/suite-temple.janet: -------------------------------------------------------------------------------- 1 | (import ../spork/temple :as temple) 2 | (import ../spork/test) 3 | 4 | (temple/add-loader) 5 | 6 | (test/start-suite) 7 | 8 | (defn- remove-r [x] (string/replace-all "\r" "" x)) 9 | 10 | (defn check-template 11 | [template args expected] 12 | (def expected (string/trim (remove-r expected))) 13 | (def buf @"") 14 | (with-dyns [:out buf] 15 | (template args)) 16 | (def sbuf (string/trim (remove-r (string buf)))) 17 | (test/assert (= sbuf expected) (string/format "template %v - expected %v, got %v" template expected sbuf))) 18 | 19 | (import ./templates/hi :as hi) 20 | (import ./templates/hop :as hop) 21 | 22 | (check-template hi/render-dict {:a 1 :b 2} 23 | ``` 24 | 25 | 6 26 | 27 | ```) 28 | 29 | (check-template hop/render-dict {:a 1 :b 2} 30 | ``` 31 | 32 | 6 33 | 34 | ```) 35 | 36 | (assert (deep= (hi/capture-dict {:a 1 :b 2}) 37 | (hi/capture :a 1 :b 2))) 38 | 39 | (def str-template "hello {{ (args :arg) }}") 40 | (def render (temple/compile str-template)) 41 | (def out (render :arg "world")) 42 | 43 | (test/assert (buffer? out) "Rendered temple string produces a buffer") 44 | 45 | (def expected "hello world") 46 | (test/assert (= expected (string out)) "Rendered temple string produces \"hello world\"") 47 | 48 | (def ctc 49 | `{$ (import /spork/fmt) $}{{ (fmt/format (string "(def c " (args :a) " )")) }}`) 50 | 51 | (test/assert (deep= ((temple/compile ctc) :a "a > b") 52 | @"(def c a > b)\n") 53 | "compile time chunk") 54 | 55 | (test/assert (deep= ((temple/compile `{{ (args :a) }}`) :a "a > b") 56 | @"a > b") 57 | "sub chunk") 58 | 59 | (test/assert (deep= ((temple/compile `{% (print (args :a)) %}`) :a "a > b") 60 | @"a > b\n") 61 | "code chunk") 62 | 63 | (test/assert (deep= ((temple/compile `{- (args :a) -}`) :a "a > b") 64 | @"a > b") 65 | "raw chunk") 66 | 67 | (test/end-suite) 68 | -------------------------------------------------------------------------------- /spork/data.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### data.janet 3 | ### 4 | ### Compare data structures using `diff`. 5 | ### 6 | 7 | (varfn diff []) 8 | 9 | (defn- atom-diff 10 | [a b] 11 | (if (= a b) @[nil nil a] @[a b nil])) 12 | 13 | (defn- in? [x ds] 14 | (if (index-of x ds) 15 | true 16 | false)) 17 | 18 | (defn- safe-in [ds n] 19 | (if (in? (type ds) [:array :tuple]) 20 | (if (<= n (dec (length ds))) 21 | (in ds n) 22 | nil) 23 | (in ds n))) 24 | 25 | (defn- vectorize [m] 26 | (unless (or (nil? m) (empty? m)) 27 | (when (in? (type m) [:array :tuple :table :struct]) 28 | (reduce 29 | (fn [result [k v]] (put result k v)) 30 | (array/new-filled (max ;(keys m))) 31 | (pairs m))))) 32 | 33 | (defn- diff-associative-key [a b k] 34 | (let [va (safe-in a k) 35 | vb (safe-in b k) 36 | [a* b* ab] (diff va vb) 37 | same (and (in? k (keys a)) (in? k (keys b)) 38 | (or (not (nil? ab)) 39 | (and (nil? va) (nil? vb))))] 40 | [(when (and (in? k (keys a)) (or (not (nil? a*)) (not same))) {k a*}) 41 | (when (and (in? k (keys b)) (or (not (nil? b*)) (not same))) {k b*}) 42 | (when same {k ab})])) 43 | 44 | (defn- diff-associative [a b &opt ks] 45 | (default ks (distinct (array/concat (keys a) (keys b)))) 46 | (let [reduced (reduce 47 | (fn [diff1 diff2] 48 | (map |(if (empty? $) nil $) 49 | (map |(merge (or $0 @{}) (or $1 @{})) diff1 diff2))) 50 | [nil nil nil] 51 | (map (partial diff-associative-key a b) ks))] 52 | reduced)) 53 | 54 | (defn- diff-sequential [a b] 55 | (map vectorize (diff-associative 56 | (if (array? a) a (array ;a)) 57 | (if (array? b) b (array ;b)) 58 | (range (max (length a) (length b)))))) 59 | 60 | (varfn diff 61 | ``` 62 | Compares a and b recursively. Returns an array of 63 | @[things-only-in-a things-only-in-b things-in-both]. 64 | ``` 65 | [a b] 66 | (if (deep= a b) 67 | @[nil nil (postwalk |(cond (tuple? $) (array ;$) 68 | (struct? $) (struct/to-table $) $) a)] 69 | (do 70 | (cond 71 | (all indexed? [a b]) (diff-sequential a b) 72 | (all dictionary? [a b]) (diff-associative a b) 73 | (atom-diff a b))))) 74 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: Test 2 | 3 | on: 4 | push: 5 | branches: [ master ] 6 | pull_request: 7 | branches: [ master ] 8 | 9 | jobs: 10 | test-posix: 11 | name: Build and test on POSIX systems 12 | runs-on: ${{ matrix.os }} 13 | strategy: 14 | matrix: 15 | os: [ ubuntu-latest, macos-latest, macos-14 ] 16 | janet-version: [ heads/master, tags/v1.39.1, tags/v1.38.0, tags/v1.37.1, tags/v1.36.0 ] 17 | steps: 18 | - name: Checkout Janet 19 | uses: actions/checkout@v4 20 | with: 21 | repository: janet-lang/janet 22 | path: janet 23 | ref: refs/${{ matrix.janet-version }} 24 | - name: Build Janet 25 | run: cd janet && make clean && make && make test 26 | - name: Install Janet 27 | run: cd janet && sudo make install 28 | - name: Checkout the repository 29 | uses: actions/checkout@v4 30 | with: 31 | path: spork 32 | - name: Build Spork 33 | run: cd spork && janet -l ./bundle -e "(build)" 34 | - name: Test Install 35 | run: sudo janet -e '(bundle/install "spork")' 36 | - name: Run Tests 37 | run: cd spork && VERBOSE=1 janet -l ./bundle -e "(check)" 38 | 39 | test-windows: 40 | name: Build and test on Windows 41 | strategy: 42 | matrix: 43 | os: [ windows-2022, windows-latest ] 44 | janet-version: [ 1.36.0, 1.37.1, 1.38.0, 1.39.1 ] 45 | runs-on: ${{ matrix.os }} 46 | steps: 47 | - uses: actions/checkout@v4 48 | with: 49 | path: spork 50 | - name: Download Janet Latest Release 51 | shell: cmd 52 | run: curl -fSLo janet.msi https://github.com/janet-lang/janet/releases/download/v${{ matrix.janet-version }}/janet-${{ matrix.janet-version }}-windows-x64-installer.msi 53 | - name: Install Janet 54 | shell: cmd 55 | run: msiexec /quiet /i janet.msi ALLUSERS=1 /log install.log && type install.log 56 | - name: Build Spork 57 | shell: cmd 58 | run: | 59 | refreshenv & cd spork & janet -l ./bundle -e "(do (setdyn :verbose true) (build))" 60 | - name: Test Install 61 | shell: cmd 62 | run: | 63 | refreshenv & janet -e "(bundle/install `spork`)" 64 | - name: Run Tests 65 | shell: cmd 66 | run: | 67 | refreshenv & cd spork & janet -l ./bundle -e "(check)" 68 | -------------------------------------------------------------------------------- /test/suite-generators.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/ev-utils :as eu) 3 | (import ../spork/generators :as generators) 4 | 5 | (start-suite) 6 | 7 | (defn- generator-assert! 8 | [s] 9 | (assert (fiber? s)) 10 | (assert (= :new (fiber/status s)))) 11 | 12 | (def s (generators/from-iterable [1 2 3])) 13 | (generator-assert! s) 14 | (assert (deep= @[1 2 3] (generators/to-array s))) 15 | 16 | (def s (generators/from-iterable @[1 2 3])) 17 | (generator-assert! s) 18 | (assert (deep= @[1 2 3] (generators/to-array s))) 19 | 20 | (def s (generators/from-iterable @[1 2 3])) 21 | (def s2 (generators/from-iterable s)) 22 | (generator-assert! s) 23 | (assert (deep= @[1 2 3] (generators/to-array s2))) 24 | 25 | (def s (generators/range 1 10)) 26 | (generator-assert! s) 27 | (assert (deep= @[1 2 3 4 5 6 7 8 9] (generators/to-array s))) 28 | 29 | (def s (generators/concat [1] @[2] (generators/from-iterable [3 4 5]))) 30 | (generator-assert! s) 31 | (assert (deep= @[1 2 3 4 5] (generators/to-array s))) 32 | 33 | (def s (generators/map inc [1 2 3])) 34 | (generator-assert! s) 35 | (assert (deep= @[2 3 4] (generators/to-array s))) 36 | 37 | (def s (generators/filter odd? [1 2 3])) 38 | (generator-assert! s) 39 | (assert (deep= @[1 3] (generators/to-array s))) 40 | 41 | (def s (generators/take 2 [1 2 3])) 42 | (generator-assert! s) 43 | (assert (deep= @[1 2] (generators/to-array s))) 44 | 45 | (def s (generators/take-while odd? [1 2 3])) 46 | (generator-assert! s) 47 | (assert (deep= @[1] (generators/to-array s))) 48 | 49 | (def s (generators/take-until even? [1 2 3])) 50 | (generator-assert! s) 51 | (assert (deep= @[1] (generators/to-array s))) 52 | 53 | (def s (generators/drop 1 [1 2 3])) 54 | (generator-assert! s) 55 | (assert (deep= @[2 3] (generators/to-array s))) 56 | 57 | (def s (generators/drop-while odd? [1 2 3])) 58 | (generator-assert! s) 59 | (assert (deep= @[2 3] (generators/to-array s))) 60 | 61 | (def s (generators/drop-until even? [1 2 3])) 62 | (generator-assert! s) 63 | (assert (deep= @[2 3] (generators/to-array s))) 64 | 65 | (def s (generators/cycle [1 2 3])) 66 | (generator-assert! s) 67 | (def taken (generators/take 10 s)) 68 | (assert (deep= @[1 2 3 1 2 3 1 2 3 1] (generators/to-array taken))) 69 | 70 | (def s (generators/cycle {:a 1 :b 2 :c 3})) 71 | (def taken (generators/take 10 s)) 72 | (def taken-array (generators/to-array taken)) 73 | (assert (= 10 (length taken-array))) 74 | (assert (deep= @[1 2 3] (sorted (distinct taken-array)))) 75 | 76 | (end-suite) 77 | -------------------------------------------------------------------------------- /test/suite-infix.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (use ../spork/infix) 3 | 4 | (start-suite) 5 | 6 | # Basic tests 7 | (assert (deep= '(+ 1 2) (macex1 '($$ 1 + 2)))) 8 | (assert (deep= ~(,math/pow 1 2) (macex1 '($$ 1 ** 2)))) 9 | (assert (= ($$ 1 - 2 - 3 - 4) (- 1 2 3 4))) 10 | (assert (= ($$ 1 + 2 + 3 + 4) (+ 1 2 3 4))) 11 | (assert (= ($$ 1 * 2 * 3 * 4) (* 1 2 3 4))) 12 | (assert (= ($$ 1 / 2 / 3 / 4) (/ 1 2 3 4))) 13 | (assert (= ($$ 1 % 2 % 3 % 4) (% 1 2 3 4))) 14 | (assert (= ($$ 2 ** 3 ** 4 + 1) (+ 1 (math/pow 2 (math/pow 3 4))))) 15 | 16 | # Examples 17 | (def a 123123) 18 | (def b 12391) 19 | (def y [10 20 30 40]) 20 | (def z :thing) 21 | (defn good? [z] (not z)) 22 | (assert (= ($$ a + b ** 2) (+ a (math/pow b 2)))) 23 | (assert (= ($$ (a + b) ** 2) (math/pow (+ a b) 2))) 24 | (assert (= ($$ y[2] + y[3]) (+ (in y 2) (in y 3)))) 25 | (assert (= ($$ a > b and ,(good? z)) (and (> a b) (good? z)))) 26 | 27 | # Logic (and or) 28 | (assert (= ($$ true and nil) nil)) 29 | (assert (= ($$ true and not nil) true)) 30 | (assert (= ($$ false or not false) true)) 31 | (assert (= ($$ false or true and not false) true)) 32 | (assert (= ($$ false or true and ! false) true)) 33 | 34 | # Bit operations 35 | (assert (= ($$ 1 << 1) 2)) 36 | (assert (= ($$ 1 >> 1) 0)) 37 | (assert (= ($$ 0xFF00 & 0xFF) 0)) 38 | (assert (= ($$ 0xFF00 band 0xFF) 0)) 39 | (assert (= ($$ 0xFF00 bor 0xFF) 0xFFFF)) 40 | (assert (= ($$ 0xFF00 ^ 0xFF) 0xFFFF)) 41 | (assert (= ($$ 0xFF0 ^ 0x0FF) 0xF0F)) 42 | (assert (= ($$ 0xFF00 bor 0xFF bor 0x10000) 0x1FFFF)) 43 | 44 | # Array indexing 45 | (def an-array [:a :b :c 1 2 3]) 46 | (assert (= :b ($$ an-array[1]))) 47 | (assert-error "out of bounds" ($$ an-array[100])) 48 | 49 | # Mutation with ++ and -- 50 | (var a 0) 51 | (assert (= 11 ($$ ++ a + 10))) 52 | (assert (= 10 ($$ -- a + 10))) 53 | 54 | # Comparisons 55 | (assert (= true ($$ 100 > 20))) 56 | (assert (= false ($$ 10 > 20))) 57 | (assert (= true ($$ 100 >= 20))) 58 | (assert (= true ($$ 20 >= 20))) 59 | (assert (= false ($$ 10 >= 20))) 60 | (assert (= true ($$ 0 < 20))) 61 | (assert (= false ($$ 20 < 20))) 62 | (assert (= false ($$ 40 < 20))) 63 | (assert (= true ($$ 0 <= 20))) 64 | (assert (= true ($$ 20 <= 20))) 65 | (assert (= false ($$ 40 <= 20))) 66 | (assert (= true ($$ :a = :a))) 67 | (assert (= false ($$ :b = :a))) 68 | (assert (= false ($$ :a != :a))) 69 | (assert (= true ($$ :b != :a))) 70 | (assert (= false ($$ :a not= :a))) 71 | (assert (= true ($$ :b not= :a))) 72 | (assert ($$ 10 <= 20 and 30 < 40)) 73 | 74 | (end-suite) 75 | -------------------------------------------------------------------------------- /doc/api/htmlgen.mdz: -------------------------------------------------------------------------------- 1 | {:title "htmlgen" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | HTMLgen is a rendering engine that can render plain data structures into 8 | an HTML string. Its API has only one constant and two functions: 9 | 10 | @ul{ 11 | @li{constant @code`doctype` is a string with html5 doctype header} 12 | @li{function @code`raw` returns the function that will add the raw string, passed as an argument to the function, to the output, when rendered, without any escaping.} 13 | @li{function @code`html` has one required argument @code`data` with the data structure rendered into bytes with HTML code. And optional @code`buf` to which function renders final bytes. If you do not provide the @code`buf`, it will create a new one.} } 14 | 15 | ## Rules for rendering data structures 16 | 17 | Example: 18 | 19 | @codeblock[janet]``` 20 | (use spork/htmlgen) 21 | (defn append-year [buf] (buffer/push buf (string ((os/date) :year)))) 22 | (html 23 | @[[:head 24 | @[[:meta {:charset "htf-8"}] 25 | [:title "Spork"]]] 26 | [:body 27 | @[[:header "Menu"] 28 | [:main [:section "News"]] 29 | [:footer "All right reserved " append-year]]]]) 30 | 31 | => @"Spork
Menu
News
All right reserved 2022
" 32 | ``` 33 | 34 | We will show how HTMLgen renders from the data structure by dissecting 35 | the example above: 36 | 37 | @ul{ 38 | @li{`array` (and @code`fiber` which is not in the example) each member of 39 | the sequence renders by one of these rules.} 40 | @li{@code`tuple` represents the HTML tag. The first member must be the name of 41 | the HTML tag. The second member can be a dictionary with HTML attributes 42 | for the HTML tag. All the other members are children of the tag and renders 43 | according to these rules.} 44 | @li{@code`string`, @code`buffer`, @code`number` and @code`boolean` coerces to string and, 45 | if necessary, escaped and pushed to the buffer.} 46 | @li{@code`function` gets the buffer, with which it can do whatever it wants to, 47 | presumably push some more content, but anything.} 48 | @li{@code`nil` do not do anything to the buffer.} 49 | } 50 | 51 | As you may see, the rules are straightforward, yet with the @code`fiber` and @code`function` types you have pretty endless possibilities when constructing the HTML code from data structures. 52 | 53 | ## Reference 54 | 55 | @api-docs("../../spork" "htmlgen") 56 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Spork 2 | 3 | [![test](https://github.com/janet-lang/spork/actions/workflows/test.yml/badge.svg)](https://github.com/janet-lang/spork/actions/workflows/test.yml) 4 | 5 | Various Janet utility modules. Spork aims to be grab bag of useful Janet functionality that 6 | does not belong in the core library. 7 | 8 | To use all features mentioned below in one program you can do `(use spork)` to 9 | import them. When you need only part of the functionality, please use `import` 10 | as seen in the example for the part. 11 | 12 | ## Build 13 | 14 | ``` 15 | janet -l ./bundle -e '(build)' 16 | ``` 17 | 18 | ## Test 19 | 20 | Spork must be installed to test properly. 21 | 22 | ``` 23 | janet --install . 24 | janet -l ./bundle -e '(check)' 25 | ``` 26 | 27 | ## Installation 28 | 29 | As of Janet version 1.38.0, the normal Janet binary can install spork in the following way: 30 | 31 | ``` 32 | [sudo] janet --install . 33 | ``` 34 | 35 | This will install all spork modules to `$JANET_PATH` and all executable scripts to `$JANET_PATH/bin`. 36 | 37 | For versions prior to 1.38.0, but with support for the bundle module: 38 | 39 | ``` 40 | [sudo] janet -e '(bundle/install ".")' 41 | ``` 42 | 43 | Or, finally, with JPM (legacy): 44 | 45 | ``` 46 | [sudo] jpm install spork 47 | ``` 48 | 49 | ## Dependencies 50 | 51 | Spork contains third-party dependencies in the `deps/` directory. All dependencies are MIT/X11 licensed, or public domain. 52 | Licenses for individual components can be found along with the source code in the `deps/` directory. 53 | 54 | ## Documentation 55 | 56 | Spork's documentation is written using [Mendoza](https://github.com/bakpakin/mendoza). 57 | The docs are most easily read by first building and then serving the .mdz files in `doc/` using Mendoza. 58 | You can then access the served static site using a browser. 59 | 60 | - First, make sure you have [Janet](https://janet-lang.org/) and [jpm](https://janet-lang.org/docs/jpm.html) installed. See [the Janet docs](https://janet-lang.org/docs/index.html) for more information on this. 61 | - Next, install Mendoza (to install globally, run `[sudo] jpm install mendoza`). For more information on Mendoza, see [the Mendoza project on GitHub](https://github.com/bakpakin/mendoza). 62 | - Clone this repo locally (e.g. using `git clone https://github.com/janet-lang/spork.git`). 63 | - From the spork project root (`cd spork` if you just cloned it) run `mdz build && mdz serve`. 64 | 65 | While the Mendoza server process is running, you can navigate to http://localhost:8000 to view the spork docs as a static site. 66 | 67 | -------------------------------------------------------------------------------- /test/suite-utf8.janet: -------------------------------------------------------------------------------- 1 | (import spork/utf8) 2 | (use ../spork/test) 3 | 4 | (start-suite) 5 | 6 | ### 7 | ### utf8/decode-rune 8 | ### 9 | 10 | (eachp [enc dec] 11 | {"a" (chr "a") 12 | "á" 0xE1 13 | "ა" 0x10D0 14 | "𐊀" 0x10280} 15 | (assert (= [dec (length enc)] (utf8/decode-rune enc)) 16 | (string/format "utf8: decode (U+%X)" dec))) 17 | 18 | (each inv 19 | ["\x81" # stray continuation 20 | "\xf0\x90\x8a" "\xf0\x90\x8a" "\xf0\x90" "\xf0" # truncated forward 21 | "\x90\x8a\x80" "\x8a\x80" "\x80" # truncated backward 22 | "\xfe" "\xff"] # invalid 23 | (assert (= [nil 0] (utf8/decode-rune inv)) 24 | (string/format "utf8: decode invalid (%q)" inv))) 25 | 26 | (defn- decode-iterate [buf] 27 | (var i 0) 28 | (def iter @[]) 29 | (while (< i (length buf)) 30 | (def [ch i+] (utf8/decode-rune buf i)) 31 | (when (nil? ch) 32 | (errorf "invalid UTF-8 sequence: %q (pos %d)" buf i)) 33 | (+= i i+) 34 | (array/push iter ch)) 35 | iter) 36 | (eachp [utf8 codepoints] 37 | {"ķēķī" @[0x137 0x113 0x137 0x12B] 38 | "チェリー" @[0x30C1 0x30A7 0x30EA 0x30FC] 39 | "🤣😜🐕" @[0x1F923 0x1F61C 0x1F415] 40 | "あaá🇦" @[0x3042 0x61 0xE1 0x1F1E6]} 41 | (assert (deep= codepoints (decode-iterate utf8)) 42 | (string/format "utf8: decode iterate (%q)" codepoints))) 43 | 44 | (let [enc "あ"] 45 | (loop [i :range [1 3]] 46 | (assert (= [nil 0] (utf8/decode-rune enc i)) 47 | (string/format "utf8: decode from truncated start (%d)" i)))) 48 | 49 | ### 50 | ### utf8/prefix->width 51 | ### 52 | 53 | (eachp [prefix len] 54 | {0x7F 1 55 | 0x80 1 # invalid (truncated) 56 | 0xDF 2 57 | 0xEF 3 58 | 0xF7 4 59 | 0xFB 1} # invalid (too long) 60 | (assert (= len (utf8/prefix->width prefix)) 61 | (string/format "utf8: prefix->width (%X)" prefix))) 62 | 63 | ### 64 | ### utf8/encode-rune 65 | ### 66 | (assert (deep= @"a" (utf8/encode-rune (chr "a"))) 67 | "utf8: encode simple") 68 | (assert (deep= @"\xC3\xA1" (utf8/encode-rune 0xE1)) 69 | "utf8: encode 2byte") 70 | (assert (deep= @"\xE3\x81\x82" (utf8/encode-rune 0x3042)) 71 | "utf8: encode 3byte") 72 | (assert (deep= @"\xF0\x92\x81\x9E" (utf8/encode-rune 0x1205E)) 73 | "utf8: encode 4byte") 74 | (let [[ok err] (protect (utf8/encode-rune 0x110000))] 75 | (assert (false? ok) 76 | (string/format "utf8: encode overlong (got %q)" err))) 77 | 78 | # buffer reuse 79 | (let [b @"a"] 80 | (assert (= b (utf8/encode-rune 0xE1 b)) 81 | "utf8: encode reuse buffer") 82 | (assert (deep= @"aá" b) 83 | "utf8: encode reuse buffer (encoding result)")) 84 | 85 | (end-suite) 86 | -------------------------------------------------------------------------------- /spork/generators.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### generators.janet 3 | ### 4 | ### Module for fiber based sequence combinators rather than array based combinators, as 5 | ### are in the core library. 6 | ### 7 | 8 | (defn from-iterable 9 | "Create a new generator around any iterable data structure." 10 | [ds] 11 | (coro (each x ds (yield x)))) 12 | 13 | (defn range 14 | "Create a lazy range." 15 | [from to] 16 | (coro (for i from to (yield i)))) 17 | 18 | (defn to-array 19 | "Consume `s` into a new array." 20 | [s] 21 | (seq [v :in s] v)) 22 | 23 | (defn run 24 | "Evaluate `s` for side effects." 25 | [s] 26 | (each _ s)) 27 | 28 | (defn concat 29 | "Concatenate one or more generators or iterables into a single generator." 30 | [& xs] 31 | (coro (each x xs 32 | (each elem x (yield elem))))) 33 | 34 | (defn map 35 | "Create a generator that maps `f` over `ds`." 36 | [f ds] 37 | (coro (each x ds (yield (f x))))) 38 | 39 | (defn mapcat 40 | "Map `f` over `ds`, concatenating the results into a new generator." 41 | [f ds] 42 | (coro (each x ds 43 | (each elem (f x) (yield elem))))) 44 | 45 | (defn filter 46 | "Create a generator that filters `ds` with `p`." 47 | [p ds] 48 | (coro (each x ds (if (p x) (yield x))))) 49 | 50 | (defn take 51 | "Take `n` elements from iterable `ds`." 52 | [n ds] 53 | (coro 54 | (var taken 0) 55 | (each x ds 56 | (yield x) 57 | (+= taken 1) 58 | (if (= taken n) 59 | (break))))) 60 | 61 | (defn take-while 62 | "Return elements from `ds` while `p` is true." 63 | [p ds] 64 | (coro (each x ds 65 | (if (p x) 66 | (yield x) 67 | (break))))) 68 | 69 | (defn take-until 70 | "Return elements from `ds` until `p` is true." 71 | [p ds] 72 | (take-while (complement p) ds)) 73 | 74 | (defn drop 75 | "Drop `n` elements from `ds`." 76 | [n ds] 77 | (coro 78 | (var dropped 0) 79 | (each x ds 80 | (if (= dropped n) 81 | (yield x) 82 | (+= dropped 1))))) 83 | 84 | (defn drop-while 85 | "Drop elements from `ds` while `p` is true." 86 | [p ds] 87 | (coro 88 | (var dropping true) 89 | (each x ds 90 | (if (and dropping (p x)) 91 | nil 92 | (do 93 | (set dropping false) 94 | (yield x)))))) 95 | 96 | (defn drop-until 97 | "Drop elements from `ds` until `p` is true." 98 | [p ds] 99 | (drop-while (complement p) ds)) 100 | 101 | (defn cycle 102 | "Repeatedly yield the elements of `ds`, looping back to the beginning when finished." 103 | [ds] 104 | (coro 105 | (var i nil) 106 | (while true 107 | (set i (next ds i)) 108 | (if (nil? i) (set i (next ds))) 109 | (yield (ds i))))) 110 | -------------------------------------------------------------------------------- /bin/janet-netrepl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env janet 2 | 3 | (import spork/netrepl) 4 | (import spork/argparse) 5 | 6 | (defn- main 7 | [&] 8 | 9 | (def ap 10 | (argparse/argparse 11 | "Start a networked REPL server or client" 12 | 13 | :default 14 | {:kind :accumulate 15 | :help "Files to load into the environment"} 16 | 17 | "host" 18 | {:short "H" 19 | :help (string "The server host to serve the repl on. Default is " netrepl/default-host) 20 | :default netrepl/default-host 21 | :kind :option} 22 | 23 | "port" 24 | {:short "P" 25 | :help (string "The server port to serve the repl on. Default is " netrepl/default-port) 26 | :default netrepl/default-port 27 | :kind :option} 28 | 29 | "unix-socket" 30 | {:short "U" 31 | :help (string "Unix socket path to serve the repl at.") 32 | :kind :option} 33 | 34 | "client" 35 | {:short "c" 36 | :kind :flag 37 | :help "Spawn a netrepl client instead of a server"} 38 | 39 | "client-name" 40 | {:short "n" 41 | :kind :option 42 | :help "Set the name of the connecting client"} 43 | 44 | "library" 45 | {:short "l" 46 | :kind :accumulate 47 | :help "Load libraries in the repl as with the janet -l flag"} 48 | 49 | "dofile" 50 | {:short "d" 51 | :kind :option 52 | :help "Pass in a file to evaluate with dofile for each new environment table"} 53 | 54 | "message" 55 | {:short "m" 56 | :kind :option 57 | :help "Specify a short message to show clients on connection"} 58 | 59 | "message-file" 60 | {:short "M" 61 | :kind :option 62 | :help "Specify a file to load as a welcome message for new connections"} 63 | 64 | "single-env" 65 | {:short "s" 66 | :kind :flag 67 | :help "Share a single environment between multiple connections"})) 68 | 69 | # Break on help text 70 | (unless ap (break)) 71 | (def [host port] (if-let [path (ap "unix-socket")] 72 | [:unix path] 73 | [(ap "host") (ap "port")])) 74 | (def dof (ap "dofile")) 75 | (def msg (ap "message")) 76 | (def msg-file (ap "message-file")) 77 | (def files (get ap :default [])) 78 | (def libraries (get ap "library" [])) 79 | (defn make-msg 80 | [&] 81 | (if msg (string msg "\n") 82 | (if msg-file (slurp msg-file)))) 83 | (defn env-make 84 | [&] 85 | (let [e (make-env)] 86 | (each l libraries (merge-module e (require l))) 87 | (each f files (merge-module e (dofile f))) 88 | (put e :pretty-format "%.20Q") 89 | (when dof (dofile dof :env e)) 90 | e)) 91 | (if (ap "client") 92 | (netrepl/client host port (ap "client-name")) 93 | (if (ap "single-env") 94 | (netrepl/server-single host port env-make nil make-msg) 95 | (netrepl/server host port env-make nil make-msg)))) 96 | -------------------------------------------------------------------------------- /test/suite-test.janet: -------------------------------------------------------------------------------- 1 | (import ../spork/test) 2 | 3 | (test/start-suite) 4 | # test/assert 5 | (assert (test/assert true "assert")) 6 | 7 | # test/assert-not 8 | (assert (test/assert-not false "assert-not")) 9 | 10 | # test/assert-error 11 | (assert (test/assert-error "assert-error" (error "Bad"))) 12 | 13 | # test/assert-no-error 14 | (assert (test/assert-no-error "assert-no-error" "Good")) 15 | 16 | # test/capture-stdout 17 | (test/assert (= [true "Output\n"] (test/capture-stdout (print "Output") true)) "capture stdout") 18 | 19 | # test/capture-stderr 20 | (test/assert (= [true "Output\n"] 21 | (test/capture-stderr (eprint "Output") true)) "capture stderr") 22 | 23 | # test/timeit 24 | (do 25 | (def [result output] 26 | (test/capture-stdout 27 | (test/timeit (loop [i :range [1 100000]] i) "foo:"))) 28 | (test/assert (nil? result)) 29 | (def m (peg/match '(* "foo: " (<- (some :S)) " seconds\n" -1) output)) 30 | (test/assert (truthy? m) "timeit -- invalid output") 31 | (test/assert (scan-number (in m 0)) "timeit -- invalid number of seconds")) 32 | 33 | (do 34 | (def [result output] 35 | (test/capture-stdout 36 | (test/timeit "someresult"))) 37 | (test/assert (= result "someresult") "timeit2 -- invalid return") 38 | (def m (peg/match '(* "Elapsed time: " (<- (some :S)) " seconds\n" -1) output)) 39 | (test/assert (truthy? m) "timeit2 -- invalid output") 40 | (test/assert (scan-number (in m 0)) "timeit2 -- invalid number of seconds")) 41 | 42 | # test/capture-stdout 43 | (test/assert 44 | (= [nil "\nRunning test suite 666 tests...\n\n\e[32m\xE2\x9C\x94\e[0m\n\nTest suite 666 finished in 0.000 soconds\n13 of 13 tests passed.\n\n"]) 45 | (test/capture-stdout 46 | (test/start-suite 666) 47 | (test/assert true "true") 48 | (test/end-suite))) 49 | 50 | # test/suppress-stdout 51 | (test/assert 52 | (= [nil ""] 53 | (test/capture-stdout 54 | (test/suppress-stdout (print "Hello world!")))) 55 | "suppress-stdout") 56 | 57 | # test/suppress-stdout 58 | (test/assert 59 | (= [nil ""] 60 | (test/capture-stderr 61 | (test/suppress-stderr (print "Hello world!")))) 62 | "suppress-stderr") 63 | 64 | (test/assert-docs "/spork/test") 65 | (test/assert-docs "/spork/argparse") 66 | (test/assert-docs "/spork/fmt") 67 | (test/assert-docs "/spork/generators") 68 | (test/assert-docs "/spork/getline") 69 | (test/assert-docs "/spork/htmlgen") 70 | (test/assert-docs "/spork/http") 71 | (test/assert-docs "/spork/httpf") 72 | (test/assert-docs "/spork/misc") 73 | (test/assert-docs "/spork/msg") 74 | (test/assert-docs "/spork/netrepl") 75 | (test/assert-docs "/spork/path") 76 | (test/assert-docs "/spork/regex") 77 | (test/assert-docs "/spork/rpc") 78 | (test/assert-docs "/spork/schema") 79 | (test/assert-docs "/spork/sh") 80 | (test/assert-docs "/spork/tasker") 81 | (test/assert-docs "/spork/temple") 82 | 83 | (test/assert-docs "spork/json") 84 | (test/assert-docs "spork/tarray") 85 | (test/assert-docs "spork/rawterm") 86 | (test/assert-docs "spork/utf8") 87 | 88 | (test/end-suite) 89 | -------------------------------------------------------------------------------- /src/tarray.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2021 Calvin Rose 3 | * 4 | * Permission is hereby granted, free of charge, to any person obtaining a copy 5 | * of this software and associated documentation files (the "Software"), to 6 | * deal in the Software without restriction, including without limitation the 7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or 8 | * sell copies of the Software, and to permit persons to whom the Software is 9 | * furnished to do so, subject to the following conditions: 10 | * 11 | * The above copyright notice and this permission notice shall be included in 12 | * all copies or substantial portions of the Software. 13 | * 14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 20 | * IN THE SOFTWARE. 21 | */ 22 | 23 | #ifndef JANET_TYPED_ARRAYS_H_defined 24 | #define JANET_TYPED_ARRAYS_H_defined 25 | 26 | #include 27 | 28 | #ifdef __cplusplus 29 | extern "C" { 30 | #endif 31 | 32 | extern JANET_API const JanetAbstractType janet_ta_view_type; 33 | extern JANET_API const JanetAbstractType janet_ta_buffer_type; 34 | 35 | typedef enum { 36 | JANET_TARRAY_TYPE_U8, 37 | JANET_TARRAY_TYPE_S8, 38 | JANET_TARRAY_TYPE_U16, 39 | JANET_TARRAY_TYPE_S16, 40 | JANET_TARRAY_TYPE_U32, 41 | JANET_TARRAY_TYPE_S32, 42 | JANET_TARRAY_TYPE_U64, 43 | JANET_TARRAY_TYPE_S64, 44 | JANET_TARRAY_TYPE_F32, 45 | JANET_TARRAY_TYPE_F64 46 | } JanetTArrayType; 47 | 48 | typedef struct { 49 | uint8_t *data; 50 | size_t size; 51 | int32_t flags; 52 | } JanetTArrayBuffer; 53 | 54 | typedef struct { 55 | union { 56 | void *pointer; 57 | uint8_t *u8; 58 | int8_t *s8; 59 | uint16_t *u16; 60 | int16_t *s16; 61 | uint32_t *u32; 62 | int32_t *s32; 63 | uint64_t *u64; 64 | int64_t *s64; 65 | float *f32; 66 | double *f64; 67 | } as; 68 | JanetTArrayBuffer *buffer; 69 | size_t size; 70 | size_t stride; 71 | JanetTArrayType type; 72 | } JanetTArrayView; 73 | 74 | JANET_API JanetTArrayBuffer *janet_tarray_buffer(size_t size); 75 | JANET_API JanetTArrayView *janet_tarray_view(JanetTArrayType type, size_t size, size_t stride, size_t offset, JanetTArrayBuffer *buffer); 76 | JANET_API int janet_is_tarray_view(Janet x, JanetTArrayType type); 77 | JANET_API JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n); 78 | JANET_API JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type); 79 | JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n); 80 | 81 | #ifdef __cplusplus 82 | } 83 | #endif 84 | 85 | #endif /* JANET_TYPED_ARRAYS_H_defined */ 86 | -------------------------------------------------------------------------------- /doc/api/netrepl.mdz: -------------------------------------------------------------------------------- 1 | {:title "netrepl" 2 | :template "mdzdoc/main.html"} 3 | --- 4 | 5 | A simple async networked repl (both client and server) with a remote debugger 6 | and the ability to repl into existing environments. 7 | 8 | 9 | ## Specifying the Environment 10 | 11 | Provide various ways to produce the environment to repl into. 12 | @ol{ 13 | @li{an environment factory function, called for each connection.} 14 | @li{an env (table value) - this means every connection will share the same environment} 15 | @li{default env, made via make-env with nice printing for each new connection.} 16 | } 17 | 18 | ## NETREPL Protocol 19 | 20 | Clients don't need to support steps 4. and 5. if they never send messages prefixed with 0xFF or 0xFE bytes. These bytes should not occur in normal Janet source code and are not even valid utf8. 21 | 22 | Any message received by the client that begins with 0xFF should result in printing the message to a console, but not otherwise interrupt the flow of the protocol. 23 | This easily allows for partial results. A server should not send messages leading with 0xFF to the client unless the client is created with the :auto-flush connection setting. 24 | 25 | Any message received by the client that begins with 0xFE will discard this first byte and continue processing as usual. 26 | 27 | @ol{ 28 | @li{server <- {connection settings, including client name@code[}] <- client 29 | @ol{@li{If msg starts with 0xFF, parse message as (-> msg (slice 1) parse) and extract the :name key as the name. Other connection settings can be stored here.} 30 | @li{If msg does not start with 0xFF, the message is treated as the client name. Other options are considered nil.}}} 31 | @li{server -> {repl prompt (no newline)@code[}] -> client} 32 | @li{server <- {one chunk of input (msg)@code[}] <- client} 33 | @li{If (= (msg 0) 0xFF) 34 | @ol{@li{(def result (-> msg (slice 1) parse eval protect))} 35 | @li{server -> result -> client} 36 | @li{goto 3.}}} 37 | @li{If (= (msg 0) 0xFE)} 38 | @ol{@li{Return msg as either: 39 | @ol{@li{a keyword if the msg contains a command (e.g. :cancel)} 40 | @li{an array if the msg contains a command and arguments (e.g. @code`@[:source "path/to/source"]`}} 41 | @li{goto 6b.}}} 42 | @li{Otherwise 43 | @ol{@li{Send chunk to repl input stream} 44 | @li{Unless auto-flush is enabled, server -> {(dyn :out) and (dyn :err) (empty at first)@code[}] -> client} 45 | @li{goto 2.}}} 46 | } 47 | 48 | ## Examples 49 | 50 | Launch a networked REPL server on one machine and connect to it from another machine or process. 51 | 52 | ### Server 53 | 54 | @codeblock[janet]``` 55 | (import spork/netrepl) 56 | 57 | (def some-def 10) 58 | 59 | # Serve a repl into the current environment (@code`some-def` will be visible). 60 | (netrepl/server "127.0.0.1" "9000" (fiber/getenv (fiber/current))) 61 | ``` 62 | 63 | ### Client 64 | 65 | @codeblock[janet]``` 66 | (import spork/netrepl) 67 | 68 | # Starts a nice terminal repl. 69 | (netrepl/client "127.0.0.1" "9000" "bob") 70 | ``` 71 | 72 | ## Reference 73 | 74 | @api-docs("../../spork" "netrepl") 75 | -------------------------------------------------------------------------------- /doc/api/data.mdz: -------------------------------------------------------------------------------- 1 | {:title "data" 2 | :author "Caleb Figgers" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | @p{@link[https://clojure.org/]{Clojure} contains a very useful core library (or "namespace" in Clojure parlance) called @link[https://clojure.github.io/clojure/clojure.data-api.html]{clojure.data} (@link[https://github.com/clojure/clojure/blob/51c6d7a70912a8f65e81a8e11ae6f56c94920725/src/clj/clojure/data.clj]{source}). It contains one "exported" function: @code`clojure.data/diff`. This addition to spork, @code`data.janet`, should exactly replicate the behavior of @code`clojure.data/diff` using Janet tables, structs, arrays, and tuples in place of their Clojure equivalents.} 8 | 9 | ## Function 10 | 11 | The @code`diff` function recursively compares the structure and contents of two data structures (struct, table, tuple, array) and returns an array with three elements: 12 | 13 | @codeblock[janet]`@[things-only-in-a things-only-in-b things-in-both]` 14 | 15 | In the case of nested associative data structures (i.e., tables and structs), the comparison is recursive and the data structures are neatly partitioned into the same @code`@[things-only-in-a things-only-in-b things-in-both]` structure, but arbitrary levels deep in the two original associative data structures. 16 | 17 | This function makes comparing two structs or tables for changes trivial. (An example use case: compare the decoded JSON returned from a REST API call made seconds ago against the version of that same decoded JSON from that same API that was returned from the same call made an hour ago and stored locally in a database for comparison an hour later.) 18 | 19 | ## Example 20 | 21 | So for example, @code`diff`'ing the two nested structs @code`{:a 1 :b 2 :c {:d 3 :e 4}}` and @code`{:a 4 :b 2 :c {:d 3 :e 5 :f 6}}` looks like this: 22 | 23 | @codeblock[janet]``` 24 | repl:1:> (import spork/data :as d) 25 | repl:2:> (d/diff {:a 1 :b 2 :c {:d 3 :e 4}} {:a 4 :b 2 :c {:d 3 :e 5 :f 6}}) 26 | @[@{:a 1 :c @{:e 4}} @{:a 4 :c @{:e 5 :f 6}} @{:b 2 :c @{:d 3}}] 27 | ``` 28 | 29 | The return is @code`@[@{:a 1 :c @{:e 4}} @{:a 4 :c @{:e 5 :f 6}} @{:b 2 :c @{:d 3}}]` because: 30 | 31 | @ul{ 32 | @li{the value for @code`:a` appears in both and is different in each one (so @code`:a` is a key in both the first and second returned table, with each value set as seen in the first and second original structs)} 33 | @li{the value for @code`:b` appears in both and is the same in each (so @code`:b` is a key only in the third returned table, containing the shared value in both original strucs)} 34 | @li{the nested value of @code`:d` appears in both and is the same in each (so @code`:c` is a key in the third returned table, containing the value of @code`:d` that is shared in both original structs)} 35 | @li{the nested value of @code`:e` appears in both and is different in each one (so @code`:c` is a key in both the first and second returned table, containing the value @code`:e` with with each value set as seen in the first and second original structs), and} 36 | @li{the key/value pair @code`:f` 6 only appears in the latter original struct (so only the second returned table contains @code`:f` and its value).} 37 | } 38 | 39 | ## Reference 40 | 41 | @api-docs("../../spork" "data") 42 | -------------------------------------------------------------------------------- /spork/htmlgen.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### HTML generation using plain data. 3 | ### 4 | 5 | (def- escape-peg 6 | (peg/compile 7 | ~(% (any (+ (* "&" (constant "&")) 8 | (* "\"" (constant """)) 9 | (* "<" (constant "<")) 10 | (* ">" (constant ">")) 11 | (* "'" (constant "'")) 12 | '1))))) 13 | (defn escape 14 | "Escape characters in a string for HTML" 15 | [x] 16 | (in (peg/match escape-peg (string x)) 0)) 17 | 18 | (var- render nil) 19 | 20 | (defn- render-each 21 | [to arr] 22 | (each el arr 23 | (render to el))) 24 | 25 | (defn- render-attrs 26 | [to attrs] 27 | (eachk k attrs 28 | (buffer/push to " " k `="` (escape (get attrs k)) `"`))) 29 | 30 | (defn- render-normal-tag 31 | [to tag attrs children] 32 | (buffer/push to "<" tag) 33 | (render-attrs to attrs) 34 | (buffer/push to ">") 35 | (render-each to children) 36 | (buffer/push to "")) 37 | 38 | (defn- render-self-closed-tag 39 | [to tag attrs] 40 | (buffer/push to "<" tag) 41 | (render-attrs to attrs) 42 | (buffer/push to "/>")) 43 | 44 | (def- self-close-tags 45 | {:area true 46 | :base true 47 | :br true 48 | :col true 49 | :embed true 50 | :hr true 51 | :img true 52 | :input true 53 | :link true 54 | :meta true 55 | :param true 56 | :source true 57 | :track true 58 | :wbr true 59 | :command true 60 | :keygen true 61 | :menuitem true}) 62 | 63 | (defn- render-tag 64 | [to tag attrs children] 65 | (if (get self-close-tags tag) 66 | (render-self-closed-tag to tag attrs) 67 | (render-normal-tag to tag attrs children))) 68 | 69 | (defn- render-tuple 70 | [to tup] 71 | (def [tag maybe-attrs] tup) 72 | (assert tag "expected tag") 73 | (if (dictionary? maybe-attrs) 74 | (render-tag to tag maybe-attrs (drop 2 tup)) 75 | (render-tag to tag {} (drop 1 tup)))) 76 | 77 | (defn- render-bytes 78 | [to bytes] 79 | (buffer/push to (escape bytes))) 80 | 81 | (defn- render-function 82 | [to f] 83 | (f to)) 84 | 85 | (def- type-renders 86 | {:tuple render-tuple 87 | :array render-each 88 | :string render-bytes 89 | :buffer render-bytes 90 | :fiber render-each 91 | :number render-bytes 92 | :boolean render-bytes 93 | :nil (fn [&]) 94 | :function render-function}) 95 | 96 | (defn- render1 97 | [to x] 98 | (def handler (get type-renders (type x))) 99 | (if handler 100 | (handler to x) 101 | (errorf "cannot render %V" x))) 102 | 103 | (set render render1) 104 | 105 | ### 106 | ### Public API 107 | ### 108 | 109 | (defn raw 110 | "Get an object that can be used to splice in HTML literals. 111 | `text` is not escaped in the output string." 112 | [text] 113 | (fn [buf] (buffer/push buf text))) 114 | 115 | (def doctype-html 116 | "The html5 doctype header" 117 | (raw "")) 118 | 119 | (defn html 120 | "Render HTML from standard data structures. Fills the provided optional 121 | buffer, or new one if it is not provided, with the html bytes." 122 | [data &opt buf] 123 | (default buf @"") 124 | (render buf data) 125 | buf) 126 | -------------------------------------------------------------------------------- /doc/api/test.mdz: -------------------------------------------------------------------------------- 1 | {:title "test" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | This module contains a simple test helper when you do not need a specialized 8 | library. 9 | 10 | ## Examples 11 | 12 | ### assert 13 | 14 | Modified version of `assert`, with some nice error handling. 15 | 16 | @codeblock[janet]``` 17 | (test/assert false "How is this?") 18 | # => ✘ How is this? 19 | (test/assert true "OK") 20 | # => ✔true 21 | ``` 22 | 23 | 24 | ### assert-not 25 | 26 | Invert assert. 27 | 28 | @codeblock[janet]``` 29 | (test/assert-not false "OK") 30 | # => ✔true 31 | ``` 32 | 33 | 34 | ### assert-error 35 | 36 | Test passes if forms throw errors. 37 | 38 | @codeblock[janet]``` 39 | (test/assert-error "To err is natural" (error "Bad")) 40 | # => ✔true 41 | ``` 42 | 43 | 44 | ### assert-no-error 45 | 46 | Test passes if forms throw errors. 47 | 48 | @codeblock[janet]``` 49 | (test/assert-no-error "To not err is desired" (do "Good")) 50 | # => ✔true 51 | ``` 52 | 53 | 54 | ### start-suite 55 | 56 | Starts test suite, which counts all and passed tests. 57 | 58 | 59 | ### end-suite 60 | 61 | Ends test suite, prints summary and exits if any have failed. 62 | 63 | 64 | ### All together 65 | 66 | Example of simple test suite. 67 | 68 | @codeblock[janet]``` 69 | (import spork/test) 70 | 71 | (test/start-suite 0) 72 | 73 | (test/assert true "is always true") 74 | (test/assert-not false "is always false") 75 | (test/assert-error "To err is natural" (error "Bad")) 76 | (test/assert-no-error "To not err is desired" (do "Good")) 77 | 78 | (test/end-suite) 79 | 80 | # => 81 | 82 | Test suite 0 finished in 0.000 soconds 83 | 4 of 4 tests passed. 84 | ``` 85 | 86 | 87 | ### timeit 88 | 89 | Time code execution using os/clock, and print the result. 90 | Returns the value of the timed expression. 91 | 92 | @codeblock[janet]``` 93 | repl> (test/timeit (sum (seq [i :range [1 1000000]] (math/sqrt i)))) 94 | Elapsed time: 0.0718288 seconds 95 | 6.66666e+08 96 | ``` 97 | 98 | 99 | ### capture-stdout 100 | 101 | Runs the body and captures stdout. Returns tuple with result and captured 102 | stdout in string. 103 | 104 | @codeblock[janet]``` 105 | (capture-stdout 106 | (print "Interesting output") 107 | true) 108 | # => (true "Interesting output") 109 | ``` 110 | 111 | 112 | ### capture-stderr 113 | 114 | Runs the body and captures stderr. Returns tuple with result and captured 115 | stderr in string. 116 | 117 | @codeblock[janet]``` 118 | (capture-stderr 119 | (print "Interesting output") 120 | true) 121 | # => (true "Interesting output") 122 | ``` 123 | 124 | 125 | ### supress-stdout 126 | 127 | Runs the form, but supresses its stdout. 128 | 129 | @codeblock[janet]``` 130 | (suppress-stdout (print "Hello world!")) 131 | # => nil 132 | ``` 133 | 134 | 135 | ### supress-stderr 136 | 137 | Runs the form, but supresses its stderr. 138 | 139 | @codeblock[janet]``` 140 | (suppress-stderr (eprint "Hello world!")) 141 | # => nil 142 | ``` 143 | 144 | ### assert-docs 145 | 146 | Asserts that all public bindings from the environment have docstring, 147 | when the `path` is required. 148 | 149 | @codeblock[janet]``` 150 | (assert-doc "/spork/test") 151 | ✘ suppress-stderr does not have proper doc 152 | ``` 153 | 154 | ## Reference 155 | 156 | @api-docs("../../spork" "test") 157 | 158 | -------------------------------------------------------------------------------- /spork/pm-config.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### Configuration from environment variables for pm.janet and declare-cc.janet. 3 | ### 4 | 5 | (def default-pkglist 6 | "The default package listing for resolving short bundle names." 7 | "https://github.com/janet-lang/pkgs.git") 8 | 9 | (defn detect-toolchain 10 | "Auto-detect the current compiler toolchain." 11 | [env] 12 | (cond 13 | (get env :toolchain) (get env :toolchain) 14 | (os/getenv "MSVC") :msvc 15 | (os/getenv "GCC") :gcc 16 | (os/getenv "CLANG") :clang 17 | (os/getenv "CC") :cc # any posix compatible compiler accessed via `cc` 18 | (= :windows (os/which)) :msvc 19 | (os/compiler))) 20 | 21 | # Fix for janet 1.35.2 22 | (compwhen (not (dyn 'assertf)) 23 | (defmacro- assertf 24 | "Convenience macro that combines `assert` and `string/format`." 25 | [x fmt & args] 26 | (def v (gensym)) 27 | ~(do 28 | (def ,v ,x) 29 | (if ,v 30 | ,v 31 | (,errorf ,fmt ,;args))))) 32 | 33 | (defn- set1 34 | [env d e &opt xform] 35 | (default xform identity) 36 | (when-let [x (os/getenv e)] 37 | (put env d (xform x)))) 38 | 39 | (defn- tobool 40 | [x] 41 | (get 42 | {"t" true "true" true "1" true "yes" true "on" true} 43 | (string/ascii-lower (string/trim x)) false)) 44 | 45 | (defn- toposint 46 | [x] 47 | (def y (scan-number x)) 48 | (assertf (and (>= y 1) (int? y)) "expected a positive integer for number of workers, got %v" x) 49 | y) 50 | 51 | (defn- make-enum 52 | [name & options] 53 | (def enum-set (tabseq [o :in options] o o)) 54 | (fn enum 55 | [x] 56 | (def y (-> x string/ascii-lower keyword)) 57 | (assertf (in enum-set y) "unknown option %v for %s. Expected one of %s." x name (string/join options ", ")) 58 | y)) 59 | 60 | (def- build-type-xform (make-enum "build type" :debug :develop :release)) 61 | (def- toochain-xform (make-enum "toolchain" :gcc :clang :msvc :cc)) # TODO mingw, zig 62 | 63 | (defn read-env-variables 64 | "Read and validate environment variables for configuration. These environment variables are 65 | translated to dynamic bindings and stored in an environment table. By default, store the bindings in the current environment." 66 | [&opt env] 67 | (default env (curenv)) 68 | (when (get env :is-configured) (break)) 69 | (set1 env :janet-prefix "JANET_PREFIX") 70 | (set1 env :gitpath "JANET_GIT") 71 | (set1 env :curlpath "JANET_CURL") 72 | (set1 env :tarpath "JANET_TAR") 73 | (set1 env :build-type "JANET_BUILD_TYPE" build-type-xform) 74 | (set1 env :toolchain "JANET_TOOLCHAIN" toochain-xform) 75 | (set1 env :build-root "JANET_BUILD_DIR") 76 | (set1 env :offline "JANET_OFFLINE" tobool) 77 | (set1 env :pkglist "JANET_PKGLIST") 78 | (set1 env :workers "WORKERS" toposint) 79 | (set1 env :verbose "VERBOSE" tobool) 80 | (put env :is-configured true)) 81 | 82 | (defn print-config 83 | "Print all current settings" 84 | [&opt env] 85 | (default env (curenv)) 86 | (print "build dir: " (get env :build-root "_build")) 87 | (print "build type: " (get env :build-type "release")) 88 | (print "curl: " (get env :curlpath "curl")) 89 | (print "git: " (get env :gitpath "git")) 90 | (print "offline: " (if (get env :offline) "true" "false")) 91 | (print "pkg list: " (get env :pkglist default-pkglist)) 92 | (print "prefix: " (get env :janet-prefix "")) 93 | (print "syspath: " (get env *syspath* "")) 94 | (print "tar: " (get env :tarpath "tar")) 95 | (print "toolchain: " (detect-toolchain env)) 96 | (print "verbose: " (if (get env :verbose) "true" "false")) 97 | (print "workers: " (get env :workers (os/cpu-count)))) 98 | -------------------------------------------------------------------------------- /spork/infix.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### infix.janet - A macro for infix syntax in Janet. Useful for math. 3 | ### 4 | ### Examples: 5 | ### 6 | ### ($$ a + b ** 2) ---> (+ a (math/pow b 2)) 7 | ### ($$ (a + b) ** 2) ---> (math/pow (+ a b) 2) 8 | ### ($$ y[2] + y[3]) ---> (+ (in y 2) (in y 3)) 9 | ### ($$ a > b and ,(good? z)) ---> (and (> a b) (good? z)) 10 | ### 11 | ### Syntax is as follows: 12 | ### 13 | ### Binary operators <<, >>, >>>, =, !=, <, <=, >, >=, &, ^, bor, band, and, or, 14 | ### +, -, *, /, %, ** are supported. Operator precedence is in the 15 | ### `precedence table below (higher means more tightly binding). All 16 | ### operators are left associative except ** (math/pow), which is right 17 | ### associative. 18 | ### 19 | ### Unary prefix operators !, -, bnot, not, ++, -- are supported. 20 | ### No unary postfix operators are supported. 21 | ### 22 | ### Square brackets can be used for indexing. 23 | ### 24 | ### Normal parentheses are used for making subgroups 25 | ### 26 | ### You can "escape" infix syntax use a quote or unquote (comma) 27 | ### 28 | 29 | (def- precedence 30 | {'>> 9 31 | '<< 9 32 | '>>> 9 33 | '= 8 34 | '!= 8 35 | 'not= 8 36 | '< 8 37 | '<= 8 38 | '>= 8 39 | '> 8 40 | '& 7 41 | '^ 6 42 | 'bor 5 43 | 'band 5 44 | 'and 4 45 | 'or 3 46 | '+ 10 47 | '- 10 48 | '* 20 49 | '/ 20 50 | '% 20 51 | '** 30 52 | '! 40 53 | 'not 40 54 | 'bnot 40 55 | '++ 40 56 | '-- 40}) 57 | 58 | (def- right-associative 59 | {'** true}) 60 | 61 | (def- unary 62 | {'! true '- true 'bnot true 'not true '++ true '-- true}) 63 | 64 | (def- replacements 65 | {'** math/pow 66 | '>> brshift 67 | '<< blshift 68 | '>>> brushift 69 | '^ bxor 70 | '! not 71 | '!= not= 72 | '& band}) 73 | 74 | (defn- tup? [x] (and (tuple? x) (= (tuple/type x) :parens))) 75 | (defn- brak? [x] (and (tuple? x) (= (tuple/type x) :brackets))) 76 | 77 | (defn- parse-tokens 78 | [raw-tokens] 79 | # Allow breaking out of infix syntax with ' or , 80 | (when (= 'quote (first raw-tokens)) 81 | (break raw-tokens)) 82 | (when (= 'unquote (first raw-tokens)) 83 | (break (get raw-tokens 1))) 84 | (def tokens 85 | (keep-syntax 86 | raw-tokens 87 | (map |(if (tup? $) (parse-tokens $) $) raw-tokens))) 88 | (var i -1) 89 | (defn eat [] (get tokens (++ i))) 90 | (defn uneat [] (-- i)) 91 | (defn parse-expression 92 | [lhs min-prec] 93 | (when (get unary lhs) 94 | (break (parse-expression 95 | (keep-syntax raw-tokens [(get replacements lhs lhs) 96 | (parse-expression (eat) (get precedence lhs 0))]) 97 | min-prec))) 98 | (def op (eat)) 99 | (def prec (get precedence op 0)) 100 | (cond 101 | (nil? op) lhs # done 102 | 103 | (brak? op) # array subscripting (highest precedence) 104 | (let [index (parse-tokens op)] 105 | (parse-expression [in lhs index] min-prec)) 106 | 107 | # Function application for math/sin, etc. 108 | (tup? op) 109 | (parse-expression [lhs op] min-prec) 110 | 111 | (zero? prec) (errorf "expected binary operator, got %p" op) 112 | 113 | ((if (get right-associative op) >= >) prec min-prec) # climb precendence 114 | (let [next-token (eat) 115 | rhs (parse-expression next-token prec) 116 | real-op (get replacements op op)] 117 | (parse-expression (keep-syntax raw-tokens [real-op lhs rhs]) min-prec)) 118 | 119 | :else # lower precedence 120 | (do (uneat) lhs))) 121 | (def ret (parse-expression (eat) 0)) 122 | (when (= nil ret) 123 | (errorf "expected non-empty expression, got %p" raw-tokens)) 124 | ret) 125 | 126 | (defmacro $$ 127 | "Use infix syntax for writing expressions in a more familiar manner. Useful for writing mathematic expressions." 128 | [& body] 129 | (def res (parse-tokens body)) 130 | res) 131 | -------------------------------------------------------------------------------- /spork/randgen.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### randgen.janet 3 | ### 4 | ### Macros and utilties for executing psuedo probabalistic "random" code. 5 | ### The PRNG is a dynamic binding, allowing for easy deterministic execution 6 | ### 7 | 8 | (defdyn *rng* "RNG used to generate random numbers") 9 | 10 | (defn- get-rng 11 | `` 12 | Get RNG. 13 | 14 | If dynamic variable *rng* is non-nil, use that as RNG. 15 | Otherwise create a new RNG and set the dynamic variable 16 | *rng* to the newly created value. 17 | `` 18 | [] 19 | (def rng (dyn *rng*)) 20 | (if rng rng (setdyn *rng* (math/rng)))) 21 | 22 | (defn set-seed 23 | "Sets the RNG seed for execution" 24 | [seed] 25 | (setdyn *rng* (math/rng seed))) 26 | 27 | (defn rand-uniform 28 | "Get a random number uniformly between 0 and 1" 29 | [] 30 | (math/rng-uniform (get-rng))) 31 | 32 | (defn rand-int 33 | "Get a random integer in a range [start, end) that is approximately uniformly distributed" 34 | [start end] 35 | (def diff (- end start)) 36 | (+ start (math/floor (* diff (rand-uniform))))) 37 | 38 | (defn rand-gaussian 39 | "Get a random sample from the standard Gaussian distribution. 40 | Optionall specify the mean m and the standard deviation sd. 41 | " 42 | [&opt m sd] 43 | (default m 0) 44 | (default sd 1) 45 | (defn scale [x] (+ m (* sd x))) 46 | 47 | (def p (math/rng-uniform (get-rng))) 48 | (def q (math/rng-uniform (get-rng))) 49 | 50 | # We use the Box-Muller transform 51 | (let [rho (math/sqrt (* -2 (math/log q))) 52 | theta (* 2 math/pi p) 53 | _muller (* rho (math/sin theta)) 54 | # in devices where hardware entropy pool usage should be efficient 55 | # we can achieve x2 efficiency by using the `box` variable as well 56 | # _box (* rho (math/cos theta)) 57 | # box (scale _box) 58 | muller (scale _muller)] 59 | 60 | muller)) 61 | 62 | (defn sample-n 63 | "Generate n samples based on the random sampler `f`." 64 | [f n] 65 | (take n (generate [_ :iterate true] 66 | (f)))) 67 | 68 | (defn rand-index 69 | "Get a random numeric index of an indexed data structure" 70 | [xs] 71 | (rand-int 0 (length xs))) 72 | 73 | (defn rand-value 74 | "Get a random value of an indexed data structure" 75 | [xs] 76 | (get xs (rand-int 0 (length xs)))) 77 | 78 | (defn weights-to-cdf 79 | "Convert an array of weights to a discrete cdf that can be more efficiently used to 80 | take a weighted random choice" 81 | [weights] 82 | (def inv-total-weight (/ (sum weights))) 83 | (var cumsum 0) 84 | (seq [w :in weights] 85 | (+= cumsum w) 86 | (* cumsum inv-total-weight))) 87 | 88 | (defn rand-cdf 89 | "Pick a random index, weighted by a discrete cumulative distribution function." 90 | [cdf] 91 | (def p (rand-uniform)) 92 | (def l (length cdf)) 93 | (var min-idx 0) 94 | (var max-idx l) 95 | (while (< min-idx max-idx) 96 | (def mid-idx (math/floor (* 0.5 (+ min-idx max-idx)))) 97 | (def mid-p (get cdf mid-idx)) 98 | (if (<= mid-p p) 99 | (set min-idx (+ 1 mid-idx)) 100 | (set max-idx mid-idx))) 101 | min-idx) 102 | 103 | (defn rand-weights 104 | "Pick a random index given a set of weights" 105 | [weights] 106 | (rand-cdf (weights-to-cdf weights))) 107 | 108 | (defmacro rand-path 109 | "Execute one of the paths randomly with uniform distribution" 110 | [& paths] 111 | ~(case (,rand-int 0 ,(length paths)) 112 | ,;(array/concat @[] ;(map tuple (range (length paths)) paths)))) 113 | 114 | (defmacro rand-cdf-path 115 | "Execute one of the paths randomly given a discrete distribution as a CDF" 116 | [cdf & paths] 117 | ~(case (,rand-cdf ,cdf) 118 | ,;(array/concat @[] ;(map tuple (range (length paths)) paths)))) 119 | 120 | (defmacro rand-weights-path 121 | "Execute one of the paths randomly given a discrete distribution as a set of weights" 122 | [weights & paths] 123 | ~(case (,rand-weights ,weights) 124 | ,;(array/concat @[] ;(map tuple (range (length paths)) paths)))) 125 | -------------------------------------------------------------------------------- /deps/miniz/readme.md: -------------------------------------------------------------------------------- 1 | ## Miniz 2 | 3 | Miniz is a lossless, high performance data compression library in a single source file that implements the zlib (RFC 1950) and Deflate (RFC 1951) compressed data format specification standards. It supports the most commonly used functions exported by the zlib library, but is a completely independent implementation so zlib's licensing requirements do not apply. Miniz also contains simple to use functions for writing .PNG format image files and reading/writing/appending .ZIP format archives. Miniz's compression speed has been tuned to be comparable to zlib's, and it also has a specialized real-time compressor function designed to compare well against fastlz/minilzo. 4 | 5 | ## Usage 6 | 7 | Releases are available at the [releases page](https://github.com/richgel999/miniz/releases) as a pair of `miniz.c`/`miniz.h` files which can be simply added to a project. To create this file pair the different source and header files are [amalgamated](https://www.sqlite.org/amalgamation.html) during build. Alternatively use as cmake or meson module (or build system of your choice). 8 | 9 | ## Features 10 | 11 | * MIT licensed 12 | * A portable, single source and header file library written in plain C. Tested with GCC, clang and Visual Studio. 13 | * Easily tuned and trimmed down by defines 14 | * A drop-in replacement for zlib's most used API's (tested in several open source projects that use zlib, such as libpng and libzip). 15 | * Fills a single threaded performance vs. compression ratio gap between several popular real-time compressors and zlib. For example, at level 1, miniz.c compresses around 5-9% better than minilzo, but is approx. 35% slower. At levels 2-9, miniz.c is designed to compare favorably against zlib's ratio and speed. See the miniz performance comparison page for example timings. 16 | * Not a block based compressor: miniz.c fully supports stream based processing using a coroutine-style implementation. The zlib-style API functions can be called a single byte at a time if that's all you've got. 17 | * Easy to use. The low-level compressor (tdefl) and decompressor (tinfl) have simple state structs which can be saved/restored as needed with simple memcpy's. The low-level codec API's don't use the heap in any way. 18 | * Entire inflater (including optional zlib header parsing and Adler-32 checking) is implemented in a single function as a coroutine, which is separately available in a small (~550 line) source file: miniz_tinfl.c 19 | * A fairly complete (but totally optional) set of .ZIP archive manipulation and extraction API's. The archive functionality is intended to solve common problems encountered in embedded, mobile, or game development situations. (The archive API's are purposely just powerful enough to write an entire archiver given a bit of additional higher-level logic.) 20 | 21 | ## Building miniz - Using vcpkg 22 | 23 | You can download and install miniz using the [vcpkg](https://github.com/Microsoft/vcpkg) dependency manager: 24 | 25 | git clone https://github.com/Microsoft/vcpkg.git 26 | cd vcpkg 27 | ./bootstrap-vcpkg.sh 28 | ./vcpkg integrate install 29 | ./vcpkg install miniz 30 | 31 | The miniz port in vcpkg is kept up to date by Microsoft team members and community contributors. If the version is out of date, please [create an issue or pull request](https://github.com/Microsoft/vcpkg) on the vcpkg repository. 32 | 33 | ## Known Problems 34 | 35 | * No support for encrypted archives. Not sure how useful this stuff is in practice. 36 | * Minimal documentation. The assumption is that the user is already familiar with the basic zlib API. I need to write an API wiki - for now I've tried to place key comments before each enum/API, and I've included 6 examples that demonstrate how to use the module's major features. 37 | 38 | ## Special Thanks 39 | 40 | Thanks to Alex Evans for the PNG writer function. Also, thanks to Paul Holden and Thorsten Scheuermann for feedback and testing, Matt Pritchard for all his encouragement, and Sean Barrett's various public domain libraries for inspiration (and encouraging me to write miniz.c in C, which was much more enjoyable and less painful than I thought it would be considering I've been programming in C++ for so long). 41 | 42 | Thanks to Bruce Dawson for reporting a problem with the level_and_flags archive API parameter (which is fixed in v1.12) and general feedback, and Janez Zemva for indirectly encouraging me into writing more examples. 43 | 44 | ## Patents 45 | 46 | I was recently asked if miniz avoids patent issues. miniz purposely uses the same core algorithms as the ones used by zlib. The compressor uses vanilla hash chaining as described [here](https://datatracker.ietf.org/doc/html/rfc1951#section-4). Also see the [gzip FAQ](https://web.archive.org/web/20160308045258/http://www.gzip.org/#faq11). In my opinion, if miniz falls prey to a patent attack then zlib/gzip are likely to be at serious risk too. 47 | -------------------------------------------------------------------------------- /spork/rpc.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### rpc.janet 3 | ### 4 | ### Simple RPC server and client tailored to Janet. 5 | ### 6 | 7 | (use ./msg) 8 | (use ./ev-utils) 9 | 10 | (def default-host 11 | "Default host to run server on and connect to." 12 | "127.0.0.1") 13 | 14 | (def default-port 15 | "Default port to run the net repl." 16 | "9366") 17 | 18 | # RPC Protocol 19 | # 20 | # All prodcedure calls must be accompanied by a nonce value. This can be any non-repeating 21 | # value that is unique per-connection - a sequence of increasing integers works well. 22 | # 23 | # 1. server <- {user specified name of client} <- client 24 | # 2. server -> {marshalled tuple of supported keys in marshal dict (capabilites)} -> client 25 | # 3. server <- {marshalled function call: [nonce fnname args]} <- client 26 | # 4. server -> {result of unmarshalled call: [nonce status result]} -> client 27 | # 5. go back to 3. 28 | 29 | (defn server 30 | "Create an RPC server. The default host is \"127.0.0.1\" and the 31 | default port is \"9366\". Also must take a dictionary of functions 32 | that clients can call." 33 | [functions &opt host port workers-per-connection] 34 | (default host default-host) 35 | (default port default-port) 36 | (default workers-per-connection 1) 37 | (def keys-msg (keys functions)) 38 | (net/server 39 | host port 40 | (fn on-connection 41 | [stream] 42 | (var name "") 43 | (def marshbuf @"") 44 | (defer (:close stream) 45 | (def recv (make-recv stream unmarshal)) 46 | (def send (make-send stream marshal)) 47 | (set name (or (recv) (break))) 48 | (send keys-msg) 49 | (def chan-size (* 8 workers-per-connection)) 50 | (def in-queue (ev/chan chan-size)) 51 | (def out-queue (ev/chan chan-size)) 52 | (def n (nursery)) 53 | 54 | # Spawn message consumer - the only fiber reading from socket 55 | (spawn-nursery 56 | n 57 | (protect 58 | (while (def msg (recv)) 59 | (ev/give in-queue msg))) 60 | (ev/chan-close out-queue) 61 | (ev/chan-close in-queue)) 62 | 63 | # Spawn message producer - the only fiber writing to the socket 64 | (spawn-nursery 65 | n 66 | (while (def msg (ev/take out-queue)) 67 | (when (= :close (get msg 0)) (break)) # handle closed channel 68 | (send msg))) 69 | 70 | # Spawn n workers 71 | (repeat 72 | workers-per-connection 73 | (spawn-nursery 74 | n 75 | (while (def msg (ev/take in-queue)) 76 | (def [id name args] msg) 77 | (when (= :close id) (break)) 78 | (try 79 | (let [f (functions name)] 80 | (if-not f 81 | (error (string "no function " name " supported"))) 82 | (def result (f functions ;args)) 83 | (ev/give out-queue [id true result])) 84 | ([err] 85 | (ev/give out-queue [id false err])))))) 86 | 87 | # Wait for fibers to finish 88 | (join-nursery n))))) 89 | 90 | (defn client 91 | "Create an RPC client. The default host is \"127.0.0.1\" and the 92 | default port is \"9366\". Returns a table of async functions 93 | that can be used to make remote calls. This table also contains 94 | a :close function that can be used to close the connection." 95 | [&opt host port name] 96 | (default host default-host) 97 | (default port default-port) 98 | (default name (string "[" host ":" port "]")) 99 | (def stream (net/connect host port)) 100 | (def recv (make-recv stream unmarshal)) 101 | (def send (make-send stream marshal)) 102 | 103 | # Get methods 104 | (send name) 105 | (def fnames (recv)) 106 | 107 | # Build table 108 | (def chans @{}) 109 | (def send-chan (ev/chan)) 110 | (defn closer [&] (:close stream) (ev/chan-close send-chan)) 111 | (var nonce 0) 112 | 113 | (def producer 114 | (ev/spawn 115 | (while (def msg (ev/take send-chan)) 116 | (if (= :close (get msg 0)) (break)) 117 | (send msg)))) 118 | 119 | (def consumer 120 | (ev/spawn 121 | (while (def msg (recv)) 122 | (def [id] msg) 123 | (def c (get chans id)) 124 | (when c 125 | (put chans id nil) 126 | (ev/give c msg))))) 127 | 128 | # Use prototype to isolate rpc methods but still leave 129 | # access to internal fields - references to things like :close 130 | # can be overwritten but not deleted by rpc methods. 131 | (def ret 132 | (table/setproto 133 | @{} 134 | @{:close closer 135 | :channels chans 136 | :send-chan send-chan 137 | :consumer consumer 138 | :producer producer})) 139 | 140 | # Add methods from server 141 | (each f fnames 142 | (def k (keyword f)) 143 | (put ret k 144 | (fn rpc-function [_ & args] 145 | (def id (++ nonce)) 146 | (def c (ev/chan 1)) 147 | (put chans id c) 148 | (ev/give send-chan [id f args]) 149 | (let [[_ ok x] (ev/take c)] 150 | (if ok x (error x)))))) 151 | 152 | ret) 153 | -------------------------------------------------------------------------------- /test/suite-tarray.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (use ../spork/math) 3 | (import spork/tarray) 4 | 5 | (start-suite) 6 | 7 | (defn inspect-tarray 8 | [x] 9 | (def a @[]) 10 | (for i 0 (tarray/length x) (array/push a (x i))) 11 | (pp a)) 12 | 13 | (assert-no-error 14 | "create some typed arrays" 15 | (do 16 | (def a (tarray/new :float64 10)) 17 | (def b (tarray/new :float64 5 2 0 a)) 18 | (def c (tarray/new :uint32 20)))) 19 | 20 | (assert-no-error 21 | "create some typed arrays from a buffer" 22 | (do 23 | (def buf (tarray/buffer (+ 64 (* (+ 1 (* (- 10 1) 2)) 8)))) 24 | (def b (tarray/new :float64 10 2 64 buf)))) 25 | 26 | (def a (tarray/new :float64 10)) 27 | (def b (tarray/new :float64 5 2 0 a)) 28 | 29 | (assert-no-error 30 | "fill tarray" 31 | (for i 0 (tarray/length a) 32 | (set (a i) i))) 33 | 34 | (assert (= (tarray/buffer a) (tarray/buffer b)) "tarray views pointing same buffer") 35 | (assert (= (a 2) (b 1) ) "tarray views pointing same buffer") 36 | (assert (= ((tarray/slice b) 3) (b 3) (a 6) 6) "tarray slice") 37 | (assert (= ((tarray/slice b 1) 2) (b 3) (a 6) 6) "tarray slice") 38 | (assert (= (:length a) (length a)) "length method and function") 39 | 40 | (assert (= ((unmarshal (marshal b)) 3) (b 3)) "marshal") 41 | 42 | # Janet issue 408 43 | (assert-error :invalid-type (tarray/new :int32 10 1 0 (int/u64 7)) "tarray/new should only allow tarray or buffer for last argument") 44 | (def ta (tarray/new :int32 10)) 45 | (assert (= (next a nil) 0) "tarray next 1") 46 | (assert (= (next a 0) 1) "tarray next 2") 47 | (assert (= (next a 8) 9) "tarray next 3") 48 | (assert (nil? (next a 9)) "tarray next 4") 49 | (put ta 3 7) 50 | (put ta 9 7) 51 | (assert (= 2 (count |(= $ 7) ta)) "tarray count") 52 | 53 | # int64 typed arrays 54 | (def i64 int/s64) 55 | (def u64 int/u64) 56 | (assert (let [t (tarray/new :int64 10) 57 | b (i64 1000)] 58 | (set (t 0) 1000) 59 | (set (t 1) b) 60 | (set (t 2) "1000") 61 | (set (t 3) (t 0)) 62 | (set (t 4) (u64 1000)) 63 | (and 64 | (= (t 0) (t 1)) 65 | (= (t 1) (t 2)) 66 | (= (t 2) (t 3)) 67 | (= (t 3) (t 4)) 68 | )) 69 | "int64 typed arrays") 70 | 71 | # Janet Issue #142 72 | 73 | (def buffer (tarray/buffer 8)) 74 | (def buffer-float64-view (tarray/new :float64 1 1 0 buffer)) 75 | (def buffer-uint32-view (tarray/new :uint32 2 1 0 buffer)) 76 | 77 | (set (buffer-uint32-view 1) 0xfffe9234) 78 | (set (buffer-uint32-view 0) 0x56789abc) 79 | 80 | (assert (buffer-float64-view 0) "issue #142 nanbox hijack 1") 81 | (assert (= (type (buffer-float64-view 0)) :number) "issue #142 nanbox hijack 2") 82 | (assert (= (type (unmarshal @"\xC8\xbc\x9axV4\x92\xfe\xff")) :number) "issue #142 nanbox hijack 3") 83 | 84 | 85 | #construct random ta 86 | (math/seedrandom 12345) 87 | (def array (tarray/new :float64 100)) 88 | (for i 0 (tarray/length array) 89 | (put array i (math/random))) 90 | 91 | (math/seedrandom 123456) 92 | (def array2 (tarray/new :float64 100)) 93 | (for i 0 (tarray/length array2) 94 | (put array2 i (math/random))) 95 | 96 | (assert (approx-eq 0.208122 (median-absolute-deviation array) 0.00001) "median-absolute-deviation") 97 | (assert (approx-eq 0.274348 (sample-standard-deviation array) 0.000001) "sample-standard-deviation") 98 | (assert (approx-eq 0.272973 (standard-deviation array) 0.000001) "standard-deviation") 99 | (assert (let [[i a] (extent array)] 100 | (and (approx-eq i 0.00746957 0.000001) (approx-eq a 0.973551 0.000001))) "extent") 101 | (assert (approx-eq 48.7728 (sum-compensated array) 0.000001) "sum-compensated") 102 | (assert (approx-eq 0.558921 (root-mean-square array) 0.000001) "root-mean-square") 103 | (assert (approx-eq -0.124152 (sample-skewness array) 0.00001) "sample-skewness ") 104 | (assert (approx-eq 0.0745142 (variance array) 0.000001) "variance") 105 | (assert (approx-eq 0.0752669 (sample-variance array) 0.000001) "sample-variance") 106 | (assert-no-error (shuffle-in-place array) "shuffle-in-place") 107 | (assert (approx-eq 0.520372 (median array) 0.000001) "median") 108 | (assert (approx-eq 0.645951 (mode array) 0.000001) "mode") 109 | (assert (approx-eq 0.409312 (interquartile-range array) 0.000001) "interquartile-range") 110 | (assert (approx-eq 0.348654 (geometric-mean array) 0.00001) "geometric-mean") 111 | (assert (approx-eq 0.122595 (harmonic-mean array) 0.00001) "harmonic-mean") 112 | 113 | (assert (approx-eq 0.556132 (quantile-sorted array 0.5) 0.000001) "quantile-sorted") 114 | (assert (approx-eq 0.520372 (quantile array 0.5) 0.000001) "quantile") 115 | (assert (approx-eq 0.63 (quantile-rank-sorted array 0.5) 0.000001) "quantile-rank-sorted") 116 | (assert (approx-eq 0.49 (quantile-rank array 0.5) 0.000001) "quantile-rank") 117 | (assert (approx-eq 7.45142 (sum-nth-power-deviations array 2) 0.000001) "sum-nth-power-deviations") 118 | (assert-no-error (sample-covariance array array2) "sample-covariance") 119 | (assert-no-error (sample-correlation array array2) "sample-correlation") 120 | (assert-no-error (t-test array 3) "t-test array") 121 | (assert-no-error (t-test-2 array array2) "t-test-2") 122 | (assert-no-error (permutation-test array array2) "permutation-test array") 123 | 124 | (end-suite) 125 | 126 | -------------------------------------------------------------------------------- /spork/test.janet: -------------------------------------------------------------------------------- 1 | # Helper code for running tests 2 | 3 | (var num-tests-passed 0) 4 | (var num-tests-run 0) 5 | (var suite-num 0) 6 | (var start-time 0) 7 | 8 | (def- tests-passed-ref (get (dyn 'num-tests-passed) :ref)) 9 | (def- tests-run-ref (get (dyn 'num-tests-run) :ref)) 10 | 11 | (defmacro assert 12 | "Overrides the default assert with some nice error handling." 13 | [x &opt e] 14 | (default e (string/format "%j" (dyn :macro-form))) 15 | (def xx (gensym)) 16 | ~(do 17 | (++ (',tests-run-ref 0)) 18 | (def ,xx ,x) 19 | (if ,xx (++ (',tests-passed-ref 0))) 20 | (as-macro ,unless ,xx 21 | (if (os/isatty) 22 | (,prin "\e[31m✘\e[0m ") 23 | (,prin "[FAIL] ")) 24 | (,print ,e)) 25 | ,xx)) 26 | 27 | (defmacro assert-not 28 | "Invert assert." 29 | [x &opt e] 30 | ~(as-macro ,assert (,not ,x) ,e)) 31 | 32 | (defmacro assert-error 33 | "Test passes if forms error." 34 | [msg & forms] 35 | (def errsym (gensym)) 36 | ~(as-macro ,assert (,= ',errsym (as-macro ,try (do ,;forms) ([_] ',errsym))) ,msg)) 37 | 38 | (defmacro assert-no-error 39 | "Test passes if forms do not error." 40 | [msg & forms] 41 | (def errsym (gensym)) 42 | ~(as-macro ,assert (,not= ',errsym (as-macro ,try (do ,;forms) ([_] ',errsym))) ,msg)) 43 | 44 | (defn start-suite 45 | "Starts test suite." 46 | [&opt name] 47 | (default name (dyn :current-file)) 48 | (set suite-num name) 49 | (set start-time (os/clock)) 50 | (set num-tests-passed 0) 51 | (set num-tests-run 0)) 52 | 53 | (defn end-suite 54 | "Ends test suite, prints summary and exits if any tests have failed." 55 | [] 56 | (def delta (- (os/clock) start-time)) 57 | (prinf "test suite %V finished in %.3f seconds - " suite-num delta) 58 | (print num-tests-passed " of " num-tests-run " tests passed.") 59 | (if (not= num-tests-passed num-tests-run) (os/exit 1))) 60 | 61 | (defmacro timeit 62 | ``` 63 | Time the execution of `form` using `os/clock` before and after, 64 | and print the result to stdout. Returns result of executing `form`. 65 | Uses `tag` (default "Elapsed time:") to tag the printout. 66 | ``` 67 | [form &opt tag] 68 | (default tag "Elapsed time:") 69 | (with-syms [start result end] 70 | ~(do 71 | (def ,start (os/clock)) 72 | (def ,result ,form) 73 | (def ,end (os/clock)) 74 | (print ,tag " " (- ,end ,start) " seconds") 75 | ,result))) 76 | 77 | (defmacro timeit-loop 78 | ``Similar to `loop`, but outputs performance statistics after completion. 79 | Additionally defines a `:timeout` verb to iterate continuously for a given 80 | number of seconds. If the first form of `body` is a bytes, it will be taken 81 | as a custom tag.`` 82 | [head & body] 83 | (var tag "Elapsed time:") 84 | (def head2 @[;head]) 85 | (def body2 @[;body]) 86 | (with-syms [c start elapsed per-body] 87 | (when (def i (index-of :timeout head2)) 88 | (array/insert head2 i []) 89 | (set (head2 (+ i 1)) :iterate) 90 | (set (head2 (+ i 2)) ~(< (- (os/clock) ,start) ,(in head2 (+ i 2))))) 91 | (when (bytes? (get body2 0)) 92 | (set tag (in body2 0)) 93 | (array/remove body2 0)) 94 | ~(do 95 | (var ,c 0) 96 | (def ,start (os/clock)) 97 | (loop ,head2 (++ ,c) ,;body2) 98 | (def ,elapsed (- (os/clock) ,start)) 99 | (def ,per-body (/ ,elapsed ,c)) 100 | (cond 101 | (< ,per-body 1e-3) (printf "%s %.3fs, %.4gµs/body" ,tag ,elapsed (* ,per-body 1_000_000)) 102 | (< ,per-body 1) (printf "%s %.3fs, %.4gms/body" ,tag ,elapsed (* ,per-body 1_000)) 103 | (printf "%s %.3fs, %.4gs/body" ,tag ,elapsed ,per-body))))) 104 | 105 | (defmacro- capture-* 106 | [out & body] 107 | (with-syms [buf res] 108 | ~(do 109 | (def ,buf @"") 110 | (with-dyns [,out ,buf] 111 | (def ,res (do ,;body)) 112 | [,res (string ,buf)])))) 113 | 114 | (defmacro capture-stdout 115 | ``` 116 | Runs the form and captures stdout. Returns tuple with result of the form 117 | and a string with captured stdout. 118 | ``` 119 | [& body] 120 | ~(as-macro ,capture-* :out ,;body)) 121 | 122 | (defmacro capture-stderr 123 | ``` 124 | Runs the form and captures stderr. Returns tuple with result of the form 125 | and a string with captured stderr. 126 | ``` 127 | [& body] 128 | ~(as-macro ,capture-* :err ,;body)) 129 | 130 | (defmacro- suppress-* [out & body] 131 | ~(with-dyns [,out @""] ,;body)) 132 | 133 | (defmacro suppress-stdout 134 | "Suppreses stdout from the body" 135 | [& body] 136 | ~(as-macro ,suppress-* :out ,;body)) 137 | 138 | (defmacro suppress-stderr 139 | "Suppreses stderr from the body" 140 | [& body] 141 | ~(as-macro ,suppress-* :err ,;body)) 142 | 143 | (defn assert-docs 144 | ``` 145 | Assert that all symbols have proper docstring when module on the 146 | path is required. 147 | ``` 148 | [path] 149 | (loop [[sym val] :pairs (require path) 150 | :when (and (symbol? sym) (not (val :private)) (not (val :ref)))] 151 | (assert (and (val :doc) 152 | (peg/match '(* (+ (* "(" (thru ")\n\n")) 153 | (not "(")) 154 | (some 1) -1) 155 | (string/replace-all "\r" "" (get val :doc "")))) 156 | (string sym " does not have proper doc")))) 157 | -------------------------------------------------------------------------------- /test/suite-argparse.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/argparse) 3 | 4 | (start-suite) 5 | 6 | (def argparse-params 7 | ["A simple CLI tool. An example to show the capabilities of argparse." 8 | "debug" {:kind :flag 9 | :short "d" 10 | :help "Set debug mode."} 11 | "verbose" {:kind :multi 12 | :short "v" 13 | :help "Print debug information to stdout."} 14 | "key" {:kind :option 15 | :short "k" 16 | :help "An API key for getting stuff from a server." 17 | :required true} 18 | "expr" {:kind :accumulate 19 | :short "e" 20 | :help "Search for all patterns given."} 21 | "thing" {:kind :option 22 | :help "Some option?" 23 | :default "123"}]) 24 | 25 | (with-dyns [:args @["testcase.janet" "-k" "100"]] 26 | (def res (suppress-stdout (argparse/argparse ;argparse-params))) 27 | (when (res "debug") (error (string "bad debug: " (res "debug")))) 28 | (when (res "verbose") (error (string "bad verbose: " (res "verbose")))) 29 | (assert (= (res "key") "100") (string "bad key: " (res "key"))) 30 | (assert-not (res "expr") (string "bad expr: " (res "expr"))) 31 | (assert (= (res "thing") "123") (string "bad thing: " (res "thing")))) 32 | 33 | (with-dyns [:args @["testcase.janet" "-k" "100" "--thing"]] 34 | (def res (suppress-stdout (argparse/argparse ;argparse-params))) 35 | (assert-not res "Option \"thing\" missing arg, but result is non-nil.")) 36 | 37 | (with-dyns [:args @["testcase.janet" "-k" "100" "-e" "foo" "-e"]] 38 | (def res (suppress-stdout (argparse/argparse ;argparse-params))) 39 | (assert-not res "Option \"expr\" missing arg, but result is non-nil.")) 40 | 41 | (with-dyns [:args @["testcase.janet" "-k" "100" "-v" "--thing" "456" "-d" "-v" 42 | "-e" "abc" "-vvv" "-e" "def"]] 43 | (def res (suppress-stdout (argparse/argparse ;argparse-params))) 44 | (assert (res "debug") (string "bad debug: " (res "debug"))) 45 | (assert (= (res "verbose") 5) (string "bad verbose: " (res "verbose"))) 46 | (assert (= (tuple ;(res "expr")) ["abc" "def"]) 47 | (string "bad expr: " (string/join (res "expr") " "))) 48 | (assert (= (res "thing") "456") (string "bad thing: " (res "thing"))) 49 | (assert (= (tuple ;(res :order)) 50 | ["key" "verbose" "thing" "debug" "verbose" 51 | "expr" "verbose" "verbose" "verbose" "expr"]) 52 | (string "bad order: " (string/join (res :order) " ")))) 53 | 54 | (with-dyns [:args @["testcase.janet" "server"]] 55 | (def res (suppress-stdout (argparse/argparse 56 | "A simple CLI tool." 57 | :default {:kind :option}))) 58 | (assert (= (res :default) "server") 59 | (string "bad default " (res :default)))) 60 | 61 | (with-dyns [:args @["testcase.janet" "server" "run"]] 62 | (def res (suppress-stdout (argparse/argparse 63 | "A simple CLI tool." 64 | :default {:kind :accumulate}))) 65 | (assert (and (deep= (res :default) @["server" "run"])) 66 | (string "bad default " (res :default)))) 67 | 68 | (with-dyns [:args @["testcase.janet" "-k" "100" "--fake"]] 69 | (def res (suppress-stdout (argparse/argparse ;argparse-params))) 70 | (assert-not res "Option \"fake\" is not valid, but result is non-nil.")) 71 | 72 | (with-dyns [:args @["testcase.janet" "-l" "100" "--" "echo" "-n" "ok"]] 73 | (def res (suppress-stdout (argparse/argparse "A simple CLI tool" 74 | "length" {:kind :option 75 | :short "l" 76 | :help "key"} 77 | :default {:kind :accumulate}))) 78 | (assert res "arguments were not parsed correctly in the presence of `--`.") 79 | (def {"length" len :default cmd-args} res) 80 | (assert (= len "100") 81 | "option was not parsed correctly in the presence of `--`.") 82 | (assert (= ["echo" "-n" "ok"] (tuple ;cmd-args)) 83 | "unnamed arguments after `--` were not parsed correctly.")) 84 | 85 | (def argparse-params-with-shortcircuit 86 | ["A simple CLI tool. An example to show the capabilities of argparse." 87 | "debug" {:kind :flag 88 | :short "d" 89 | :help "Set debug mode."} 90 | "verbose" {:kind :multi 91 | :short "v" 92 | :help "Print debug information to stdout."} 93 | "key" {:kind :option 94 | :short "k" 95 | :help "An API key for getting stuff from a server." 96 | :required true} 97 | "expr" {:kind :accumulate 98 | :short "e" 99 | :help "Search for all patterns given."} 100 | "thing" {:kind :option 101 | :help "Some option?" 102 | :default "123"} 103 | :default {:kind :accumulate 104 | :short-circuit true}]) 105 | 106 | (with-dyns [:args @["testcase.janet" "-k" "100" "test" "--fake"]] 107 | (def res (suppress-stdout (argparse/argparse ;argparse-params-with-shortcircuit))) 108 | (assert (deep= res 109 | @{"key" "100" "thing" "123" :default @["test"] :order @["key" :default] :rest ["test" "--fake"]}) 110 | "argparse param :default {:short-circuit true} should not fail but return with res and :rest of arguments")) 111 | 112 | 113 | (end-suite) 114 | -------------------------------------------------------------------------------- /test/suite-randgen.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (use ../spork/randgen) 3 | 4 | (start-suite) 5 | 6 | (assert-docs "/spork/randgen") 7 | 8 | (def delta 0.00000000000001) 9 | 10 | (assert (do 11 | (set-seed 1) 12 | (def expected @[0.205397787403126 13 | 0.946474426007273 14 | 0.292829399753968 15 | 0.579518994067899 16 | 0.897969128303416 17 | 0.218425627853671 18 | 0.583403751886178 19 | 0.613190880523174]) 20 | (def actual 21 | (map |(do $ (rand-uniform)) 22 | (range (length expected)))) 23 | (and (all |(> delta (math/abs (- $0 $1))) 24 | expected actual) 25 | (all |(or (< 0 $ 1) (zero? $)) 26 | actual))) 27 | "rand-uniform") 28 | 29 | (assert (do 30 | (set-seed 1) 31 | (def expected @[5.0318756480189 5.10069692026214 4.89567968233822 4.95051117259612]) 32 | (def actual 33 | (sample-n |(rand-gaussian 5 0.1) 4)) 34 | (and (all |(> delta (math/abs (- $0 $1))) 35 | expected actual))) 36 | "sample-rand-gaussian") 37 | 38 | (assert (do 39 | (set-seed 1) 40 | (def expected 0.318756480188982) 41 | (def actual (rand-gaussian)) 42 | (|(> delta (math/abs (- $0 $1))) expected actual) 43 | "call-rand-gaussian")) 44 | 45 | (assert (do 46 | (set-seed 1) 47 | (def low 0) 48 | (def hi 11) 49 | (def expected @[2 10 3 6 9 2 6 6]) 50 | (def actual 51 | (map |(do $ (rand-int low hi)) 52 | (range (length expected)))) 53 | (and (deep= expected actual) 54 | (all |(<= low $ (dec hi)) 55 | actual))) 56 | "rand-int") 57 | 58 | (def animals [:ant :bee :cat :dog :ewe :fox :gnu :hog]) 59 | 60 | (assert (do 61 | (set-seed 1) 62 | (def expected @[1 7 2 4 7 1 4 4]) 63 | (def actual 64 | (map |(do $ (rand-index animals)) 65 | (range (length expected)))) 66 | (and (deep= expected actual) 67 | (all |(<= 0 $ (dec (length expected))) 68 | actual))) 69 | "rand-index") 70 | 71 | (assert (do 72 | (set-seed 1) 73 | (def expected @[:bee :hog :cat :ewe :hog :bee :ewe :ewe]) 74 | (def actual 75 | (map |(do $ (rand-value animals)) 76 | (range (length expected)))) 77 | (and (deep= expected actual) 78 | (all |(index-of $ animals) 79 | actual))) 80 | "rand-value") 81 | 82 | (assert (deep= (weights-to-cdf [2 6 8]) 83 | @[0.125 0.5 1]) 84 | "weights-to-cdf") 85 | 86 | (def delta2 0.1) 87 | 88 | (assert (do 89 | (set-seed 1) 90 | (def w1 1) 91 | (def w2 2) 92 | (def weights [w1 w2]) 93 | (var n-w1-idx 0) 94 | (var n-w2-idx 0) 95 | (var other false) 96 | (loop [_ :range [0 1000]] 97 | (def res (rand-cdf (weights-to-cdf weights))) 98 | (cond 99 | (zero? res) (++ n-w1-idx) 100 | (one? res) (++ n-w2-idx) 101 | (set other true))) 102 | (and (not other) 103 | (> delta2 (math/abs (- (/ w2 w1) (/ n-w2-idx n-w1-idx)))))) 104 | "rand-cdf") 105 | 106 | (assert (do 107 | (set-seed 2) 108 | (def w1 1) 109 | (def w2 2) 110 | (def weights [w1 w2]) 111 | (var n-w1-idx 0) 112 | (var n-w2-idx 0) 113 | (var other false) 114 | (loop [_ :range [0 10000]] 115 | (def res (rand-weights weights)) 116 | (cond 117 | (zero? res) (++ n-w1-idx) 118 | (one? res) (++ n-w2-idx) 119 | (set other true))) 120 | (and (not other) 121 | (> delta2 (math/abs (- (/ w2 w1) (/ n-w2-idx n-w1-idx)))))) 122 | "rand-weights") 123 | 124 | (assert (do 125 | (set-seed 1) 126 | (def counts @{}) 127 | (for _ 0 1000 128 | (rand-path (put counts :ant (inc (get counts :ant 0))) 129 | (put counts :bee (inc (get counts :bee 0))) 130 | (put counts :cat (inc (get counts :cat 0))))) 131 | (deep= counts @{:ant 344 :bee 318 :cat 338})) 132 | "rand-path") 133 | 134 | (assert (do 135 | (set-seed 1) 136 | (def counts @{}) 137 | (for _ 0 1000 138 | (rand-cdf-path (weights-to-cdf [1 2 3]) 139 | (put counts :ant (inc (get counts :ant 0))) 140 | (put counts :bee (inc (get counts :bee 0))) 141 | (put counts :cat (inc (get counts :cat 0))))) 142 | (deep= counts @{:ant 177 :bee 318 :cat 505})) 143 | "rand-cdf-path") 144 | 145 | (assert (do 146 | (set-seed 1) 147 | (def counts @{}) 148 | (for _ 0 1000 149 | (rand-weights-path [1 2 3] 150 | (put counts :ant (inc (get counts :ant 0))) 151 | (put counts :bee (inc (get counts :bee 0))) 152 | (put counts :cat (inc (get counts :cat 0))))) 153 | (deep= counts @{:ant 177 :bee 318 :cat 505})) 154 | "rand-weights-path") 155 | 156 | (end-suite) 157 | -------------------------------------------------------------------------------- /man/janet-pm.1: -------------------------------------------------------------------------------- 1 | .TH JANET-PM 1 2 | .SH NAME 3 | janet-pm \- the Janet Project Manager, a build tool for Janet 4 | .SH SYNOPSIS 5 | .B janet-pm 6 | [\fB\-\-flag ...\fR] 7 | [\fB\-\-option=value ...\fR] 8 | .IR command 9 | .IR args ... 10 | 11 | .SH DESCRIPTION 12 | Run from a directory containing a project.janet file to perform 13 | operations on a project, or from anywhere to do operations on the 14 | global module cache (modpath). Commands that need write permission to 15 | the modpath are considered privileged commands - in some environments 16 | they may require super user privileges. Other project-level commands 17 | need to have a ./project.janet file in the current directory. 18 | 19 | .SH DOCUMENTATION 20 | 21 | .SH GLOBAL COMMANDS 22 | 23 | .TP 24 | .BR help 25 | Show this help text. 26 | 27 | .TP 28 | .BR install\ [\fBrepo...\fR] 29 | Install remote bundles, and any required dependencies. 30 | 31 | .TP 32 | .BR clear-cache 33 | Clear the cache of saved remote dependencies. 34 | 35 | .TP 36 | .BR list-pkgs\ [\fBsearch\fR] 37 | List packages in the remote package listing that contain the 38 | string search. If no search pattern is given, prints the 39 | entire package listing. 40 | 41 | .TP 42 | .BR env\ name 43 | Create an environment with which one can install Janet dependencies 44 | and scripts in an isolated manner. 45 | 46 | .TP 47 | .BR new-project\ [\fBname\fR] 48 | Create a new Janet project in a directory `name`. 49 | 50 | .TP 51 | .BR new-simple-project\ [\fBname\fR] 52 | Create a new Janet project that can be installed and distributed without spork in a directory `name`. 53 | 54 | .TP 55 | .BR new-c-project\ [\fBname\fR] 56 | Create a new C+Janet project in a directory `name`. 57 | 58 | .TP 59 | .BR new-exe-project\ [\fBname\fR] 60 | new-exe-project name 61 | Create a new project for an executable in a directory `name`. 62 | 63 | .SH PER-PROJECT COMMANDS 64 | 65 | .TP 66 | .BR deps 67 | Install dependencies for the current project. 68 | 69 | .TP 70 | .BR install\ [\fBrepos...\fR] 71 | Install artifacts of the current project. Shorthand for `janet --install .` 72 | 73 | .TP 74 | .BR uninstall\ [\fBrepos...\fR] 75 | Uninstall the current project's artifacts. Shorthand for `janet --uninstall {current-project-name}` 76 | 77 | .TP 78 | .BR prune 79 | Remove any bundles that have no dependents and are marked for auto-remove. 80 | 81 | .TP 82 | .BR build 83 | Build all artifacts of the project. The build configuration is determined by JANET_BUILD_TYPE, and the 84 | location of artifacts will by in the JANET_BUILD_DIR directory. 85 | 86 | .TP 87 | .BR clean 88 | Remove any generated files or artifacts. Calls the `(clean)` hook. 89 | 90 | .TP 91 | .BR test 92 | Run tests. Tests should be .janet files in the test/ directory 93 | relative to project.janet. Will patch the module paths to load 94 | built native code without installing it. Shorthand for `run check`. 95 | 96 | .TP 97 | .BR quickbin\ [\fBentry\fR]\ [\fBoutput\fR] 98 | Create an executable file from a script, statically linking in any dependencies found while compiling 99 | the script. The script should contain a main function that will serve as the main function for the generated 100 | executable. 101 | 102 | .TP 103 | .BR save-lockfile\ [\fBdestination\fR] 104 | Save all currently installed bundles to a lockfile. 105 | 106 | .TP 107 | .BR load-lockfile\ [\fBsource\fR] 108 | Install all bundles in the given lockfile. 109 | 110 | .SH ENVIRONMENT VARIABLES 111 | 112 | janet-pm inherits all of the environment variables used by janet, as well some of its own. Many of these are 113 | only used in support of building bundles that use a project.janet. 114 | 115 | .B JANET_BUILD_DIR 116 | .RS 117 | Where to create build outputs when building a bundle has a project.janet. Defaults to _build. 118 | .RE 119 | 120 | .B JANET_BUILD_TYPE 121 | .RS 122 | What kind of build to make when building a bundle that has a project.janet. 123 | Should be "develop", "release", or "debug". 124 | .RE 125 | 126 | .B JANET_CURL 127 | .RS 128 | Where to get the "curl" command when handling project.janet. Defaults to "curl". 129 | .RE 130 | 131 | .B JANET_GIT 132 | .RS 133 | Where to get the "git" command when handling project.janet. Defaults to "git". 134 | .RE 135 | 136 | .B JANET_OFFLINE 137 | .RS 138 | If set to 1, true, on, etc., will only look at packages in the local cache. 139 | .RE 140 | 141 | .B JANET_PKGLIST 142 | .RS 143 | The package listing repository to use to resolve package nicknames. Defaults to https://github.com/janet-lang/pkgs.git 144 | .RE 145 | 146 | .B JANET_PREFIX 147 | .RS 148 | Where POSIX toolchain will look for Janet headers and libjanet.a. By default, will try to autodetect by searching through the 149 | syspath, the PREFIX environment variable, /usr/, and /usr/local. Most installs should not need to set this, but otherwise should 150 | be set to whatever PREFIX was when janet was installed. 151 | .RE 152 | 153 | .B JANET_TAR 154 | .RS 155 | Where to get the "tar" command. Defaults to "tar". 156 | .RE 157 | 158 | .B JANET_TOOLCHAIN 159 | .RS 160 | Name of the toolchain to use to compile project.janet based natives. Should be one of "gcc", "clang", "msvc", or "cc". 161 | Defaults to autodetecting based on the presence of other environment variables MSVC, GCC, CLANG, and CC. 162 | Will then finally default to whatever compiler was used to compile the `janet` executable running this script. This 163 | is the output of `janet -e '(print (os/compiler))'` 164 | .RE 165 | 166 | .B VERBOSE 167 | .RS 168 | Print full output from running commands. 169 | .RE 170 | 171 | .B WORKERS 172 | .RS 173 | Number of processes to run in parallel when compiling C and C++ source code. 174 | .RE 175 | -------------------------------------------------------------------------------- /spork/temple.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### temple.janet 3 | ### Copyright © Calvin Rose 2020 4 | ### 5 | 6 | (defmacro- defenv 7 | "Define a module inline as if returned by require." 8 | [what docstring & forms] 9 | (def env (make-env)) 10 | (each f forms 11 | (resume (fiber/setenv (coro (eval f)) env))) 12 | ~(def ,what ,docstring ',env)) 13 | 14 | (defenv base-env 15 | "Base environment for rendering" 16 | # Define forms available inside the temple DSL here 17 | (def- escape-peg 18 | (peg/compile 19 | ~(% (any (+ (* "&" (constant "&")) 20 | (* "\"" (constant """)) 21 | (* "<" (constant "<")) 22 | (* ">" (constant ">")) 23 | (* "'" (constant "'")) 24 | '1))))) 25 | (defn escape [x] 26 | (in (peg/match escape-peg (string x)) 0))) 27 | 28 | (defn create 29 | "Compile a template string into a function. Optionally 30 | provide a location where the source is from to improve debugging. Returns 31 | the template function." 32 | [source &opt where] 33 | 34 | (default where source) 35 | (def env (table/setproto @{} base-env)) 36 | 37 | # Inherit dyns 38 | (let [current-env (fiber/getenv (fiber/current))] 39 | (loop [[k v] :pairs current-env :when (keyword? k)] 40 | (put env k v))) 41 | 42 | # State for compilation machine 43 | (def p (parser/new)) 44 | (def forms @[]) 45 | 46 | (defn compile-time-chunk 47 | "Eval the capture straight away during compilation. Use for imports, etc." 48 | [chunk] 49 | (defn do-in-env [] (eval-string chunk)) 50 | (def f (fiber/new do-in-env)) 51 | (fiber/setenv f env) 52 | (resume f) 53 | true) 54 | 55 | (defn parse-chunk 56 | "Parse a string and push produced values to forms." 57 | [chunk] 58 | (parser/consume p chunk) 59 | (while (parser/has-more p) 60 | (array/push forms (parser/produce p)))) 61 | 62 | (defn code-chunk 63 | "Parse all the forms in str and insert them into the template." 64 | [str] 65 | (parse-chunk str) 66 | (if (= :error (parser/status p)) 67 | (error (parser/error p))) 68 | true) 69 | 70 | (defn sub-chunk 71 | "Same as code-chunk, but results in sending code to the buffer." 72 | [str] 73 | (code-chunk 74 | (string "\n(prin (escape (do " str "\n))) "))) 75 | 76 | (defn raw-chunk 77 | "Same as code-chunk, but results in sending code to the buffer." 78 | [str] 79 | (code-chunk 80 | (string "\n(prin (do " str "\n)) "))) 81 | 82 | (defn string-chunk 83 | "Insert string chunk into parser" 84 | [str] 85 | (parse-chunk "\n") 86 | (parser/insert p ~(,prin ,str)) 87 | true) 88 | 89 | # Run peg 90 | (def grammar 91 | ~{:code-chunk (* "{%" (drop (cmt '(any (if-not "%}" 1)) ,code-chunk)) "%}") 92 | :compile-time-chunk (* "{$" (drop (cmt '(any (if-not "$}" 1)) ,compile-time-chunk)) "$}") 93 | :sub-chunk (* "{{" (drop (cmt '(any (if-not "}}" 1)) ,sub-chunk)) "}}") 94 | :raw-chunk (* "{-" (drop (cmt '(any (if-not "-}" 1)) ,raw-chunk)) "-}") 95 | :main-chunk (drop (cmt '(any (if-not (+ "{$" "{{" "{%" "{-") 1)) ,string-chunk)) 96 | :main (any (+ :compile-time-chunk :raw-chunk :code-chunk :sub-chunk :main-chunk (error "")))}) 97 | (def did-match (peg/match grammar source)) 98 | 99 | # Check errors in template and parser 100 | (unless did-match (error "invalid template syntax")) 101 | (parse-chunk "\n") 102 | (parser/eof p) 103 | (case (parser/status p) 104 | :error (error (parser/error p))) 105 | 106 | # Make ast from forms 107 | (def ast ~(fn temple-template [args] 108 | ,;forms 109 | nil)) 110 | 111 | (def ctor (compile ast env (string where))) 112 | (if-not (function? ctor) 113 | (error (string "could not compile template: " (string/format "%p" ctor)))) 114 | 115 | (let [f (fiber/new ctor :e)] 116 | (fiber/setenv f env) 117 | (def res (resume f)) 118 | (case res 119 | :error (error res) 120 | res))) 121 | 122 | # 123 | # Module loading 124 | # 125 | 126 | (defn- loader 127 | [path &] 128 | (with-dyns [:current-file path] 129 | (let [tmpl (create (slurp path) path)] 130 | @{'render 131 | @{:doc "Main template function." 132 | :value (fn render [&keys args] (tmpl args))} 133 | 'render-dict 134 | @{:doc "Template function, but pass arguments as a dictionary." 135 | :value tmpl} 136 | 'capture 137 | @{:doc "Template function that returns buffer of rendered template." 138 | :value (fn capture [&keys args] 139 | (def b @"") 140 | (with-dyns [:out b] (tmpl args)) 141 | b)} 142 | 'capture-dict 143 | @{:doc "Template function that returns buffer of rendered template, 144 | but pass arguments as a dictionary." 145 | :value (fn capture-dict [args] 146 | (def b @"") 147 | (with-dyns [:out b] (tmpl args)) 148 | b)}}))) 149 | 150 | (defn add-loader 151 | "Adds the custom template loader to Janet's module/loaders and 152 | update module/paths." 153 | [] 154 | (put module/loaders :temple loader) 155 | (module/add-paths ".temple" :temple)) 156 | 157 | # 158 | # String templating 159 | # 160 | 161 | (defn compile 162 | ` 163 | Compile a Temple template into a function which will return a 164 | rendered buffer. 165 | 166 | The resulting function should receive the template arguments in the 167 | &keys format. 168 | ` 169 | [str] 170 | (let [tmpl (create str (dyn :current-file))] 171 | (fn render 172 | [&keys args] 173 | (let [out @""] 174 | (with-dyns [:out out] (tmpl args)) 175 | out)))) 176 | -------------------------------------------------------------------------------- /test/suite-data.janet: -------------------------------------------------------------------------------- 1 | (use ../spork/test) 2 | (import ../spork/data :as d) 3 | 4 | (start-suite) 5 | 6 | (assert-docs "/spork/data") 7 | 8 | (defn diff-assert [a b should-be msg] 9 | (assert (deep= (d/diff a b) should-be) msg)) 10 | 11 | (def cases 12 | [[1 1 @[nil nil 1] "Should be: Integers, same"] 13 | [1 2 @[1 2 nil] "Should be: Integers, different"] 14 | 15 | ["1" "1" @[nil nil "1"] "Should be: Strings, same"] 16 | ["1" "2" @["1" "2" nil] "Should be: Strings, different"] 17 | 18 | ["String" 1 @["String" 1 nil] "Should be: String and Integer, different"] 19 | 20 | [[1 2 3] [1 2 3] @[nil nil @[1 2 3]] "Should be: Tuples, same"] 21 | [[1 2 3] [1 2 3 4] @[nil @[nil nil nil 4] @[1 2 3]] "Should be: Tuples, element added"] 22 | [[1 2 3] [1 2] @[@[nil nil 3] nil @[1 2]] "Should be: Tuples, element removed"] 23 | [[1 2 3] [1 5 3] @[@[nil 2] @[nil 5] @[1 nil 3]] "Should be: Tuples, element changed"] 24 | [[1 2 3] [1 5] @[@[nil 2 3] @[nil 5] @[1]] "Should be: Tuples, element changed and element removed"] 25 | 26 | [@[1 2 3] @[1 2 3] @[nil nil @[1 2 3]] "Should be: Arrays, same"] 27 | [@[1 2 3] @[1 2 3 4] @[nil @[nil nil nil 4] @[1 2 3]] "Should be: Arrays, element added"] 28 | [@[1 2 3] @[1 2] @[@[nil nil 3] nil @[1 2]] "Should be: Arrays, element removed"] 29 | [@[1 2 3] @[1 5 3] @[@[nil 2] @[nil 5] @[1 nil 3]] "Should be: Arrays, element changed"] 30 | [@[1 2 3] @[1 5] @[@[nil 2 3] @[nil 5] @[1]] "Should be: Arrays, element changed and element removed"] 31 | 32 | [{:a 1 :b 2} {:a 1 :b 2} @[nil nil @{:a 1 :b 2}] "Should be: Structs, same"] 33 | [{:a 1 :b 2} {:a 1 :b 2 :c 3} @[nil @{:c 3} @{:a 1 :b 2}] "Should be: Structs, element added"] 34 | [{:a 1 :b 2} {:a 1} @[@{:b 2} nil @{:a 1}] "Should be: Structs, element removed"] 35 | [{:a 1 :b 2} {:a 1 :b 5} @[@{:b 2} @{:b 5} @{:a 1}] "Should be: Structs, element changed"] 36 | [{:a 1 :b 2} {:b 5} @[@{:a 1 :b 2} @{:b 5} nil] "Should be: Structs, element changed and element removed"] 37 | 38 | [@{:a 1 :b 2} @{:a 1 :b 2} @[nil nil @{:a 1 :b 2}] "Should be: Tables, same"] 39 | [@{:a 1 :b 2} @{:a 1 :b 2 :c 3} @[nil @{:c 3} @{:a 1 :b 2}] "Should be: Tables, element added"] 40 | [@{:a 1 :b 2} @{:a 1} @[@{:b 2} nil @{:a 1}] "Should be: Tables, element removed"] 41 | [@{:a 1 :b 2} @{:a 1 :b 5} @[@{:b 2} @{:b 5} @{:a 1}] "Should be: Tables, element changed"] 42 | [@{:a 1 :b 2} @{:b 5} @[@{:a 1 :b 2} @{:b 5} nil] "Should be: Tables, element changed and element removed"] 43 | 44 | [@{:a 1 :b {:c 1 :d 2}} @{:a 1 :b {:c 1 :d 2}} @[nil nil @{:a 1 :b @{:c 1 :d 2}}] "Should be: Nested Tables, same"] 45 | [@{:a 1 :b {:c 1 :d 2}} @{:a 1 :b {:c 1 :d 2 :e {:f 1 :g 2}} :h 3} @[nil @{:b @{:e {:f 1 :g 2}} :h 3} @{:a 1 :b @{:c 1 :d 2}}] "Should be: Nested Tables, element added"] 46 | [@{:a 1 :b {:c 1 :d 2}} @{:a 1 :b {:c 1}} @[@{:b @{:d 2}} nil @{:a 1 :b @{:c 1}}] "Should be: Nested Tables, element removed"] 47 | [@{:a 1 :b {:c 1 :d 2}} @{:a 1 :b {:c 1 :d 5}} @[@{:b @{:d 2}} @{:b @{:d 5}} @{:a 1 :b @{:c 1}}] "Should be: Nested Tables, element changed"] 48 | [@{:a 1 :b {:c 1 :d 2}} @{:b {:c 1 :d 5}} @[@{:a 1 :b @{:d 2}} @{:b @{:d 5}} @{:b @{:c 1}}] "Should be: Nested Tables, element changed and element removed"] 49 | 50 | [{:a 1 :b 2} @{:a 1 :b 2} @[nil nil @{:a 1 :b 2}] "Should be: Struct and Table, same"] 51 | [{:a 1 :b 2} @{:a 1 :b 2 :c 4 :d 5} @[nil @{:c 4 :d 5} @{:a 1 :b 2}] "Should be: Struct and Table, different"] 52 | 53 | [@[1 2 3] [1 2 3] @[nil nil @[1 2 3]] "Should be: Array and Tuple, same"] 54 | [@[1 2 3] [1 2 3 4 5] @[nil @[nil nil nil 4 5] @[1 2 3]] "Should be: Array and Tuple, different"] 55 | 56 | [@{:a [1 2 {:b {:c 3}}] 5 @[:d :e 4] 6 @{7 {:f "test" :g {8 [9 10 11] :h 12}}}} 57 | @{:a [1 2 {:b {:c 3}}] 5 @[:d :e 4] 6 @{7 {:f "test" :g {8 [9 10 11] :h 12}}}} 58 | @[nil nil @{6 @{7 @{:f "test" :g @{8 @[9 10 11] :h 12}}} :a @[1 2 @{:b @{:c 3}}] 5 @[:d :e 4]}] 59 | "Should be: Nested Complex Data Structures, same"] 60 | 61 | [@{:a [1 2 {:b {:c 3}}] 5 @[:d :e 4] 6 @{7 {:f "test" :g {8 [9 10 11] :h 12}}}} 62 | @{:a [1 2 {:b {:c 3}}] 5 @[:d :e 4] 6 @{7 {:f "test" :g {8 [9 10 {:z 100} 11] :h 12}}}} 63 | @[@{6 @{7 @{:g @{8 @[nil nil 11]}}}} @{6 @{7 @{:g @{8 @[nil nil {:z 100} 11]}}}} @{5 @[:d :e 4] 6 @{7 @{:f "test" :g @{8 @[9 10] :h 12}}} :a @[1 2 @{:b @{:c 3}}]}] 64 | "Should be: Nested Complex Data Structures, deep insertion"] 65 | 66 | [@{:a [1 2 {:b {:c 3}}] 5 @[:d :e 4] 6 @{7 {:f "test" :g {8 [9 10 11] :h 12}}}} 67 | @{:a [1 2 {:b {:c 3}}] 5 @[:d :e 4] 6 @{7 {:f "test" :g {8 [9 10 11]}}}} 68 | @[@{6 @{7 @{:g @{:h 12}}}} nil @{6 @{7 @{:g @{8 @[9 10 11]} :f "test"}} 5 @[:d :e 4] :a @[1 2 @{:b @{:c 3}}]}] 69 | "Should be: Nested Complex Data Structures, deep delete"] 70 | 71 | [@{:a [1 2 {:b {:c 3}}] 5 @[:d :e 4] 6 @{7 {:f "test" :g {8 [9 10 11] :h 12}}}} 72 | @{:a [1 2 {:b {:c 3}}] 5 @[:d :e 4] 6 @{7 {:f "test" :g {8 [:z 10 11] :h 12}}}} 73 | @[@{6 @{7 @{:g @{8 @[9]}}}} @{6 @{7 @{:g @{8 @[:z]}}}} @{6 @{7 @{:f "test" :g @{8 @[nil 10 11] :h 12}}} 5 @[:d :e 4] :a @[1 2 @{:b @{:c 3}}]}] 74 | "Should be: Nested Complex Data Structures, deep update"] 75 | 76 | [@{:a [1 2 {:b {:c 3}}] 5 @[:d :e 4] 6 @{7 {:f "test" :g {8 [9 10 11] :h 12}}}} 77 | @{:a [1 2 {:b {:c 3}}] 5 @[:d :e 4] 6 @{7 {:f "test" :g {8 {:z 100 :x 10000 :y 100000} :h 12}}}} 78 | @[@{6 @{7 @{:g @{8 [9 10 11]}}}} @{6 @{7 @{:g @{8 {:x 10000 :y 100000 :z 100}}}}} @{:a @[1 2 @{:b @{:c 3}}] 5 @[:d :e 4] 6 @{7 @{:f "test" :g @{:h 12}}}}] 79 | "Should be: Nested Complex Data Structures, deep update of a whole structure"] 80 | 81 | [@{:a [1 2 {:b {:c 3}}] 5 @[:d :e 4] 6 @{7 {:f "test" :g {8 [9 10 11] :h 12}}}} 82 | @{:zz [1 10000 {:b {:c 3}}] 5 @[:d :e 1000] 6 @{7 {:f "test" :g {8 [9 10 11 {:z 10}] :h 12}}}} 83 | @[@{5 @[nil nil 4] :a [1 2 {:b {:c 3}}]} @{5 @[nil nil 1000] 6 @{7 @{:g @{8 @[nil nil nil {:z 10}]}}} :zz [1 10000 {:b {:c 3}}]} @{5 @[:d :e] 6 @{7 @{:f "test" :g @{8 @[9 10 11] :h 12}}}}] 84 | "Should be: Nested Complex Data Structures, multiple deep updates"]]) 85 | 86 | (map |(diff-assert ;$) cases) 87 | 88 | (end-suite) 89 | -------------------------------------------------------------------------------- /src/base64.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2024 Janet contributors 3 | * 4 | * Permission is hereby granted, free of charge, to any person obtaining a copy 5 | * of this software and associated documentation files (the "Software"), to 6 | * deal in the Software without restriction, including without limitation the 7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or 8 | * sell copies of the Software, and to permit persons to whom the Software is 9 | * furnished to do so, subject to the following conditions: 10 | * 11 | * The above copyright notice and this permission notice shall be included in 12 | * all copies or substantial portions of the Software. 13 | * 14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 20 | * IN THE SOFTWARE. 21 | */ 22 | 23 | #include 24 | 25 | const char *const table = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; 26 | 27 | static inline uint8_t encode_sextet_1(uint8_t byte1) { 28 | return table[byte1 >> 2]; 29 | } 30 | 31 | static inline uint8_t encode_sextet_2(uint8_t byte1, uint8_t byte2) { 32 | return table[((byte1 & 3) << 4) | (byte2 >> 4)]; 33 | } 34 | 35 | static inline uint8_t encode_sextet_3(uint8_t byte2, uint8_t byte3) { 36 | return table[((byte2 & 15) << 2) | (byte3 >> 6)]; 37 | } 38 | 39 | static inline uint8_t encode_sextet_4(uint8_t byte3) { 40 | return table[byte3 & 63]; 41 | } 42 | 43 | static Janet base64_encode(int32_t argc, Janet *argv) { 44 | janet_fixarity(argc, 1); 45 | const uint8_t *in = janet_getstring(argv, 0); 46 | int32_t inlen = janet_length(argv[0]); 47 | int rem = inlen % 3; 48 | JanetBuffer *outbuf = janet_buffer(((inlen + 3 - rem) / 3) * 4); 49 | int cursor = 0; 50 | for (; cursor < (inlen - rem); cursor += 3) { 51 | janet_buffer_push_u8(outbuf, encode_sextet_1(in[cursor])); 52 | janet_buffer_push_u8(outbuf, encode_sextet_2(in[cursor], in[cursor + 1])); 53 | janet_buffer_push_u8(outbuf, encode_sextet_3(in[cursor + 1], in[cursor + 2])); 54 | janet_buffer_push_u8(outbuf, encode_sextet_4(in[cursor + 2])); 55 | } 56 | if (rem == 1) { 57 | janet_buffer_push_u8(outbuf, encode_sextet_1(in[cursor])); 58 | janet_buffer_push_u8(outbuf, encode_sextet_2(in[cursor], in[cursor + 1])); 59 | janet_buffer_push_u8(outbuf, '='); 60 | janet_buffer_push_u8(outbuf, '='); 61 | } else if (rem == 2) { 62 | janet_buffer_push_u8(outbuf, encode_sextet_1(in[cursor])); 63 | janet_buffer_push_u8(outbuf, encode_sextet_2(in[cursor], in[cursor + 1])); 64 | janet_buffer_push_u8(outbuf, encode_sextet_3(in[cursor + 1], in[cursor + 2])); 65 | janet_buffer_push_u8(outbuf, '='); 66 | } 67 | return janet_stringv(outbuf->data, outbuf->count); 68 | } 69 | 70 | static uint8_t decode_character(uint8_t c) { 71 | if (c >= 'a') { 72 | return c - 97 + 26; 73 | } else if (c >= 'A') { 74 | return c - 65; 75 | } else if (c >= '0' && c <= '9') { 76 | return c - 48 + 52; 77 | } else if (c == '+') { 78 | return 62; 79 | } else if (c == '/') { 80 | return 63; 81 | } else { 82 | janet_panicf("Wrong character: %c", c); 83 | } 84 | } 85 | 86 | static inline uint8_t decode_byte_1(uint8_t sextet1, uint8_t sextet2) { 87 | return (sextet1 << 2) | (sextet2 >> 4); 88 | } 89 | 90 | static inline uint8_t decode_byte_2(uint8_t sextet2, uint8_t sextet3) { 91 | return (sextet2 << 4) | (sextet3 >> 2); 92 | } 93 | 94 | static inline uint8_t decode_byte_3(uint8_t sextet3, uint8_t sextet4) { 95 | return (sextet3 << 6) | sextet4; 96 | } 97 | 98 | static Janet base64_decode(int32_t argc, Janet *argv) { 99 | janet_fixarity(argc, 1); 100 | int32_t inlen = janet_length(argv[0]); 101 | if (inlen % 4 != 0) { 102 | janet_panicf("Wrong length: %d", inlen); 103 | } 104 | const uint8_t *in = janet_getstring(argv, 0); 105 | int padding = 0; 106 | int end = inlen; 107 | if (in[inlen - 2] == '=') { 108 | end -= 4; 109 | padding = 2; 110 | } else if (in[inlen - 1] == '=') { 111 | end -= 4; 112 | padding = 1; 113 | } 114 | JanetBuffer *outbuf = janet_buffer((inlen / 4) * 3); 115 | int cursor = 0; 116 | uint8_t sextet1, sextet2, sextet3, sextet4; 117 | for (; cursor < end; cursor += 4) { 118 | sextet1 = decode_character(in[cursor]); 119 | sextet2 = decode_character(in[cursor + 1]); 120 | sextet3 = decode_character(in[cursor + 2]); 121 | sextet4 = decode_character(in[cursor + 3]); 122 | janet_buffer_push_u8(outbuf, decode_byte_1(sextet1, sextet2)); 123 | janet_buffer_push_u8(outbuf, decode_byte_2(sextet2, sextet3)); 124 | janet_buffer_push_u8(outbuf, decode_byte_3(sextet3, sextet4)); 125 | } 126 | if (padding == 2) { 127 | sextet1 = decode_character(in[cursor]); 128 | sextet2 = decode_character(in[cursor + 1]); 129 | janet_buffer_push_u8(outbuf, decode_byte_1(sextet1, sextet2)); 130 | } else if (padding == 1) { 131 | sextet1 = decode_character(in[cursor]); 132 | sextet2 = decode_character(in[cursor + 1]); 133 | sextet3 = decode_character(in[cursor + 2]); 134 | janet_buffer_push_u8(outbuf, decode_byte_1(sextet1, sextet2)); 135 | janet_buffer_push_u8(outbuf, decode_byte_2(sextet2, sextet3)); 136 | } 137 | return janet_stringv(outbuf->data, outbuf->count); 138 | } 139 | 140 | static const JanetReg cfuns[] = { 141 | { 142 | "encode", 143 | base64_encode, 144 | "(base64/encode x)\n\nEncodes a string in Base64. Returns encoded string." 145 | }, 146 | { 147 | "decode", 148 | base64_decode, 149 | "(base64/decode x)\n\nDecodes a string from Base64. Returns decoded string." 150 | }, 151 | {NULL, NULL, NULL} 152 | }; 153 | 154 | JANET_MODULE_ENTRY(JanetTable *env) { 155 | janet_cfuns(env, "base64", cfuns); 156 | } 157 | -------------------------------------------------------------------------------- /src/utf8.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2022 Calvin Rose and contributors 3 | * 4 | * Permission is hereby granted, free of charge, to any person obtaining a copy 5 | * of this software and associated documentation files (the "Software"), to 6 | * deal in the Software without restriction, including without limitation the 7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or 8 | * sell copies of the Software, and to permit persons to whom the Software is 9 | * furnished to do so, subject to the following conditions: 10 | * 11 | * The above copyright notice and this permission notice shall be included in 12 | * all copies or substantial portions of the Software. 13 | * 14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 20 | * IN THE SOFTWARE. 21 | */ 22 | 23 | #include 24 | 25 | /* TODO: It might be wise to disallow overlong sequences for security reasons. 26 | * See https://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt for a list 27 | * of test cases. */ 28 | 29 | JANET_FN(cfun_utf8_decode_rune, 30 | "(utf8/decode-rune buf &opt start)", 31 | "Read a UTF-8 encoded Unicode codepoint from the buffer which starts at the given index. Returns a tuple [value width], where width = number of bytes consumed. If at the end of buffer or the buffer contains malformed UTF-8, returns [nil 0].") { 32 | janet_arity(argc, 1, 2); 33 | JanetByteView buf = janet_getbytes(argv, 0); 34 | int32_t start; 35 | if (argc > 1) { 36 | start = janet_getinteger(argv, 1); 37 | } else { 38 | start = 0; 39 | } 40 | 41 | Janet res[2] = { janet_wrap_nil(), janet_wrap_integer(0) }; 42 | if (start >= buf.len) { 43 | goto exit; 44 | } 45 | 46 | int32_t i = start; 47 | uint8_t a = buf.bytes[i++]; 48 | if ((a & 0x80) == 0) { 49 | res[0] = janet_wrap_integer((int32_t)a); 50 | } else if ((a & 0xE0) == 0xC0) { 51 | if (i >= buf.len) goto exit; 52 | uint8_t b = buf.bytes[i++]; 53 | if ((b & 0xC0) != 0x80) goto exit; 54 | res[0] = janet_wrap_integer((int32_t)(a & 0x1F) << 6 | 55 | (int32_t)(b & 0x3F)); 56 | } else if ((a & 0xF0) == 0xE0) { 57 | if ((i + 1) >= buf.len) goto exit; 58 | uint8_t b = buf.bytes[i++], 59 | c = buf.bytes[i++]; 60 | if ((b & 0xC0) != 0x80) goto exit; 61 | if ((c & 0xC0) != 0x80) goto exit; 62 | res[0] = janet_wrap_integer((int32_t)(a & 0x0F) << 12 | 63 | (int32_t)(b & 0x3F) << 6 | 64 | (int32_t)(c & 0x3F)); 65 | } else if ((a & 0xF8) == 0xF0) { 66 | if ((i + 2) >= buf.len) goto exit; 67 | uint8_t b = buf.bytes[i++], 68 | c = buf.bytes[i++], 69 | d = buf.bytes[i++]; 70 | if ((b & 0xC0) != 0x80) goto exit; 71 | if ((c & 0xC0) != 0x80) goto exit; 72 | if ((d & 0xC0) != 0x80) goto exit; 73 | res[0] = janet_wrap_integer((int32_t)(a & 0x07) << 18 | 74 | (int32_t)(b & 0x3F) << 12 | 75 | (int32_t)(c & 0x3F) << 6 | 76 | (int32_t)(d & 0x3F)); 77 | } else { 78 | goto exit; 79 | } 80 | 81 | res[1] = janet_wrap_integer(i - start); 82 | exit: 83 | return janet_wrap_tuple(janet_tuple_n(&res[0], 2)); 84 | } 85 | 86 | JANET_FN(cfun_utf8_encode_rune, 87 | "(utf8/encode-rune rune &opt buf)", 88 | "Encode a Unicode codepoint into the end of a buffer.") { 89 | janet_arity(argc, 1, 2); 90 | uint32_t rune = (uint32_t)janet_getinteger(argv, 0); 91 | 92 | uint8_t enc[4]; 93 | uint32_t len = 0; 94 | 95 | if (rune <= 0x7F) { 96 | enc[len++] = (uint8_t)rune; 97 | } else if (rune <= 0x7FF) { 98 | enc[len++] = (uint8_t)(0xC0 | ((rune >> 6) & 0x1F)); 99 | enc[len++] = (uint8_t)(0x80 | (rune & 0x3F)); 100 | } else if (rune <= 0xFFFF) { 101 | enc[len++] = (uint8_t)(0xE0 | ((rune >> 12) & 0x0F)); 102 | enc[len++] = (uint8_t)(0x80 | ((rune >> 6) & 0x3F)); 103 | enc[len++] = (uint8_t)(0x80 | (rune & 0x3F)); 104 | } else if (rune <= 0x10FFFF) { 105 | enc[len++] = (uint8_t)(0xF0 | ((rune >> 18) & 0x07)); 106 | enc[len++] = (uint8_t)(0x80 | ((rune >> 12) & 0x3F)); 107 | enc[len++] = (uint8_t)(0x80 | ((rune >> 6) & 0x3F)); 108 | enc[len++] = (uint8_t)(0x80 | (rune & 0x3F)); 109 | } else { 110 | janet_panicf("character %d outsize UTF-8 range", (int)rune); 111 | } 112 | 113 | JanetBuffer *out; 114 | if (argc > 1) { 115 | out = janet_getbuffer(argv, 1); 116 | } else { 117 | out = janet_buffer((int32_t)len); 118 | } 119 | janet_buffer_push_bytes(out, &enc[0], (int32_t)len); 120 | return janet_wrap_buffer(out); 121 | } 122 | 123 | JANET_FN(cfun_utf8_prefixtowidth, 124 | "(utf8/prefix->width c)", 125 | "Given the first byte in an UTF-8 sequence, get the number of bytes that the codepoint sequence takes up, including the prefix byte.") { 126 | janet_fixarity(argc, 1); 127 | uint32_t c = (uint32_t)janet_getinteger(argv, 0); 128 | int32_t n = ((c & 0xF8) == 0xF0) ? 4 : 129 | ((c & 0xF0) == 0xE0) ? 3 : 130 | ((c & 0xE0) == 0xC0) ? 2 : 131 | 1; 132 | return janet_wrap_integer(n); 133 | } 134 | 135 | JANET_MODULE_ENTRY(JanetTable *env) { 136 | JanetRegExt cfuns[] = { 137 | JANET_REG("decode-rune", cfun_utf8_decode_rune), 138 | JANET_REG("encode-rune", cfun_utf8_encode_rune), 139 | JANET_REG("prefix->width", cfun_utf8_prefixtowidth), 140 | JANET_REG_END 141 | }; 142 | janet_cfuns_ext(env, "utf8", cfuns); 143 | } 144 | -------------------------------------------------------------------------------- /tools/wchar_procunicode.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### wchar_procunicode: Generate a character width table from Unicode data. 3 | ### 4 | # Usage: 5 | # 1. Obtain a version of the Unicode Character Database, e.g., 6 | # from https://www.unicode.org/Public/UCD/latest/. 7 | # 2. Invoke this script with paths to UnicodeData.txt and EastAsianWidth.txt. 8 | # 3. Paste the resulting output into src/getline.c as k_width_classes[]. 9 | # 10 | # With thanks to Justine Tunney (https://github.com/jart; https://justine.lol) 11 | # for assistance and her great work on Cosmopolitan Libc/Bestline. 12 | 13 | (defn strip-comment [line] 14 | (def line (string/trimr line)) 15 | (if-let [comment-start (string/find "#" line)] 16 | (string/trimr (slice line 0 comment-start)) 17 | line)) 18 | 19 | (defn parse-line-unicode-data [line] 20 | (def parts (string/split ";" (strip-comment line))) 21 | (when (not= 15 (length parts)) 22 | (errorf "input does not seem like Unicode data: %s" line)) 23 | (def codepoint (first parts)) 24 | (def class (parts 2)) 25 | (when (string/find ".." codepoint) 26 | (errorf "input is not Unicode data: codepoint %s is actually a range" codepoint)) 27 | [(scan-number codepoint 16) class]) 28 | 29 | (defn parse-line-width-data [line] 30 | (def parts (string/split ";" (strip-comment line))) 31 | (when (not= 2 (length parts)) 32 | (break nil)) 33 | (def [cprange class] parts) 34 | (def cprange 35 | (if-let [range (string/find ".." cprange)] 36 | (let [[a b] [(slice cprange 0 range) (slice cprange (+ 2 range))]] 37 | [(scan-number a 16) (scan-number b 16)]) 38 | [(scan-number cprange 16) (scan-number cprange 16)])) 39 | [cprange class]) 40 | 41 | (defn width-for-char [c [general-category east-asian-width]] 42 | (cond 43 | (= c 0) 0 44 | (= "Cc" general-category) -1 45 | (or (= "W" east-asian-width) 46 | (= "F" east-asian-width)) 2 47 | (= c 0x00AD) 1 48 | (or (= "Me" general-category) 49 | (= "Mn" general-category) 50 | (= "Cf" general-category) 51 | (<= 0x1160 c 0x11FF)) 0 52 | 1)) 53 | 54 | (defn bitset/new [] @"\x80\0\0\0\0\0\0\0") 55 | (defn bitset/pos [pos] 56 | (def pos (inc pos)) # top bit is masked 57 | (when (>= pos 64) (errorf "pos %d out of range" pos)) 58 | [(brshift pos 3) (- 7 (band pos 7))]) 59 | (defn bitset/test [mask pos] 60 | (def [byte bit] (bitset/pos pos)) 61 | (def byte-val (mask byte)) 62 | (def bit-val (band byte-val (blshift 1 bit))) 63 | (not= bit-val 0)) 64 | (defn bitset/set [mask pos] 65 | (def [byte bit] (bitset/pos pos)) 66 | (put mask byte 67 | (bor (mask byte) (blshift 1 bit)))) 68 | (defn bitset/clear [mask pos] 69 | (def [byte bit] (bitset/pos pos)) 70 | (put mask byte 71 | (band (mask byte) (bxor 0xFF (blshift 1 bit))))) 72 | (defn buffer->array [buf] 73 | (def a (array/new (length buf))) 74 | (each x buf 75 | (array/push a x)) 76 | a) 77 | 78 | (defn coalesce! [triples] 79 | (comment 80 | ``` 81 | struct width_table_entry { 82 | uint32_t start_point; // always a codepoint, used as a sorting key 83 | uint32_t width; 84 | // if top bit is set, bits 63..0 indicate for which codepoints after 85 | // start_point this applies to 86 | // otherwise the value is the literal end point 87 | uint64_t end_point_or_bitmask; 88 | }; 89 | ```) 90 | (var -start nil) 91 | (var -end nil) 92 | (var -mask nil) 93 | (var -width nil) 94 | (var -coalesced nil) 95 | (def entries @[]) 96 | (var i 0) 97 | 98 | (defn begin [start end width] 99 | (set -start start) 100 | (set -end end) 101 | (set -width width) 102 | (set -coalesced 1) 103 | (when (< (- end start) 63) 104 | (set -mask (bitset/new)) 105 | (for i start (inc end) 106 | (bitset/set -mask (- i start))))) 107 | (defn flush [start end width] 108 | (if (> -coalesced 1) 109 | (array/push entries {:start -start :mask -mask :width -width}) 110 | (array/push entries {:start -start :end -end :width -width})) 111 | (begin start end width)) 112 | (defn try-coalesce [start end] 113 | (if (< (- end -start) 63) 114 | (do 115 | (for i start (inc end) 116 | (bitset/set -mask (- i -start))) 117 | (++ -coalesced) 118 | true) 119 | false)) 120 | 121 | (each [start end width] triples 122 | (if -width 123 | (if (not= width -width) 124 | (flush start end width) 125 | (if (try-coalesce start end) 126 | (do) # noop 127 | (flush start end width))) 128 | (begin start end width))) 129 | 130 | (each {:start start :end end :mask mask :width width} entries 131 | (if mask 132 | (printf "{ %6d, %2d, 0x%02x%02x%02x%02x%02x%02x%02x%02xULL }," 133 | start width ;(buffer->array mask)) 134 | (printf "{ %6d, %2d, %18d }," start width end)))) 135 | 136 | (defn main [_ path-unicode-data path-width-data] 137 | (def chars (array/new 0x10FFFF)) 138 | (with [f (file/open path-unicode-data :r)] 139 | (forever 140 | (def line (:read f :line)) 141 | (when (nil? line) (break)) 142 | (def line (parse-line-unicode-data line)) 143 | (when line 144 | (def [ch cl] line) 145 | (while (< (length chars) ch) 146 | (array/push chars [nil nil])) 147 | (array/push chars [cl nil])))) 148 | (with [f (file/open path-width-data :r)] 149 | (forever 150 | (def line (:read f :line)) 151 | (when (nil? line) (break)) 152 | (def line (parse-line-width-data line)) 153 | (when line 154 | (def [[a b] cl-b] line) 155 | (for i a (inc b) 156 | (def [cl-a _] (in chars i [nil nil])) 157 | (put chars i [cl-a cl-b]))))) 158 | 159 | (def triples @[]) 160 | (var run-width 1) 161 | (var run-start nil) 162 | (for c 0 (length chars) 163 | (def width (width-for-char c (in chars c))) 164 | (when (not= width run-width) 165 | (when (not= run-width 1) 166 | (array/push triples [run-start (dec c) run-width])) 167 | (set run-width width) 168 | (set run-start c))) 169 | (when (not= run-width 1) 170 | (array/push triples [run-start (dec (length chars)) run-width])) 171 | 172 | (print "/* AUTO-GENERATED BY tools/wchar_procunicode.janet */") 173 | (coalesce! triples) 174 | 175 | nil) 176 | -------------------------------------------------------------------------------- /spork/ev-utils.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### ev-utils.janet 3 | ### 4 | ### Module for parallel execution utilities with Janet. 5 | ### 6 | 7 | (defmacro wait-cancel 8 | "Wait forever until the current fiber is canceled, and then run some cleanup code." 9 | [& body] 10 | ~(as-macro ,defer (do ,;body) (while true (,ev/sleep 1024)))) 11 | 12 | (defn nursery 13 | "Group a number of fibers into a single object for structured concurrency" 14 | [] 15 | @{:supervisor (ev/chan) :fibers @{}}) 16 | 17 | (defn go-nursery 18 | "Spawn a fiber into a nursery, similar to ev/go." 19 | [nurse f &opt value] 20 | (def super (get nurse :supervisor)) 21 | (def fibs (get nurse :fibers)) 22 | (def fib (ev/go f value super)) 23 | (set (fibs fib) fib)) 24 | 25 | (defmacro spawn-nursery 26 | "Similar to ev/spawn but associate spawned fibers with a nursery" 27 | [nurse & body] 28 | ~(,go-nursery ,nurse (fn _spawn [&] ,;body))) 29 | 30 | (defn- drain-fibers 31 | "Canceling a group of fibers and wait for them all to complete." 32 | [super fibers reason] 33 | (each f fibers (ev/cancel f reason)) 34 | (def n (length fibers)) 35 | (table/clear fibers) 36 | (repeat n (ev/take super))) 37 | 38 | (defn join-nursery 39 | "Suspend the current fiber until the nursery is emptied." 40 | [nurse] 41 | (def fibs (get nurse :fibers)) 42 | (def super (get nurse :supervisor)) 43 | (defer (drain-fibers super fibs "parent canceled") 44 | (while (next fibs) 45 | (def [sig fiber] (ev/take super)) 46 | (if (= sig :ok) 47 | (put fibs fiber nil) 48 | (do 49 | (drain-fibers super fibs "sibling canceled") 50 | (propagate (fiber/last-value fiber) fiber)))))) 51 | 52 | (defn- join 53 | "Special case of supervise for implementing some parallel functions." 54 | [supervisor fibers] 55 | (var err-fiber nil) 56 | (defer (drain-fibers supervisor fibers "parent canceled") 57 | (while (next fibers) 58 | (def [sig fiber] (ev/take supervisor)) 59 | (if (= sig :ok) 60 | (put fibers fiber nil) 61 | (do 62 | (drain-fibers supervisor fibers "sibling canceled") 63 | (propagate (fiber/last-value fiber) fiber)))))) 64 | 65 | (defn pcall 66 | "Call a function n times (in parallel) for side effects. 67 | Each function is called with an integer argument indicating a fiber index. Returns nil." 68 | [f n] 69 | (assert (> n 0)) 70 | (def chan (ev/chan)) 71 | (def new-f (if (function? f) f (fn [x] (f x)))) 72 | (join chan 73 | (tabseq [i :range [0 n] 74 | :let [fib (ev/go (fiber/new new-f :tp) i chan)]] 75 | fib fib))) 76 | 77 | (defn pmap-full 78 | "Function form of `ev/gather`. If any of the 79 | sibling fibers error, all other siblings will be canceled. Returns the gathered 80 | results in an array. `data` can be any indexed data structure." 81 | [f data] 82 | (def chan (ev/chan)) 83 | (def res (if (dictionary? data) @{} @[])) 84 | (join chan 85 | (tabseq [[i x] :pairs data 86 | :let [fib (ev/go (fiber/new (fn [] (put res i (f x))) :tp) nil chan)]] 87 | fib fib)) 88 | res) 89 | 90 | (defn pmap-limited 91 | "Similar to pmap-full, but only runs work n-ways parallel." 92 | [f data n-workers] 93 | (assert (> n-workers 0)) 94 | (def res (if (dictionary? data) @{} @[])) 95 | (var cursor (next data nil)) 96 | (defn worker [&] 97 | (while (not= nil cursor) 98 | (def value (get data cursor)) 99 | (def key cursor) 100 | (set cursor (next data cursor)) 101 | (put res key (f value)))) 102 | (pcall worker n-workers) 103 | res) 104 | 105 | (defn pmap 106 | "Map `f` over data in parallel, optionally limiting parallelism to 107 | `n` workers." 108 | [f data &opt n-workers] 109 | (if (= nil n-workers) 110 | (pmap-full f data) 111 | (pmap-limited f data n-workers))) 112 | 113 | (defn pdag 114 | "Executes a dag by calling f on every node in the graph. 115 | Can set the number of workers 116 | for parallel execution. The graph is represented as a table 117 | mapping nodes to arrays of child nodes. Each node will only be evaluated 118 | after all children have been evaluated. Modifying `dag` inside `f` 119 | will not affect the scheduling of workers. 120 | Returns a table mapping each node 121 | to the result of `(f node)`." 122 | [f dag &opt n-workers] 123 | 124 | # preprocess 125 | (def res @{}) 126 | (def seen @{}) 127 | (def q (ev/chan math/int32-max)) 128 | (def dep-counts @{}) 129 | (def inv @{}) 130 | (defn visit [node] 131 | (if (seen node) (break)) 132 | (put seen node true) 133 | (def depends-on (get dag node [])) 134 | (put dep-counts node (length depends-on)) 135 | (if (empty? depends-on) 136 | (ev/give q node)) 137 | (each r depends-on 138 | (put inv r (array/push (get inv r @[]) node)) 139 | (visit r))) 140 | (eachk r dag (visit r)) 141 | 142 | # run n workers in parallel 143 | (default n-workers (max 1 (length seen))) 144 | (assert (> n-workers 0)) 145 | (defn worker [&] 146 | (while (next seen) 147 | (def node (ev/take q)) 148 | (if-not node (break)) 149 | (when (in seen node) 150 | (put seen node nil) 151 | (put res node (f node))) 152 | (each r (get inv node []) 153 | (when (zero? (set (dep-counts r) (dec (get dep-counts r 1)))) 154 | (ev/give q r)))) 155 | (ev/give q nil)) 156 | 157 | (pcall worker n-workers) 158 | res) 159 | 160 | (defn multithread-service 161 | "Run instances of a function over multiple threads. On failures, restart 162 | the failed thread. Normal function returns will not trigger a restart." 163 | [thread-main n-threads] 164 | (def supervisor (ev/thread-chan 1024)) 165 | (var next-tid 0) 166 | (var to-complete n-threads) 167 | (defn start-thread [] 168 | (def tid (string "thread-" (++ next-tid))) 169 | (ev/thread thread-main tid :nt supervisor)) 170 | (repeat n-threads (start-thread)) 171 | (while (> to-complete 0) 172 | (def [sig payload tid] (ev/take supervisor)) 173 | (if tid 174 | (if (= sig :ok) 175 | (do 176 | (eprint "thread " tid " completed normally") 177 | (-- to-complete)) 178 | (do 179 | (eprint "thread message " sig " in " tid ": " payload) 180 | (start-thread))))) 181 | (ev/chan-close supervisor)) 182 | --------------------------------------------------------------------------------