+ Date : 2022-02-12
+
+ Copyright : Copyright (C) 2022 Felix C. Stegerman
+ Version : v0.0.2
+ License : GPLv3+, LGPLv3+
+
+
+
+
+
+
+[](https://github.com/obfusk/koneko/actions?query=workflow%3ACI)
+[](https://travis-ci.org/obfusk/koneko)
+[](https://www.gnu.org/licenses/gpl-3.0.html)
+[](https://www.gnu.org/licenses/lgpl-3.0.html)
+
+
+
+ 
+ koneko - a concatenative not-quite-lisp for kittens
+
+
+→ [Description](#description),
+→ [Whirlwind Tour](#whirlwind-tour),
+→ [Language Reference](#language-reference),
+→ [More Examples](#more-examples),
+→ [Doctests](#doctests);
+
+→ [Installing](#installing),
+→ [Running](#running),
+→ [(Build) Requirements](#build-requirements),
+→ [Specs & Docs](#specs--docs),
+→ [Vim Syntax Highlighting](#vim-syntax-highlighting);
+
+→ [TODO](#todo),
+→ [License](#license)
+
+## Description
+
+**NB: work in progress.**
+
+Koneko (子猫 -- "kitten" in Japanese) is a simple functional
+concatenative stack-based programming language with Lisp (& Haskell)
+influences. It is intended to combine the elegance of the
+(point-free) "concatenation is composition" model with the elegance of
+Lisp-like languages.
+
+**→ Try koneko in your browser with the JavaScript
+[REPL](https://koneko.dev).**
+
+### Properties
+
+* concatenative
+ - point-free
+ - juxtaposition of expressions denotes function composition
+* stack-oriented
+ - postfix (reverse polish) notation
+ - functions consume arguments from the stack
+ - functions produce return values on the stack
+* Lisp-like
+ - homoiconic
+ - blocks (anonymous functions, similar to lambdas)
+ - named parameters/points (lexically scoped)
+* functional
+ - only immutable data structures
+ - does have side effects (I/O)
+ - (mostly) strict evaluation
+* dynamically, strongly typed
+
+### Features
+
+* primitive (built-in):
+ - primitive data types: nil, bool, int, float, str, kwd
+ - composite data types: pair, list, dict
+ - multi(method)s (similar to multiple dispatch & type classes)
+ - records (similar to algebraic data types)
+ - modules
+ - regexes (mostly Perl-compatible and thus not actually "regular" expressions)
+ - concurrency (& parallelism)
+ - exception handling
+ - thunks
+* prelude (standard library):
+ - stack shuffling
+ - combinators (stack-oriented higher-order functions)
+ - arithmetic
+ - string operations
+ - ranges, lazy sequences & sequence operations
+ - slicing & associative structure operations
+ - looping & basic I/O
+ - either, functor, monad
+* nil punning
+* syntactic sugar (on top of a minimal "core language")
+
+## Whirlwind Tour
+
+### Hello World
+
+```bash
+$ koneko -e '"Hello, World!" say!'
+hello, World!
+```
+
+### REPL
+
+```bash
+$ koneko
+>>> "Hello, World!" say!
+Hello, World!
+>>> ^D
+```
+
+### The Weird (& Wonderful)
+
+```koneko
+>>> 1 2 + ; postfix notation
+3
+
+>>> drop ; functions manipulate the stack
+>>> ( 3 4 ) ; literals push a value onto the stack
+( 3 4 )
+
+>>> len dup ; unquoted identifiers are calls
+2
+>>> '+ ; quoted identifiers push themselves
+#
+>>> call ; and can then be called explicitly
+4
+
+>>> ( 1 2 3 )
+( 1 2 3 )
+>>> reverse show ; concatenation is function composition
+"( 3 2 1 )"
+
+>>> ( 4 5, 6 ) ; commas are whitespace
+( 4 5 6 )
+
+; unless a line starts with a comma, the command-line repl will print
+; the top of the stack after evaluating it
+>>> , 7 2
+>>> -
+5
+
+>>> ,s! ; show the stack (non-browser repl only)
+--- STACK ---
+5
+( 4 5 6 )
+"( 3 2 1 )"
+4
+--- END ---
+>>> clear-stack! ; clear the stack (repl only)
+*** STACK CLEARED ***
+```
+
+NB: use whitespace to separate tokens since "special" characters like
+`+` and `(` are not delimiters but valid parts of identifiers.
+
+```koneko
+>>> 1 2+
+*** ERROR: name 2+ is not defined
+>>> (1 2)
+*** ERROR: name (1 is not defined
+```
+
+Details:
+→ [Language Features](doc/01-language-features.md),
+→ [Ident(ifiers) & Quoting](doc/02-identifiers-and-quoting.md)
+
+### Data Types
+
+NB: all data types are immutable.
+
+```koneko
+>>> () ; empty list
+()
+>>> ( nil #t #f ) ; list containing nil, true & false
+( nil #t #f )
+>>> ( 1 2 + 4 ) ; nested expressions are evaluated
+( 3 4 )
+
+>>> 32 0x20 0b100000 ; integers
+32
+>>> 3.14 ; floating point
+3.14
+
+>>> "spam & eggs" ; string
+"spam & eggs"
+>>> :foo ; keyword (aka symbol)
+:foo
+
+>>> :answer 42 => ; key/value pair
+:answer 42 =>
+>>> { x: 42, :y 99 1 + => } ; dict: key/value map
+{ :x 42 =>, :y 100 => }
+```
+
+NB: `nil` and `#f` are falsy, everything else is truthy.
+
+```koneko
+>>> , :Point ( :x :y ) defrecord ; define record type
+>>> Point( 1 -1 ) ; "list" constructor
+Point{ :x 1 =>, :y -1 => }
+>>> Point{ y: -1, x: 1 } ; "dict" constructor
+Point{ :x 1 =>, :y -1 => }
+>>> .x ; field access
+1
+```
+
+Details:
+→ [Primitive Data Types](doc/03-primitive-data-types.md),
+→ [Pairs, Lists & Dicts](doc/04-pairs-lists-and-dicts.md),
+→ [Records](doc/07-records.md)
+
+### Functions
+
+```koneko
+>>> , 2 7 ; push 2 and 7
+>>> [ swap - ] ; push a block
+[ swap - ]
+>>> call ; call the block
+5
+>>> , :swap-and-subtract [ swap - ] def ; named block
+>>> 2 7 swap-and-subtract
+5
+```
+
+NB: since purely concatenative programs contain no free variables,
+almost any "subexpression" can be "factored out" simply by giving it a
+name.
+
+```koneko
+>>> , :myswap [ x y . 'y 'x ] def ; named parameters
+>>> , 1 2 myswap s!
+--- STACK ---
+1
+2
+--- END ---
+
+>>> 1 2 [ x y . y x ] call ; remember to quote non-calls
+*** ERROR: type int is not callable
+>>> [1 +] ; remember to use whitespace
+*** ERROR: name [1 is not defined
+```
+
+Details:
+→ [Functions](doc/05-functions.md),
+→ [Multi(method)s](doc/06-multimethods.md)
+
+### Primitives & Prelude
+
+Details:
+→ [Primitives, Builtins & Prelude](doc/09-primitives-builtins-and-prelude.md),
+→ [Prelude: Syntax Highlighted Source](https://koneko.dev/lib-doc/prelude.knk.html),
+→ [Prelude: Function Index](https://koneko.dev/lib-doc/prelude.knk.index.html)
+
+```koneko
+>>> , :inc [ 1 + ] def ; naming things
+>>> 41 'inc call ; explicit call
+42
+
+>>> 1 2 < ; comparison: = not= < <= > >=
+#t
+>>> [ :less ] [ :not-less ] if ; conditional
+:less
+
+>>> ( 42 ) show ; convert to readable str
+"( 42 )"
+>>> "foo" show
+"\"foo\""
+
+>>> , "Hello!" say! ; print line
+Hello!
+```
+
+#### Stack Shuffling
+
+```koneko
+>>> 1 2 swap drop dup + ; swap, drop the 1, dup the 2, add
+4
+```
+
+#### Combinators
+
+```koneko
+>>> , 35 [ 2 + ] [ 7 + ] bi ; call two functions on 1 value
+>>> , s!
+--- STACK ---
+42
+37
+--- END ---
+```
+
+### Syntactic Sugar
+
+```koneko
+>>> answer: 42 ; pair w/ single-token value
+:answer 42 =>
+>>> { x: 1, y: 2 } ; dict literal
+{ :x 1 =>, :y 2 => }
+
+>>> 1 ( 2 3 ) !cons ; field call (field access + call)
+( 1 2 3 )
+
+>>> '.x ; quoted field access
+[ :x __swap__ __call__ ]
+>>> '!x ; quoted field call
+[ :x __swap__ __call__ __call__ ]
+
+>>> '[ 2 * '1 div ] ; "curried" block w/ "holes"
+[ __1__ . [ 2 * '__1__ div ] ]
+>>> 3 swap call ; "fill" the hole from the stack
+[ 2 * '__1__ div ]
+>>> 5 swap call
+3
+```
+
+Details:
+→ [Syntactic Sugar](doc/08-syntactic-sugar.md)
+
+### Examples
+
+```koneko
+>>> , :fibs ( 0 1 ) [ 'fibs dup rest '+ zip ] lseq def
+>>> 'fibs 10 take-first ->list
+( 0 1 1 2 3 5 8 13 21 34 )
+>>> 'fibs 10 nth
+55
+```
+
+```koneko
+>>> "" 0.0 0.0 / show .[ '1 ++ ] 10 times " batman!" ++ say!
+NaNNaNNaNNaNNaNNaNNaNNaNNaNNaN batman!
+```
+
+```koneko
+>>> 15 [1-n] [ dup 3 "fizz" 5 "buzz" '[ '1 div? '2 "" ? ] 2bi$ bi
+... ++ 'show 'nip ~seq say! ] each
+1
+2
+fizz
+4
+buzz
+fizz
+7
+8
+fizz
+buzz
+11
+fizz
+13
+14
+fizzbuzz
+```
+
+## Language Reference
+
+→ [01: Language Features](doc/01-language-features.md),
+
+→ [02: Ident(ifiers) & Quoting](doc/02-identifiers-and-quoting.md),
+
+→ [03: Primitive Data Types](doc/03-primitive-data-types.md),
+
+→ [04: Pairs, Lists & Dicts](doc/04-pairs-lists-and-dicts.md),
+
+→ [05: Functions](doc/05-functions.md),
+
+→ [06: Multi(method)s](doc/06-multimethods.md),
+
+→ [07: Records](doc/07-records.md),
+
+→ [08: Syntactic Sugar](doc/08-syntactic-sugar.md),
+
+→ [09: Primitives, Builtins & Prelude](doc/09-primitives-builtins-and-prelude.md),
+
+→ [10: Standard Library](doc/10-standard-library.md),
+
+→ [11: Possible Future Extensions](doc/11-future.md)
+
+### Prelude
+
+→ [Syntax Highlighted Source](https://koneko.dev/lib-doc/prelude.knk.html),
+→ [Function Index](https://koneko.dev/lib-doc/prelude.knk.index.html)
+
+## More Examples
+
+→ [More Examples](doc/more-examples.md)
+
+## Doctests
+
+Like Python (& Haskell), koneko supports "doctests": executable pieces
+of documentation that look like interactive REPL sessions. Doctests
+make it easy to write user tutorials, documentation, and regression
+tests at the same time and confirm that examples in documentation are
+correct and up to date.
+
+NB: this README, the Language Reference, and koneko's Prelude &
+Standard Library are full of doctests.
+
+Lets look at an example, `mylib.knk`:
+
+```koneko
+:mylib defmodule[
+
+; swap top 2 values
+;
+; >>> :mylib use
+; >>> , 1 2 s!
+; --- STACK ---
+; 2
+; 1
+; --- END ---
+; >>> , myswap s!
+; --- STACK ---
+; 1
+; 2
+; --- END ---
+
+:myswap [ x y . 'y 'x ] def
+
+] ; defmodule
+```
+
+We run koneko with the `--doctest` option (in this case also with `-v`
+for verbosity) to execute the tests in a koneko -- or markdown --
+file:
+
+```bash
+$ KONEKOPATH=. koneko --doctest -v mylib.knk
+=== Testing mylib.knk (koneko) ===
+Trying:
+ :mylib use
+Expecting:
+ok
+Trying:
+ , 1 2 s!
+Expecting:
+ --- STACK ---
+ 2
+ 1
+ --- END ---
+ok
+Trying:
+ , myswap s!
+Expecting:
+ --- STACK ---
+ 1
+ 2
+ --- END ---
+ok
+Total: 3, Tried: 3, Passed: 3, Failed: 0.
+=== Summary ===
+Total: 3, Tried: 3, Passed: 3, Failed: 0.
+Test passed.
+
+=== Summary ===
+Files: 1.
+Total: 3, Tried: 3, Passed: 3, Failed: 0.
+Test passed.
+```
+
+NB: for `:mylib use` to be able to load the `mylib.knk` file we need
+to add the current directory to `KONEKOPATH`.
+
+## Installing
+
+See [(Build) Requirements](#build-requirements).
+
+... TODO ...
+
+## Running
+
+### Linux (& Probably macOS and *BSD)
+
+```bash
+$ make cabal_build # Haskell Build
+$ ./scripts/repl_hs # Haskell REPL
+
+$ ./scripts/repl_js # Node.js REPL
+$ make repl_browser # Browser REPL
+```
+
+### Windows (Untested)
+
+```
+$ cabal v2-build --write-ghc-environment-files=always --enable-tests
+$ cabal v2-run koneko # Haskell REPL
+
+$ node js\koneko # Node.js REPL
+```
+
+... TODO ...
+
+## (Build) Requirements
+
+The Haskell implementation requires the [Haskell
+Platform](https://www.haskell.org/platform) (and a few additional
+libraries that the Cabal build system provided with the Platform can
+install); see `koneko.cabal` for the dependencies.
+
+The JavaScript implementation requires Node.js.
+
+### Debian
+
+```bash
+$ apt install haskell-platform libghc-aeson-dev \
+ libghc-cmdargs-dev libghc-doctest-dev libghc-hashtables-dev \
+ libghc-megaparsec-dev libghc-regex-pcre-dev \
+ libghc-safe-dev libghc-silently-dev # Haskell version
+$ apt install nodejs # Node.js version
+$ apt install rlwrap # (readline support)
+```
+
+## Specs & Docs
+
+```bash
+$ make cabal_build test_haskell # Haskell
+$ make test_node # JavaScript
+```
+
+TODO: haddock
+
+## Vim Syntax Highlighting
+
+```bash
+$ make link_vim_syntax # symlinks misc/vim/ files from ~/.vim
+$ make copy_vim_syntax # copies misc/vim/ files to ~/.vim
+```
+
+## TODO
+
+* finish design
+* finish documentation
+* finish implementation
+* ???
+* profit!
+
+## License
+
+### Interpreter(s)
+
+[](https://www.gnu.org/licenses/gpl-3.0.html)
+
+### Standard Library
+
+(i.e. `lib/*.knk`)
+
+[](https://www.gnu.org/licenses/lgpl-3.0.html)
+
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/doc/01-language-features.md b/doc/01-language-features.md
new file mode 100644
--- /dev/null
+++ b/doc/01-language-features.md
@@ -0,0 +1,75 @@
+
+
+ File : doc/01-language-features.md
+ Maintainer : Felix C. Stegerman
+ Date : 2020-02-07
+
+ Copyright : Copyright (C) 2020 Felix C. Stegerman
+ Version : v0.0.1
+ License : GPLv3+
+
+
+
+→ [README](../README.md),
+→ next: [Ident(ifiers) & Quoting](02-identifiers-and-quoting.md)
+
+## Language Features
+
+→ [Type System](#type-system),
+→ [Errors](#errors),
+→ [Comments & Whitespace](#comments--whitespace)
+
+A program is a sequence of tokens. Each token represents a function
+that takes a scope and a stack and returns an (updated) stack.
+
+Juxtaposition (concatenation) of tokens denotes function composition.
+Some tokens, like list literals, are nested.
+
+Evaluating any data type literal (e.g. bool, int, list, block) results
+in pushing a corresponding value of its type onto the stack.
+
+All data types are immutable.
+
+The syntax and semantics of concatenative languages form the algebraic
+structure of a monoid [[1]](#references).
+
+### Type System
+
+Koneko is strongly typed. For now, it will use dynamic typing and
+allow blocks to be of variable arity. Optional (static) type and/or
+arity checking may be added in the future.
+
+### Errors
+
+Invalid programs will result in errors; these include:
+
+* parse errors (invalid syntax);
+* name not defined (referencing an undefined ident);
+* stack underflow;
+* type error (expected e.g. an int on the stack, got something else);
+* empty list (when trying to access the head or tail);
+* key errors (when trying to access a key not in a dict);
+* etc.
+
+When an error occurs (and is not caught), an error message is printed
+and the program is terminated (except when using the repl, in which
+case the repl continues after printing an error message and resetting
+the stack).
+
+### Comments & Whitespace
+
+```
+; comments start with a semicolon and end at the end of the line
+
+1 2 + ; tokens are separated by whitespace
+1 2 +, 2 3 + ; commas are whitespace
+```
+
+NB: the repl will print the top of the stack (unless empty) after it
+evaluates a line -- unless the line starts with a `,`.
+
+## References
+
+1. https://en.wikipedia.org/wiki/Concatenative_programming_language#Properties
+
+
diff --git a/doc/02-identifiers-and-quoting.md b/doc/02-identifiers-and-quoting.md
new file mode 100644
--- /dev/null
+++ b/doc/02-identifiers-and-quoting.md
@@ -0,0 +1,156 @@
+
+
+ File : doc/02-identifiers-and-quoting.md
+ Maintainer : Felix C. Stegerman
+ Date : 2020-02-07
+
+ Copyright : Copyright (C) 2020 Felix C. Stegerman
+ Version : v0.0.1
+ License : GPLv3+
+
+
+
+→ [README](../README.md),
+→ prev: [Language Features](01-language-features.md),
+→ next: [Primitive Data Types](03-primitive-data-types.md)
+
+## Ident(ifier)s & Quoting
+
+→ [Ident(ifier)s](#identifiers),
+→ [Quoting](#quoting),
+→ [Naming Things](#naming-things),
+→ [Modules](#modules)
+
+### Ident(ifier)s
+
+Any contiguous sequence of one or more:
+
+* unicode letters, numbers, or symbols (including `~$^=+|<>`); or
+* brackets (any of `(){}[]`); or
+* any of these "punctuation" characters: `@%&*-_/?` and `'!:`
+
+is an identifier if it:
+
+* does not start with any of `'!:` or end with `:`;
+* is not a single bracket or `()`;
+* is not a valid integer literal, floating point literal, or `nil`;
+* and does not end with an opening bracket.
+
+[Unquoted](#quoting) idents are always evaluated as calls: the ident
+is looked up in the current scope, the value found is pushed onto the
+stack, and the top of the stack is `call`ed.
+
+NB: `+`, `foo`, and `<42>'` are all idents; there is no distinction
+between the names of "functions", "variables", and "operators".
+
+#### Special Ident(ifier)s
+
+* idents starting and ending with `__` (e.g. `__call__`) are
+ reserved for primitives and should not be used elsewhere;
+* `_` is not reserved, but should only be used for ignored parameters
+ and has special meaning as a "default type name" for multis;
+* `&` and `&&` are not reserved, but have special meaning as
+ parameter names (see `apply` and `apply-dict`).
+
+#### [ADVANCED] Naming Conventions
+
+Functions with names starting with:
+
+* `~` (e.g. `~nil`) branch (and possibly pattern match) on (the type
+ of) a value;
+* `^` (e.g. `^seq`) pattern match (and "destructure") a value;
+* `&` can be `apply`d to a variable number of arguments;
+* a number (e.g. `2dip`) perform an operation on that number of their
+ arguments.
+
+Functions with names ending with:
+
+* `!` (e.g. `say!`) are impure (i.e. they perform I/O);
+* `?` (e.g. `nil?`) are predicates (i.e. functions that return a bool);
+* `^` (e.g. `head^`) are partial functions (i.e. they are only defined
+ for a subset of the values of the type(s) of their argument(s); e.g.
+ `head^` will fail for an empty list, whereas `head` will return
+ `nil`).
+
+Combinators with names ending with:
+
+* `$` (e.g. `bi$`) take multiple values and a single function;
+* `~` (e.g. `bi~`) take multiple values and functions and "pair" them;
+* `*` (e.g. `bi*`) take multiple values and functions and "multiply"
+ them.
+
+NB: combinators that take a single value and multiple functions (e.g.
+`bi` and `tri`) do not end with a "special" character.
+
+### Quoting
+
+Quoted idents ("quots") omit the `call`: the ident is looked up and
+the value found is pushed onto the stack.
+
+```koneko
+>>> 1 2 + ; push and call "+"
+3
+>>> '+ ; push "+"
+#
+>>> 1 2 '+ call ; push "+", then call it
+3
+```
+
+### Naming Things
+
+Identifiers refer to either named parameters or definitions in modules.
+
+When an ident is called or quoted, it is looked up in the following
+order:
+
+* primitives;
+* the current scope and any parent scope(s);
+* the module the current scope belongs to;
+* any modules imported by the scope's module;
+* builtins;
+* the prelude.
+
+NB: `def` is the module definition primitive; it takes a
+[keyword](03-primitive-data-types.md) representing the name of the
+ident to be defined and a value to bind the ident to.
+
+```koneko
+>>> , :answer 42 def ; define a constant (in the current module)
+>>> , :inc [ 1 + ] def ; define a function
+>>> 'answer inc
+43
+```
+
+NB: koneko is a functional language: named parameters cannot be
+"assigned" another value; "redefining" an existing definition in a
+module is not allowed according to the language specification (except
+in the repl), but this is currently not enforced by the
+implementations (although the JavaScript interpreter does raise a
+warning). Definitions **should** also only occur at the beginning of
+modules, preceding any other code (but this is also not currently
+enforced).
+
+The default module is `__main__`; primitives, builtins, and the
+prelude are `__prim__`, `__bltn__`, and `__prld__` respectively.
+
+### Modules
+
+**NB: work in progress.**
+
+```
+>>> , :foo [ ... ] defmodule ; define a module
+>>> , :foo import ; import a module
+>>> , ( :x :y ) :foo import-from ; copy specific idents from a module
+```
+
+```
+>>> , :foo require ; loads foo.knk if necessary
+>>> , :foo use ; require + import
+>>> , ( :x :y ) :foo use-from ; require + import-from
+```
+
+NB: `:foo require` will find & load `foo.knk` if the module `foo` is
+not already defined; `foo.knk` is assumed to define the module `foo`
+(`:foo [ ... ] defmodule`).
+
+
diff --git a/doc/03-primitive-data-types.md b/doc/03-primitive-data-types.md
new file mode 100644
--- /dev/null
+++ b/doc/03-primitive-data-types.md
@@ -0,0 +1,76 @@
+
+
+ File : doc/03-primitive-data-types.md
+ Maintainer : Felix C. Stegerman
+ Date : 2019-12-12
+
+ Copyright : Copyright (C) 2019 Felix C. Stegerman
+ Version : v0.0.1
+ License : GPLv3+
+
+
+
+→ [README](../README.md),
+→ prev: [Ident(ifiers) & Quoting](02-identifiers-and-quoting.md),
+→ next: [Pairs, Lists & Dicts](04-pairs-lists-and-dicts.md)
+
+## Primitive Data Types
+
+i.e. nil, bool, int, float, str, kwd
+
+```koneko
+>>> nil ; nothing to see here...
+nil
+
+>>> #t ; true
+#t
+>>> #f ; false (nil and #f are falsy, everything else is truthy)
+#f
+
+>>> 42 ; integer
+42
+>>> 0x20
+32
+>>> 0b11
+3
+
+>>> 3.14 ; floating point
+3.14
+```
+
+```koneko
+>>> "spam & eggs" ; string
+"spam & eggs"
+>>> "\u732bs"
+"猫s"
+>>> "\x20"
+" "
+```
+
+```koneko
+>>> :key-word ; keyword (aka symbol)
+:key-word
+>>> :"keyword that is not a valid ident"
+:"keyword that is not a valid ident"
+```
+
+NB: for more information on keywords/symbols, see [[1]](#references).
+
+NB: ideally keywords are implemented as interned strings but the
+language specification does not guarantee that (and the current
+implementation does not intern them).
+
+
+
+## References
+
+1. https://en.wikipedia.org/wiki/Symbol_(programming)
+
+
diff --git a/doc/04-pairs-lists-and-dicts.md b/doc/04-pairs-lists-and-dicts.md
new file mode 100644
--- /dev/null
+++ b/doc/04-pairs-lists-and-dicts.md
@@ -0,0 +1,54 @@
+
+
+ File : doc/04-pairs-lists-and-dicts.md
+ Maintainer : Felix C. Stegerman
+ Date : 2019-12-06
+
+ Copyright : Copyright (C) 2019 Felix C. Stegerman
+ Version : v0.0.1
+ License : GPLv3+
+
+
+
+→ [README](../README.md),
+→ prev: [Primitive Data Types](03-primitive-data-types.md),
+→ next: [Functions](05-functions.md)
+
+## Pairs, Lists & Dicts
+
+NB: list literals have the head on the left.
+
+```koneko
+>>> :answer 42 => ; key/value pair
+:answer 42 =>
+>>> ,dup
+>>> .key ; field access
+:answer
+>>> ,drop
+>>> .value
+42
+>>> answer: 42 ; syntactic sugar
+:answer 42 =>
+
+>>> ( 1 2 :foo 4 ) ; linked list (parentheses)
+( 1 2 :foo 4 )
+>>> ,dup
+>>> len
+4
+>>> ,drop
+>>> 2 get^ ; indexing
+:foo
+>>> () empty?
+#t
+
+>>> { x: 42, :y 99 1 + => } ; dict: key/value map (curly brackets)
+{ :x 42 =>, :y 100 => }
+>>> ,dup
+>>> len
+2
+>>> ,drop
+>>> :x get^ ; indexing
+42
+```
+
+
diff --git a/doc/05-functions.md b/doc/05-functions.md
new file mode 100644
--- /dev/null
+++ b/doc/05-functions.md
@@ -0,0 +1,143 @@
+
+
+ File : doc/05-functions.md
+ Maintainer : Felix C. Stegerman
+ Date : 2020-02-02
+
+ Copyright : Copyright (C) 2020 Felix C. Stegerman
+ Version : v0.0.1
+ License : GPLv3+
+
+
+
+→ [README](../README.md),
+→ prev: [Pairs, Lists & Dicts](04-pairs-lists-and-dicts.md),
+→ next: [Multi(method)s](06-multimethods.md)
+
+## Functions
+
+→ [Blocks](#blocks),
+→ [Calling vs Applying](#calling-vs-applying),
+→ [Functions vs Callables](#functions-vs-callables)
+
+### Blocks
+
+(almost, but not quite, entirely unlike lambdas)
+
+A block consists of:
+
+* optional parameters (for which the arguments are popped from the
+ stack -- right to left (i.e. from the top of the stack) -- when the
+ block is called);
+* code (i.e. a sequence of tokens) that is executed when the block is
+ called.
+
+A block is delimited by square brackets; parameters (if any) are
+separated from the code by a `.`.
+
+```koneko
+; push a block -- that pushes 42 onto the stack -- onto the stack
+>>> [ 42 ]
+[ 42 ]
+>>> call ; call the block on the stack
+42
+
+>>> , :myblock [ 42 ] def ; let's give it a name
+>>> 'myblock ; put it on the stack
+[ 42 ]
+>>> call
+42
+>>> myblock ; call it by name
+42
+```
+
+```koneko
+>>> , :myswap [ x y . 'y 'x ] def ; a block with named parameters
+>>> 1 2 myswap
+1
+>>> ,s!
+--- STACK ---
+1
+2
+--- END ---
+```
+
+### Calling vs Applying
+
+NB: since there are usually no guarantees about whether a block has
+named parameters (or how many), only blocks/functions known to
+explicitly support applying should be applied. Record constructors
+always support application.
+
+Applying a normal block isn't much different from calling it. Except
+that it takes its arguments from the list it is applied to (in reverse
+order) instead of from the stack. The number of elements of the list
+(i.e. the number of arguments) must equal the number of parameters of
+the block. The block cannot (indirectly) access the part of the stack
+before the list it is applied to. It can push any number of return
+values on to the stack as usual.
+
+```koneko
+>>> , :foo [ x y . ( 'x 'y ) show say! ] def ; normal block
+>>> :x :y foo ; normal call
+( :x :y )
+>>> ( :x :y ) 'foo apply ; apply
+( :x :y )
+>>> foo( :x :y ) ; sugar
+( :x :y )
+```
+
+A block with a parameter named `&` will ignore that parameter when
+called normally (setting it to `nil`). It can be applied to a list
+with a number of elements equal to or greater than the number of
+normal parameters of the block. The parameter `&` is set to a
+(possibly empty) list of the remaining elements/arguments.
+
+```koneko
+>>> , :foo [ x & . ( 'x '& ) show say! ] def ; block with &
+>>> :x foo ; normal call
+( :x nil )
+>>> ( :x :y :z ) 'foo apply ; apply
+( :x ( :y :z ) )
+>>> foo( :x :y :z ) ; sugar
+( :x ( :y :z ) )
+```
+
+A block with a parameter named `&&` will ignore that parameter when
+called normally (setting it to `nil`). It can be applied to a dict,
+which needs to provide values for each normal parameter (by name).
+The parameter `&&` is set to a (possibly empty) dict of the remaining
+key/value pairs (the ones not used to provide values for the normal
+parameters).
+
+```koneko
+>>> , :foo [ x && . ( 'x '&& ) show say! ] def ; block with &&
+>>> :x foo ; normal call
+( :x nil )
+>>> { :x 1 =>, :y 2 => } 'foo apply-dict ; apply-dict
+( 1 { :y 2 => } )
+>>> foo{ x: 1, y: 2 } ; sugar
+( 1 { :y 2 => } )
+```
+
+Some more examples:
+
+```koneko
+>>> , :&+ [ x & . '& 'x '+ foldl ] def
+>>> &+( 1 2 3 4 )
+10
+```
+
+... TODO ...
+
+### Functions vs Callables
+
+Functions are: blocks, builtins, multis, and record-types; these all
+behave like (stack-based) functions and can be `call`ed (and sometimes
+`apply`d and/or `apply-dict`ed).
+
+Callables are: all types that can be `call`ed: foremostly functions,
+but also other types (e.g. list and record) that are not functions but
+which implement certain primitive operations via calls.
+
+
diff --git a/doc/06-multimethods.md b/doc/06-multimethods.md
new file mode 100644
--- /dev/null
+++ b/doc/06-multimethods.md
@@ -0,0 +1,50 @@
+
+
+ File : doc/06-multimethods.md
+ Maintainer : Felix C. Stegerman
+ Date : 2020-02-07
+
+ Copyright : Copyright (C) 2020 Felix C. Stegerman
+ Version : v0.0.1
+ License : GPLv3+
+
+
+
+→ [README](../README.md),
+→ prev: [Functions](05-functions.md),
+→ next: [Records](07-records.md)
+
+## Multi(method)s
+
+```koneko
+; a multi w/ 2 parameters, defined for a mix of int and float
+>>> , :add ( :int :int ) [ __int+__ ] defmulti
+>>> , :add ( :float :float ) [ __float+__ ] defmulti
+>>> , :add ( :int :float ) [ 'int->float dip add ] defmulti
+>>> , :add ( :float :int ) [ int->float add ] defmulti
+>>> 1 2 add
+3
+>>> 1.0 add
+4.0
+```
+
+To provide a "fallback"/"default" for a multi, use a signature
+consisting only of `:_` keywords (the number matching the arity).
+
+```koneko
+>>> , :add ( :_ :_ ) [ nil ] defmulti
+>>> "foo" () add
+nil
+```
+
+NB: `defmulti` always creates or extends a multi in the current
+module; to extend a multi from e.g. the prelude, alias it first.
+
+NB: multis are "global state": extending e.g. a prelude multi will
+affect all code using that multi.
+
+NB: the language specification prohibits "redefining" a multi for the
+same signature but this is currently not enforced by the
+implementations.
+
+
diff --git a/doc/07-records.md b/doc/07-records.md
new file mode 100644
--- /dev/null
+++ b/doc/07-records.md
@@ -0,0 +1,69 @@
+
+
+ File : doc/07-records.md
+ Maintainer : Felix C. Stegerman
+ Date : 2019-12-12
+
+ Copyright : Copyright (C) 2019 Felix C. Stegerman
+ Version : v0.0.1
+ License : GPLv3+
+
+
+
+→ [README](../README.md),
+→ prev: [Multi(method)s](06-multimethods.md),
+→ next: [Syntactic Sugar](08-syntactic-sugar.md)
+
+## Records
+
+```koneko
+>>> , :Point ( :x :y ) defrecord ; define record type
+>>> Point( 1 -1 ) ; "list" constructor
+Point{ :x 1 =>, :y -1 => }
+>>> Point{ y: -1, x: 1 } ; "dict" constructor
+Point{ :x 1 =>, :y -1 => }
+>>> ,dup
+>>> Point? ; automatically defined type predicate
+#t
+>>> ,drop dup
+>>> .x ; field access
+1
+>>> ,drop dup
+>>> .y
+-1
+>>> ,drop
+>>> { x: 99 } update ; update record (creates a new one)
+Point{ :x 99 =>, :y -1 => }
+
+; automatically defined "pattern match" function:
+; calls the block with the values of the records' fields
+>>> , [ x y . "x = " 'x show ++ ", y = " 'y show ++ ++ say! ] ^Point
+x = 99, y = -1
+
+; automatically defined "branch" function:
+; takes a second block to call if the value is of another type
+>>> , Point( 1 2 )
+>>> [ + ] [ "not a point" ] ~Point
+3
+
+; multis can have record names in their signatures
+>>> , :+ '+ def ; alias to extend
+>>> , :+ ( :Point :Point ) [ '.x '.y '[ '1 bi$ + ] bi$ 2bi Point ] defmulti
+>>> Point( 1 2 ) Point( 3 4 ) +
+Point{ :x 4 =>, :y 6 => }
+
+>>> Point( 9 34 ) record->dict ; conversion & type information
+{ :x 9 =>, :y 34 => }
+>>> Point( 3 4 ) record-type
+#
+>>> dup record-type-name
+:Point
+>>> drop record-type-fields
+( :x :y )
+>>> Point( 3 4 ) record-values
+( 3 4 )
+>>> '=> zip ->list dict 'Point apply-dict
+Point{ :x 3 =>, :y 4 => }
+```
+
+
diff --git a/doc/08-syntactic-sugar.md b/doc/08-syntactic-sugar.md
new file mode 100644
--- /dev/null
+++ b/doc/08-syntactic-sugar.md
@@ -0,0 +1,125 @@
+
+
+ File : doc/08-syntactic-sugar.md
+ Maintainer : Felix C. Stegerman
+ Date : 2022-02-12
+
+ Copyright : Copyright (C) 2022 Felix C. Stegerman
+ Version : v0.0.1
+ License : GPLv3+
+
+
+
+→ [README](../README.md),
+→ prev: [Records](07-records.md),
+→ next: [Primitives, Builtins & Prelude](09-primitives-builtins-and-prelude.md)
+
+## Syntactic Sugar
+
+The reader (i.e. parser) provides some syntactic sugar.
+
+```koneko
+>>> answer: 42 ; pair w/ single-token value
+:answer 42 =>
+>>> :answer 42 => ; desugared
+:answer 42 =>
+
+>>> { :x 1 =>, :y 2 => } ; dict literals are actually sugar
+{ :x 1 =>, :y 2 => }
+>>> ( :x 1 =>, :y 2 => ) dict ; desugared
+{ :x 1 =>, :y 2 => }
+
+>>> , :Point ( :x :y ) defrecord
+>>> Point{ y: 2, x: 1 } ; record "dict constructor"
+Point{ :x 1 =>, :y 2 => }
+>>> ( :y 2 =>, :x 1 => ) dict 'Point apply-dict ; desugared
+Point{ :x 1 =>, :y 2 => }
+
+>>> Point( 1 2 ) ; record "list constructor"
+Point{ :x 1 =>, :y 2 => }
+>>> ( 1 2 ) 'Point apply ; desugared
+Point{ :x 1 =>, :y 2 => }
+
+>>> ,dup
+>>> .x ; field access
+1
+>>> ,drop
+>>> :x swap call ; desugared
+1
+
+>>> 1 ( 2 3 ) !cons ; field call (field access + call)
+( 1 2 3 )
+>>> 1 ( 2 3 ) :cons swap call call ; desugared
+( 1 2 3 )
+
+>>> '.x ; quoted field access
+[ :x __swap__ __call__ ]
+>>> '!x ; quoted field call
+[ :x __swap__ __call__ __call__ ]
+
+>>> , Point( 1 2 ) Point( 3 4 )
+>>> '.x bi$ + ; useful for combinators
+4
+
+>>> '[ 2 * '1 div ] ; "curried" block w/ "holes"
+[ __1__ . [ 2 * '__1__ div ] ]
+>>> 3 swap call ; "fill" the hole from the stack
+[ 2 * '__1__ div ]
+>>> 2 .[ 3 * '1 div ] ; "." version calls immediately
+[ 3 * '__1__ div ]
+>>> 5 swap call
+7
+>>> 5 [ 3 * 2 div ] call ; equivalent
+7
+
+>>> '[ '2 .1 ] ; '2 is sugar for '__2__ (etc.)
+[ __1__ __2__ . [ '__2__ __1__ ] ]
+>>> '+ 1 .[ '2 .1 ] ; .1 is sugar for __1__ (etc.)
+[ '__2__ __1__ ]
+>>> 42 swap call
+43
+
+>>> 1 2 '+ 'show .[ .1 .2 ] call ; function composition
+"3"
+
+>>> ( 1 2 3 ) '* .[ 3 .1 2 div ] map ->list
+( 1 3 4 )
+>>> ( 1 2 3 ) [ 3 * 2 div ] map ->list ; equivalent
+( 1 3 4 )
+
+>>> '__prld__.puts! ; module access
+#
+>>> :puts! :__prld__ __module-get__ ; desugared
+#
+>>> , "hi!\n" __prld__.puts! ; unquoted -> call
+hi!
+
+>>> , :foo defmodule[ :x 1 def ] ; block "constructor"
+>>> , :foo [ :y 2 def ] defmodule ; desugared
+
+>>> ... ; sugar for __ellipsis__
+*** ERROR: name __ellipsis__ is not defined
+```
+
+## Aliases
+
+The repl provides some aliases.
+
+```koneko
+>>> , 1 2
+>>> ,s! ; s! ⇔ show-stack! ⇔ __show-stack!__
+--- STACK ---
+2
+1
+--- END ---
+>>> c! ; c! ⇔ clear-stack! ⇔ __clear-stack!__
+*** STACK CLEARED ***
+
+>>> 1 2 + d! ; d! ⇔ display!
+3
+>>> 1 2 + D! 3 + ; D! ⇔ ddisplay!
+3
+6
+```
+
+
diff --git a/doc/09-primitives-builtins-and-prelude.md b/doc/09-primitives-builtins-and-prelude.md
new file mode 100644
--- /dev/null
+++ b/doc/09-primitives-builtins-and-prelude.md
@@ -0,0 +1,555 @@
+
+
+ File : doc/09-primitives-builtins-and-prelude.md
+ Maintainer : Felix C. Stegerman
+ Date : 2020-02-09
+
+ Copyright : Copyright (C) 2020 Felix C. Stegerman
+ Version : v0.0.1
+ License : GPLv3+
+
+
+
+→ [README](../README.md),
+→ prev: [Syntactic Sugar](08-syntactic-sugar.md),
+→ next: [Standard Library](10-standard-library.md)
+
+## Primitives, Builtins & Prelude
+
+→ [Primitives](#primitives),
+→ [Builtins](#builtins),
+→ [Prelude](#prelude)
+
+### Primitives
+
+Primitive operations that make up the core language.
+
+NB: all primitives start and end with `__` (e.g. `__call__`); the
+prelude defines aliases without them (for the primitives intended to
+be used directly); unlike the primitives themselves, these aliases
+(e.g. `call`) can be shadowed by named parameters and module
+definitions.
+
+
+
+#### Calling, Branching & Comparing
+
+```koneko
+>>> 41 [ 1 + ] ; (put a block on the stack)
+[ 1 + ]
+>>> call ; call the callable on top of the stack
+42
+
+>>> , :T [ :truthy ] def, :F [ :falsy ] def
+>>> #t [ T ] [ F ] if ; conditional/branch
+:truthy
+>>> #f [ T ] [ F ] if ; false is falsy
+:falsy
+>>> nil [ T ] [ F ] if ; so is nil
+:falsy
+>>> 42 [ T ] [ F ] if ; everything else is truthy
+:truthy
+>>> 0 'T 'F if ; "branches" need not be blocks
+:truthy
+
+>>> 1 2 < ; compare: = not= < <= > >=
+#t
+>>> 1 2 <=> ; compare: -1 if <, 0 if =, 1 if >
+-1
+```
+
+##### CAVEATS
+
+The comparison functions `=`, `<`, `<=>`, etc. define an almost total
+ordering on all types. This makes sorting heterogeneous lists easy.
+
+The exceptions are that blocks, builtins, multis, and thunks are
+ordered respective to all other types but cannot be compared to values
+of their own type and the "usual" behaviour of NaN being unequal to
+even itself.
+
+NB: the ordering also treats all types as completely distinct --
+including numeric types like `int` and `float`.
+
+```koneko
+>>> ( "foo" ( :bar ) nil ) sort ; uses <=> :-)
+( nil "foo" ( :bar ) )
+>>> ( 1 2.0 3 4.0 ) sort ; uses <=> :-(
+( 1 3 2.0 4.0 )
+```
+
+The "alternative comparison" functions `eq`, `lt`, `cmp`, etc. define
+a partial ordering. They compare mixed `int` and `float` (by
+converting `int->float`) and reject all other mixed type comparisons.
+
+```koneko
+>>> 42 :foo <=>
+-1
+>>> 42 :foo cmp
+*** ERROR: types int and kwd are not comparable
+
+>>> 2 1.0 <=> ; also: = not= < <= > >=
+-1
+>>> 2 1.0 cmp ; also: eq neq lt lte gt gte
+1
+
+>>> ( 1 2.0 3 4.0 ) sort' ; uses cmp :-)
+( 1 2.0 3 4.0 )
+```
+
+#### Conversion, Type Information & I/O
+
+```koneko
+>>> ( 42 ) show ; convert to readable str
+"( 42 )"
+>>> "foo" show
+"\"foo\""
+
+>>> -2 abs
+2
+>>> -3.14 abs
+3.14
+
+>>> 3.14 trunc
+3
+>>> 9.5 round
+10
+>>> -9.5 round
+-10
+>>> 10.5 round
+10
+>>> -10.5 round
+-10
+>>> 0.0 0.0 / round ; NaN or Infinite -> nil
+nil
+>>> -3.14 floor
+-4
+>>> -3.14 ceil
+-3
+
+>>> 1 int->float
+1.0
+
+>>> () type ; get type as keyword
+:list
+>>> 1 type
+:int
+>>> type
+:kwd
+
+>>> 1 callable?
+#f
+>>> 'if callable?
+#t
+>>> () callable?
+#t
+>>> () function?
+#f
+
+>>> , "Hello!" say! ; print line
+Hello!
+```
+
+```
+>>> "What's your name? " ask! ; print prompt and read line
+What's your name? Foo
+"Foo"
+```
+
+#### Module Information
+
+```koneko
+>>> , :answer 42 def
+>>> __name__
+:__main__
+>>> __module-defs__
+( :D! :__args__ :__repl__ :answer :c! :clear-stack! :d! :s! :show-stack! )
+>>> :answer :__main__ __module-get__
+42
+>>> __modules__ [ show ":__" starts-with? ] filter ->list
+( :__bltn__ :__main__ :__prim__ :__prld__ )
+```
+
+#### REPL: Clear & Show Stack
+
+```koneko
+>>> clear-stack! ; only available in the repl
+*** STACK CLEARED ***
+>>> ,show-stack!
+--- STACK ---
+--- END ---
+>>> , 1 2 s! ; s! ⇔ show-stack!
+--- STACK ---
+2
+1
+--- END ---
+```
+
+#### Exceptions
+
+```koneko
+>>> "oops!" fail ; raise exception
+*** ERROR: oops!
+
+>>> , [ :try 1 2 3 ... ]
+... [ t m i . :catch { type: 't, message: 'm, info: 'i } #t ]
+... [ :finally ] try s! ; try/catch/finally
+--- STACK ---
+:finally
+{ :info ( "__ellipsis__" ) =>, :message "name __ellipsis__ is not defined" =>, :type :NameError => }
+:catch
+--- END ---
+>>> c!
+*** STACK CLEARED ***
+>>> , [ :no :errors :this :time ] [ ... ] [ :cleanup :here ] try s!
+--- STACK ---
+:here
+:cleanup
+:time
+:this
+:errors
+:no
+--- END ---
+>>> , [ ... ] nil [ :finally ] try ; w/o "catch"
+*** ERROR: name __ellipsis__ is not defined
+>>> , [ ... ] [ 3drop "ignoring error!" say! #t ] [] try
+ignoring error!
+```
+
+NB: the `catch` block must return a value that indicates whether the
+exception has been handled; it will be re-raised if it is falsy. This
+can -- and should! -- be used to only catch certain types of errors.
+
+```koneko
+>>> , [ 1 0 div ] [ 2drop :DivideByZero = ] [] try
+>>> , [ ... ] [ 2drop :DivideByZero = ] [] try
+*** ERROR: name __ellipsis__ is not defined
+```
+
+#### Regexes
+
+```koneko
+>>> "foo" "^f" rx-match ; matched part
+( "f" )
+>>> "foo" "^f(o+)" rx-match ; and groups
+( "foo" "oo" )
+>>> "bar" "^f" rx-match ; or nil
+nil
+
+>>> "foo bar" "$2 $1" "(\w+) (\w+)" #f rx-sub ; str or block
+"bar foo"
+>>> "1 2 3 4" [ swap " " ++sep++ nip ] "(\w+) (\w+)" #t rx-sub
+"2 1 4 3"
+
+>>> "foo 子猫 bar" [ reverse ] "\p{L}+" #t rx-sub ; replace all
+"oof 猫子 rab"
+>>> "foo 子猫 bar" [ reverse ] "\p{L}+" #f rx-sub ; replace first
+"oof 子猫 bar"
+```
+
+#### Miscellaneous
+
+```koneko
+>>> , [ 0.1 sleep :one ] [ 0.05 sleep :two ] par ; concurrency
+>>> ,s!
+--- STACK ---
+:two
+:one
+--- END ---
+
+>>> , [ [ 1 sleep "oops" fail ]
+... [ 1 [ D! inc 0.2 sleep #t ] loop ] par ]
+... [ 3list d! #t ] try-catch
+1
+2
+3
+4
+5
+( :Fail "oops" ( "oops" ) )
+```
+
+```
+>>> __version__ ; version & platform information
+( ( 0 0 1 ) :hs ( "linux x86_64" "ghc 8.6" ) )
+
+>>> __version__
+( ( 0 0 1 ) :js-node ( "linux x64" "node v10.17.0" ) )
+
+>>> __version__ 1st "v${0}.${1}.${2}" fmt
+"v0.0.1"
+```
+
+Of course `def` and `=>` are also primitives.
+
+There are also primitive arithmetic operations, but the prelude
+defines more convenient versions of these, like `+` and `div`:
+`__int+__`, `__int-__`, `__int*__`, `__div__`, `__mod__`,
+`__float+__`, `__float-__`, `__float*__`, `__float/__`.
+
+To list all primitives, run:
+
+```
+>>> :__prim__ __module-defs__ ; (elided)
+( :__=__ :__apply__ :__call__ :__def__ :__if__ ... )
+```
+
+### Builtins
+
+Operations that are easier or more efficient to implement in the
+interpreter but could have been defined in the prelude instead.
+
+```koneko
+>>> 42 nil? ; there is a predicate for each type
+#f
+>>> nil nil?
+#t
+>>> 42 int?
+#t
+>>> :foo kwd?
+#t
+
+>>> "0x20" str->int
+32
+>>> "3.14" str->float
+3.14
+>>> "foo" str->int
+nil
+```
+
+### Prelude
+
+→ [Stack Shuffling](#stack-shuffling),
+→ [Combinators](#combinators),
+→ [Logic & Arithmetic](#logic--arithmetic);
+
+→ [Strings, Chars, Nil, Numbers & Pairs](#strings-chars-nil-numbers--pairs),
+→ [Lists, Dicts, Ranges & Sequences](#lists-dicts-ranges--sequences),
+→ [Miscellaneous](#miscellaneous-1),
+→ [More](#more)
+
+A small set of standard definitions that is available automatically in
+all modules.
+
+See [`lib/prelude.knk`](../lib/prelude.knk) for the complete prelude
+with definitions and examples:
+
+→ [Syntax Highlighted Source](https://koneko.dev/lib-doc/prelude.knk.html),
+→ [Function Index](https://koneko.dev/lib-doc/prelude.knk.index.html)
+
+NB: the following is just an overview (and neither complete nor
+completely up-to-date); see the links above for all current prelude
+functions.
+
+#### Stack Shuffling
+
+```koneko
+>>> , 1 2 s!
+--- STACK ---
+2
+1
+--- END ---
+>>> , swap s! ; swap top 2 values on stack
+--- STACK ---
+1
+2
+--- END ---
+>>> , dup s! ; dup(licate) top of stack
+--- STACK ---
+1
+1
+2
+--- END ---
+>>> , drop s! ; drop (pop & discard) top of stack
+--- STACK ---
+1
+2
+--- END ---
+```
+
+See also: `rot>`, `>> , 35 [ 2 + ] [ 7 + ] bi
+>>> , s!
+--- STACK ---
+42
+37
+--- END ---
+
+>>> 3 '+ dip * ; pop x, call f, push x
+237
+
+>>> 41 1 '+ $ call ; partial function application
+42
+>>> 41 [ 1 + ] call
+42
+
+>>> 2 [ 1 + ] [ 3 * ] @ call ; function composition
+9
+>>> 2 [ 1 + 3 * ] call
+9
+```
+
+See also: `2$`, `3$`, `%`, `2dip`, `3dip`, `keep`, `2keep`, `tri`,
+`bi$`, `tri$`, `bi~`, `tri~`, `bi*`, `2bi`, `2tri`, `2bi$`, `2bi~`.
+
+#### Logic & Arithmetic
+
+```koneko
+>>> #f not
+#t
+>>> #f 1 or
+1
+>>> 1 nil and
+nil
+
+>>> #t 42 37 ?
+42
+
+>>> 19 [ 2 div ] [ 3 * 1 + ] 'even? ~?
+58
+```
+
+See also: `when`, `min`, `max`.
+
+```koneko
+>>> 1 2 +
+3
+>>> 1.0 2.0 /
+0.5
+>>> 8 3 div
+2
+>>> 5.0 neg
+-5.0
+>>> 37 odd?
+#t
+```
+
+#### Strings, Chars, Nil, Numbers & Pairs
+
+```koneko
+>>> 0x732b chr
+"猫"
+>>> ord
+29483
+```
+
+```koneko
+>>> nil [ "" ] [ type show ] ~nil
+""
+>>> ( 3 7 ) 'rest ~> 'first ~> [ 1 + ] ~>
+8
+>>> ( 7 3 ) ( 'rest 'first [ 1 + ] ) ~~>
+4
+```
+
+See also: `num?`, `~neg`, `~zero`, `~pos`, `^pair`.
+
+#### Lists, Dicts, Ranges & Sequences
+
+```koneko
+>>> () empty?
+#t
+>>> ( :x :y :z ) len
+3
+>>> ( :a :b :c ) 1 get^
+:b
+
+>>> ( 1 2 ) head^
+1
+>>> ( 1 2 3 ) tail^
+( 2 3 )
+>>> () head
+nil
+```
+
+```koneko
+>>> , ( 1 2 3 ) uncons^ s!
+--- STACK ---
+( 2 3 )
+1
+--- END ---
+>>> cons
+( 1 2 3 )
+>>> ( 3 4 ) 2 swap cons
+( 2 3 4 )
+```
+
+```koneko
+>>> ( 1 2 ) ( 3 4 ) ++
+( 1 2 3 4 )
+
+>>> ( :one :two :three ) 1 has?
+#t
+>>> ( :one :two :three ) :two elem?
+#t
+
+>>> { x: 1, y: 2 } { x: 99 } update
+{ :x 99 =>, :y 2 => }
+
+>>> 10 15 [m-n] ->list ; ranges
+( 10 11 12 13 14 15 )
+
+>>> "0123456789" 3 -3 [i-j) ; slicing
+"3456"
+```
+
+```koneko
+>>> () seq ; non-empty sequence or nil
+nil
+>>> ( 1 2 ) seq
+( 1 2 )
+>>> ( 1 2 ) first
+1
+>>> ( 1 2 ) rest
+( 2 )
+
+; branch/match on empty or first & rest
+>>> [ "empty" ] [ x xt . "not empty" ] ^seq
+"not empty"
+
+>>> ( 2 3 4 ) [ dup * ] map ->list
+( 4 9 16 )
+>>> ( 2 3 4 ) [ 2 mod 0 = ] filter ->list
+( 2 4 )
+>>> ( 2 3 4 ) 10 '- foldl
+1
+
+; map etc. consume and produce "lazy" (and possibly infinite) sequences
+>>> ( 1 2 3 ) cycle [ dup * ] map 7 take-first ->list
+( 1 4 9 1 4 9 1 )
+```
+
+See also: `[m-n)`, `[0-)`, `[1-n]`, etc.; `1list`, `lazy-seq`,
+`unseq`, `^list`, `zip`, `foldr`, `concat`, `reverse`, `each`,
+`cycle`, `iterate`, `repeat`, `replicate`, `take-first`, `drop-first`,
+`take-while`, `drop-while`, `sort`.
+
+#### Miscellaneous
+
+```koneko
+>>> , [ "Hi!" say! ] 3 times
+Hi!
+Hi!
+Hi!
+```
+
+#### More
+
+→ [Syntax Highlighted Source](https://koneko.dev/lib-doc/prelude.knk.html),
+→ [Function Index](https://koneko.dev/lib-doc/prelude.knk.index.html)
+
+
diff --git a/doc/10-standard-library.md b/doc/10-standard-library.md
new file mode 100644
--- /dev/null
+++ b/doc/10-standard-library.md
@@ -0,0 +1,102 @@
+
+
+ File : doc/10-standard-library.md
+ Maintainer : Felix C. Stegerman
+ Date : 2020-11-12
+
+ Copyright : Copyright (C) 2020 Felix C. Stegerman
+ Version : v0.0.1
+ License : GPLv3+
+
+
+
+→ [README](../README.md),
+→ prev: [Primitives, Builtins & Prelude](09-primitives-builtins-and-prelude.md),
+→ next: [Possible Future Extensions](11-future.md)
+
+## Standard Library
+
+→ [IO](#io), → [JSON](#json), → [Math](#math), → [Str](#str), ...
+
+### IO
+
+**NB: work in progress.**
+
+NB: the `io` module is built-in (and does not need to be `require`d or
+`use`d; it can of course still be `import`ed).
+
+```koneko
+>>> "lib/_test.knk" io.contents! 24 [-j) ; file contents
+"\"loading module _test..."
+>>> , "lib/_test.knk" io.lines! ; file lines
+>>> , "loading" grep 'say! each
+"loading module _test..." say!
+```
+
+### JSON
+
+NB: the `json` module is built-in (and does not need to be `require`d
+or `use`d; it can of course still be `import`ed).
+
+```koneko
+>>> { x: 42, y: ( 1 2 3 ) } dup json.<- ; json str <- value
+"{\"x\":42,\"y\":[1,2,3]}"
+>>> json.-> ; json str -> value
+{ :x 42 =>, :y ( 1 2 3 ) => }
+>>> =
+#t
+
+>>> :foo json.<- json.-> ; kwds become strs
+"foo"
+>>> x: 42 json.<- json.-> ; pairs become lists
+( "x" 42 )
+
+>>> , :Foo ( :x :y ) defrecord ; records become dicts
+>>> Foo( 1 2 ) json.<- json.->
+{ :__koneko_type__ "Foo" =>, :x 1 =>, :y 2 => }
+```
+
+### Math
+
+NB: the `math` module is built-in (and does not need to be `require`d
+or `use`d; it can of course still be `import`ed).
+
+```koneko
+>>> ( :^ :** :sqrt ) :math use-from
+
+>>> math.pi
+3.141592653589793
+>>> 1.0 math.exp
+2.718281828459045
+>>> 10.0 math.log ** round
+10
+
+>>> 2 10 ^
+1024
+>>> 2.0 10.0 **
+1024.0
+>>> 2.0 0.5 **
+1.4142135623730951
+>>> 2.0 sqrt
+1.4142135623730951
+
+>>> -0.0 math.sign
+-0.0
+>>> 1.0 0.0 / neg math.sign
+-1.0
+
+>>> math.pi 0.5 * math.sin
+1.0
+
+>>> :math __module-defs__
+( :** :^ :acos :acosh :asin :asinh :atan :atan2 :atanh :cos :cosh :exp :log :pi :sign :sin :sinh :sqrt :tan :tanh )
+```
+
+### Str
+
+→ [Syntax Highlighted Source](https://koneko.dev/lib-doc/str.knk.html),
+→ [Function Index](https://koneko.dev/lib-doc/str.knk.index.html)
+
+... TODO ...
+
+
diff --git a/doc/11-future.md b/doc/11-future.md
new file mode 100644
--- /dev/null
+++ b/doc/11-future.md
@@ -0,0 +1,32 @@
+
+
+ File : doc/11-future.md
+ Maintainer : Felix C. Stegerman
+ Date : 2020-02-05
+
+ Copyright : Copyright (C) 2020 Felix C. Stegerman
+ Version : v0.0.1
+ License : GPLv3+
+
+
+
+→ [README](../README.md),
+→ prev: [Standard Library](10-standard-library.md)
+
+## Future Extensions
+
+### Planned
+
+* Optional (static & dynamic) type and arity checking.
+* Pattern matching (`( 1 Foo( #_ 2 ) ) [ x . ... ] ^~`).
+* Optimisations.
+* Self-hosting compiler.
+* ...
+
+### Undecided
+
+* #/regex/ syntax.
+* Protocols/interfaces.
+* ...
+
+
diff --git a/doc/more-examples.md b/doc/more-examples.md
new file mode 100644
--- /dev/null
+++ b/doc/more-examples.md
@@ -0,0 +1,113 @@
+
+
+ File : doc/more-examples.md
+ Maintainer : Felix C. Stegerman
+ Date : 2020-02-07
+
+ Copyright : Copyright (C) 2020 Felix C. Stegerman
+ Version : v0.0.1
+ License : GPLv3+
+
+
+
+→ [README](../README.md)
+
+## More Examples
+
+**NB: outdated, work in progress.**
+
+### FP
+
+```koneko
+>>> , :fix '[ '1 fix .1 ] def ; fixed point (Y combinator)
+>>> [ drop 9 ] fix call
+9
+>>> [ 3 swap lseq1 ] fix call 10 take-first ->list
+( 3 3 3 3 3 3 3 3 3 3 )
+
+>>> , :fac [ .[ dup 1 - .1 * ] [ drop 1 ] ~pos ] fix def
+>>> 5 fac
+120
+
+>>> , :fib1 [ .[ 1 2 [ - .1 ] '$ $ bi$ bi + ] [] 2 ~[>=] ] fix def
+>>> , :fib2 [ .[ 1 - dup 1 - '1 bi$ + ] [] 2 ~[>=] ] fix def
+>>> 6 fib1 ; inefficient!
+8
+>>> 6 fib2 ; inefficient!
+8
+```
+
+```koneko
+>>> , :twice [ f . f f ] def ; with named parameters
+>>> 42 [ 1 + ] twice
+44
+```
+
+```koneko
+>>> , :twice [ dup 'call dip call ] def ; points-free
+>>> 42 [ 1 + ] twice
+44
+```
+
+```koneko
+>>> , :twice [ f . [ f f ] ] def ; "curried"
+>>> 0 [ 1 + ] twice twice twice twice call
+16
+
+>>> 0 [ 1 + ] [ twice twice ] twice call call
+16
+>>> 0 [ 1 + ] [ twice ] twice twice call call
+16
+
+>>> 0 [ 1 + ] [ twice twice ] twice twice call call
+256
+>>> 0 [ 1 + ] [ twice ] twice twice twice call call
+256
+```
+
+```
+>>> 0 [ 1 + ] ??? ; TODO
+65536
+```
+
+```koneko
+>>> , :mymap [ f . dup empty? [] [ uncons^ 'f dip 'f mymap cons ] if ] def
+>>> ( 1 2 3 ) [ dup * ] mymap
+( 1 4 9 )
+```
+
+```koneko
+>>> , :maybe [ swap [ over nil? not swap when ] foldl ] def
+>>> , :Customer ( :orders ) defrecord
+>>> , :Order ( :price ) defrecord
+>>> Customer( ( Order( 42 ) ) )
+Customer{ :orders ( Order{ :price 42 => } ) => }
+>>> ,dup
+>>> ( '.orders [ 0 get ] '.price ) maybe
+42
+>>> ,drop
+>>> ( '.orders [ 1 get ] '.price ) maybe
+nil
+```
+
+### BYO Primitives
+
+```koneko
+>>> , :myif [ 'and dip or call ] def
+>>> 42 [ :A ] [ :B ] myif
+:A
+>>> #f [ :A ] [ :B ] myif
+:B
+```
+
+```koneko
+>>> , :mycall [ f . f ] def ; TODO: primitive redundancy?
+>>> [ 1 2 + ] call
+3
+>>> [ 3 + ] mycall
+6
+```
+
+... TODO ...
+
+
diff --git a/koneko.cabal b/koneko.cabal
new file mode 100644
--- /dev/null
+++ b/koneko.cabal
@@ -0,0 +1,148 @@
+cabal-version: 2.4
+
+name: koneko
+
+-- The package version. See the Haskell package versioning policy (PVP)
+-- for standards guiding when and how versions should be incremented.
+-- https://wiki.haskell.org/Package_versioning_policy
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 0.0.2
+
+-- A short (one-line) description of the package.
+synopsis: a concatenative not-quite-lisp for kittens
+
+-- A longer description of the package.
+-- description:
+
+-- URL for the project homepage or repository.
+homepage: https://github.com/obfusk/koneko
+
+-- The license under which the package is released.
+license: GPL-3.0-or-later
+
+-- The file containing the license text.
+license-file: LICENSE.GPLv3
+
+-- The package author(s).
+author: Felix C. Stegerman
+
+-- An email address to which users can send suggestions, bug reports, and
+-- patches.
+maintainer: flx@obfusk.net
+
+-- A copyright notice.
+-- copyright:
+
+category: Compilers/Interpreters
+
+build-type: Simple
+
+-- Extra files to be distributed with the package, such as examples or a
+-- README.
+extra-source-files: CHANGELOG.md, README.md, LICENSE.LGPLv3.STDLIB,
+ doc/*.md
+
+data-files: lib/*.knk nya/*.cat
+
+
+common deps
+ -- Other library packages from which modules are imported.
+ build-depends:
+ -- included w/ ghc:
+ array, base >=4.9 && <4.15, bytestring, deepseq, directory,
+ filepath, text,
+ -- included w/ haskell-platform:
+ async, random, split, unordered-containers >=0.2.9.0, vector,
+ -- separate packages:
+ aeson <2.0.0.0, cmdargs, hashtables, megaparsec ==7.0.* || ==8.0.*,
+ regex-pcre >=0.94.0.0, safe, silently
+
+ -- Directories containing source files.
+ hs-source-dirs: src
+
+ if os(windows)
+ hs-source-dirs: src-win
+ else
+ hs-source-dirs: src-unix
+ build-depends:
+ -- included w/ ghc:
+ unix
+
+ -- Base language which the package is written in.
+ default-language: Haskell2010
+
+ ghc-options: -Wall -fwarn-incomplete-uni-patterns
+
+
+library
+ import: deps
+
+ -- Modules exported by the library.
+ exposed-modules:
+ Koneko.Bltn
+ Koneko.Data
+ Koneko.Eval
+ Koneko.IO
+ Koneko.JSON
+ Koneko.Math
+ Koneko.Misc
+ Koneko.Prim
+ Koneko.Prld
+ Koneko.Read
+ Koneko.Repl
+ Koneko.Test
+ Koneko_utils
+ Paths_koneko
+
+ -- Modules included in this library but not exported.
+ -- other-modules:
+
+ autogen-modules:
+ Paths_koneko
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+
+executable koneko
+ import: deps
+
+ -- .hs or .lhs file containing the Main module.
+ main-is: Main.hs
+
+ -- Modules included in this executable, other than Main.
+ other-modules:
+ Koneko.Bltn
+ Koneko.Data
+ Koneko.Eval
+ Koneko.IO
+ Koneko.JSON
+ Koneko.Math
+ Koneko.Misc
+ Koneko.Prim
+ Koneko.Prld
+ Koneko.Read
+ Koneko.Repl
+ Koneko.Test
+ Koneko_utils
+ Paths_koneko
+
+ autogen-modules:
+ Paths_koneko
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ ghc-options: -threaded -rtsopts -with-rtsopts=-N
+
+
+test-suite doctests
+ import: deps
+ type: exitcode-stdio-1.0
+ main-is: doctests.hs
+ build-depends: doctest
+ hs-source-dirs: test
+ ghc-options: -threaded
+
diff --git a/lib/_test.knk b/lib/_test.knk
new file mode 100644
--- /dev/null
+++ b/lib/_test.knk
@@ -0,0 +1,2 @@
+"loading module _test..." say!
+:_test [ :x 1 def, :y 2 def ] defmodule
diff --git a/lib/prelude.knk b/lib/prelude.knk
new file mode 100644
--- /dev/null
+++ b/lib/prelude.knk
@@ -0,0 +1,2507 @@
+; -- ; {{{1
+;
+; File : prelude.knk
+; Maintainer : Felix C. Stegerman
+; Date : 2022-02-12
+;
+; Copyright : Copyright (C) 2022 Felix C. Stegerman
+; Version : v0.0.1
+; License : LGPLv3+
+;
+; -- ; }}}1
+
+:__prld__ __defmodule__[
+
+; -- TODO --
+;
+; * WIP: slicing, string formatting, functor, monad, tuples
+; * more functions!
+; * refactor!
+;
+; * (chunked) sequences; map, each, iterate, zip, ...
+;
+; * cond1, cond=, is-nan?
+; * range-elem?'; seq str & dict; ++, ->list
+; * unzip, scan*; split*; init; sort-by; update-with
+; * I/O; math; ...
+;
+; * div/mod vs quot/rem
+;
+; * improve docs generation!
+;
+; --
+
+; -- Aliases for Primitives -- ; {{{1
+
+:def '__def__ __def__
+
+:call '__call__ def
+:apply '__apply__ def
+:apply-dict '__apply-dict__ def
+
+:if '__if__ def
+
+:defmulti '__defmulti__ def
+:defrecord '__defrecord__ def
+
+:=> '__=>__ def
+:dict '__dict__ def
+
+:puts! '__puts!__ def
+:ask! '__ask!__ def
+
+:type '__type__ def
+:callable? '__callable?__ def
+:function? '__function?__ def
+
+:defmodule '__defmodule__ def
+:import '__import__ def
+:import-from '__import-from__ def
+
+:= '__=__ def
+:not= '__not=__ def
+:< '__<__ def
+:<= '__<=__ def
+:> '__>__ def
+:>= '__>=__ def
+:<=> '__<=>__ def
+
+:eq '__eq__ def
+:neq '__neq__ def
+:lt '__lt__ def
+:lte '__lte__ def
+:gt '__gt__ def
+:gte '__gte__ def
+:cmp '__cmp__ def
+
+:abs '__abs__ def
+:trunc '__trunc__ def
+:round '__round__ def
+:ceil '__ceil__ def
+:floor '__floor__ def
+
+:int->float '__int->float__ def
+:record->dict '__record->dict__ def
+
+:record-type '__record-type__ def
+:record-vals '__record-values__ def
+:record-values '__record-values__ def
+:record-type-name '__record-type-name__ def
+:record-type-fields '__record-type-fields__ def
+
+:fail '__fail__ def
+:try '__try__ def
+
+:rx-match '__rx-match__ def
+:rx-sub '__rx-sub__ def
+
+:par '__par__ def
+:sleep '__sleep__ def
+
+ ; }}}1
+
+; -- Stack Shuffling -- ; {{{1
+
+; swap top 2 values
+;
+; >>> , 1 2 s!
+; --- STACK ---
+; 2
+; 1
+; --- END ---
+; >>> , swap s!
+; --- STACK ---
+; 1
+; 2
+; --- END ---
+
+:swap [ x y . 'y 'x ] def ; ⇔ '__swap__ ; bltn
+:>< 'swap def
+
+; rotate top 3 values
+;
+; >>> , 1 2 3 rot> s!
+; --- STACK ---
+; 2
+; 1
+; 3
+; --- END ---
+; >>> , [ x y z . 'z 'x 'y ] def ; ⇔ [ [] $ 2dip ]
+:>> , 1 2 3 4 rot4> s!
+; --- STACK ---
+; 3
+; 2
+; 1
+; 4
+; --- END ---
+; >>> , [ w x y z . 'z 'w 'x 'y ] def
+:>> , 42 dup s!
+; --- STACK ---
+; 42
+; 42
+; --- END ---
+; >>> c!
+; *** STACK CLEARED ***
+; >>> , 1 2 2dup s!
+; --- STACK ---
+; 2
+; 1
+; 2
+; 1
+; --- END ---
+; >>> ( 1 2 3 3dup )
+; ( 1 2 3 1 2 3 )
+
+ :dup [ x . 'x 'x ] def ; bltn
+:2dup [ x y . 'x 'y 'x 'y ] def ; ⇔ [ over over ]
+:3dup [ 2over over2 ] def
+
+; remove top value(s)
+;
+; >>> nil
+; nil
+; >>> drop
+; >>> drop
+; *** ERROR: stack underflow
+; >>> 42 37 2drop
+; >>> 1 2 3 3drop
+
+ :drop [ _ . ] def ; bltn
+:2drop [ _ _ . ] def ; ⇔ [ drop drop ]
+:3drop [ _ _ _ . ] def
+
+; drop value immediately preceding the top
+;
+; >>> , 42 37 nip s!
+; --- STACK ---
+; 37
+; --- END ---
+
+:nip [ _ y . 'y ] def ; ⇔ [ 'drop dip ]
+
+; copy value(s) immediately preceding the top "over" the top
+;
+; >>> , 1 2 over s!
+; --- STACK ---
+; 1
+; 2
+; 1
+; --- END ---
+; >>> c!
+; *** STACK CLEARED ***
+; >>> , 1 2 3 2over s!
+; --- STACK ---
+; 2
+; 1
+; 3
+; 2
+; 1
+; --- END ---
+
+ :over [ x y . 'x 'y 'x ] def ; ⇔ [ 'dup dip swap ]
+:2over [ x y z . 'x 'y 'z 'x 'y ] def ; ⇔ [ over2 over2 ]
+
+; copy value "over" the topmost 2
+;
+; >>> , 1 2 3 over2 s!
+; --- STACK ---
+; 1
+; 3
+; 2
+; 1
+; --- END ---
+
+:over2 [ x y z . 'x 'y 'z 'x ] def ; ⇔ [ 'over dip swap ]
+
+ ; }}}1
+
+; -- Combinators -- ; {{{1
+
+; partial application & function composition
+;
+; >>> , 1 '+ $ ; ⇔ [ 1 + ]
+; >>> 2 swap call
+; 3
+; >>> 2, 3 4 [ + * ] 2$, call
+; 14
+; >>> 1, 2 3 4 [ + + + ] 3$, call
+; 10
+; >>> :foo [] $ call ; [] $ ⇔ .[ '1 ]
+; :foo
+;
+; >>> , [ 1 + ] [ 3 * ] @
+; >>> 2 swap call
+; 9
+; >>> [ 2 * ] [ 1 + ] % call ; % ⇔ swap @
+; 20
+;
+; >>> , 2 '-
+; >>> , 1 $$ ; ⇔ [ f . 1 f ]
+; >>> call
+; 1
+; >>> 2 [ + * ], 3 4 2$$, call
+; 14
+; >>> 1 [ + + + ], 2 3 4 3$$, call
+; 10
+
+ :$ '[ '1 .2 ] def ; bltn
+:2$ '[ '1 '2 .3 ] def ; TODO
+:3$ '[ '1 '2 '3 .4 ] def
+
+:@ '[ .1 .2 ] def ; bltn
+:% '[ .2 .1 ] def ; bltn
+
+ :$$ '[ f . '1 f ] def
+:2$$ '[ f . '1 '2 f ] def
+:3$$ '[ f . '1 '2 '3 f ] def
+
+; remove top value(s), call function, restore value(s)
+;
+; >>> , 1 2 'dup dip s!
+; --- STACK ---
+; 2
+; 1
+; 1
+; --- END ---
+; >>> c!
+; *** STACK CLEARED ***
+; >>> , 1 2 3 4 '- 2dip s!
+; --- STACK ---
+; 4
+; 3
+; -1
+; --- END ---
+; >>> c!
+; *** STACK CLEARED ***
+; >>> , 1 2 3 4 'neg 3dip s!
+; --- STACK ---
+; 4
+; 3
+; 2
+; -1
+; --- END ---
+
+ :dip [ x f . f 'x ] def ; bltn
+:2dip [ x y f . f 'x 'y ] def ; ⇔ [ 'dip $ dip ]
+:3dip [ '2dip $ dip ] def
+
+; copy top value(s), call function, push value(s)
+;
+; >>> , 2 [ dup * ] keep s!
+; --- STACK ---
+; 2
+; 4
+; --- END ---
+; >>> c!
+; *** STACK CLEARED ***
+; >>> , 2 3 '* 2keep s!
+; --- STACK ---
+; 3
+; 2
+; 6
+; --- END ---
+
+ :keep [ over 'call dip ] def ; ⇔ [ x f . 'x f 'x ]
+:2keep [ 2over 'call 2dip ] def ; ⇔ [ '2dup dip 2dip ]
+
+; call multiple functions on one value
+;
+; >>> , 35 [ 2 + ] [ 7 + ] bi s!
+; --- STACK ---
+; 42
+; 37
+; --- END ---
+; >>> c!
+; *** STACK CLEARED ***
+; >>> , 2 [ 1 + ] [ 2 * ] [ 3 - ] tri s!
+; --- STACK ---
+; -1
+; 4
+; 3
+; --- END ---
+;
+; >>> ( 2 ( [ 1 + ] [ 2 * ] [ 3 - ] ) mlt )
+; ( 3 4 -1 )
+;
+;
+; >>> 42 'num? 'pos? bi-and
+; #t
+; >>> -1 'num? 'pos? bi-and
+; #f
+; >>> nil 'num? 'pos? bi-and ; "short-circuits"
+; #f
+; >>> nil 'num? 'pos? bi and ; oops
+; *** ERROR: types nil and int are not comparable
+; >>> nil 'nil? 'pos? bi-or
+; #t
+; >>> nil 'nil? 'pos? bi or
+; *** ERROR: types nil and int are not comparable
+
+:bi [ x f g . 'x f 'x g ] def ; ⇔ [ 'keep dip call ]
+:tri [ x f g h . 'x f 'x g 'x h ] def ; ⇔ [ 'keep 2dip bi ]
+
+:mlt [ swap $$ each ] def
+
+:bi-and [ x p1? p2? . [ 'x p1? ] [ 'x p2? ] and' ] def
+:bi-or [ x p1? p2? . [ 'x p1? ] [ 'x p2? ] or' ] def
+
+; call one function on each of multiple values
+;
+; >>> 2 3 [ dup * ] bi$ +
+; 13
+; >>> c!
+; *** STACK CLEARED ***
+; >>> , 2 3 4 [ dup * ] tri$ s!
+; --- STACK ---
+; 16
+; 9
+; 4
+; --- END ---
+;
+; >>> ( ( 2 3 4 ) [ dup * ] mlt$ ) ; mlt$ ⇔ each
+; ( 4 9 16 )
+;
+;
+; >>> ( 0 2 4 ) 'even? all?
+; #t
+; >>> ( 37 42 ) 'even? any?
+; #t
+;
+;
+; >>> -1 nil 'pos? bi$-and ; "short-circuits"
+; #f
+; >>> 42 nil 'pos? bi$-or
+; #t
+; >>> 42 nil 'pos? bi$ or ; oops
+; *** ERROR: types nil and int are not comparable
+
+:bi$ [ x y f . 'x f 'y f ] def ; ⇔ [ dup bi~ ]
+:tri$ [ x y z f . 'x f 'y f 'z f ] def ; ⇔ [ 2dup tri~ ]
+
+:mlt$ [ each ] def
+
+:all? [ p? . [ #t ] [ >< p? dup [ drop 'p? all? ] 'nip if ] ^seq ] def
+:any? [ p? . [ #f ] [ >< p? dup 'nip [ drop 'p? any? ] if ] ^seq ] def
+
+:bi$-and [ x y p? . [ 'x p? ] [ 'y p? ] and' ] def
+:bi$-or [ x y p? . [ 'x p? ] [ 'y p? ] or' ] def
+
+; call multiple functions on their "paired" value
+;
+; >>> , 4 9 [ 2 + ] [ 3 div ] bi~ s!
+; --- STACK ---
+; 3
+; 6
+; --- END ---
+; >>> c!
+; *** STACK CLEARED ***
+; >>> ( 1 2 3 :x :y :z '[ '1 swap => ] tri$ tri~ )
+; ( :x 1 => :y 2 => :z 3 => )
+;
+; >>> ( ( 1 2 3 ) ( :x :y :z ) '[ '1 swap => ] map mlt~ )
+; ( :x 1 => :y 2 => :z 3 => )
+
+:bi~ [ x y f g . 'x f 'y g ] def ; ⇔ [ 'dip dip call ]
+:tri~ [ x y z f g h . 'x f 'y g 'z h ] def
+
+:mlt~ [ 'call zip [] each ] def
+
+; TODO: mlt*, 2mlt, 2mlt$, 2mlt~, ...
+
+; call multiple functions on each of multiple values
+;
+; >>> , 2 3 [ dup * ] 'neg bi* s!
+; --- STACK ---
+; -3
+; -2
+; 9
+; 4
+; --- END ---
+
+:bi* [ [ 'bi$ $ 2keep ] dip bi$ ] def
+
+; call multiple functions on two values
+;
+; >>> , 1 2 '+ '- 2bi s!
+; --- STACK ---
+; -1
+; 3
+; --- END ---
+; >>> c!
+; *** STACK CLEARED ***
+; >>> , 7 2 '+ '- 'div 2tri s!
+; --- STACK ---
+; 3
+; 5
+; 9
+; --- END ---
+
+:2bi [ '2keep dip call ] def
+:2tri [ '2keep 2dip 2bi ] def
+
+; call one function on each of multiple pairs of values
+;
+; >>> , :x 1 :y 2 '=> 2bi$ s!
+; --- STACK ---
+; :y 2 =>
+; :x 1 =>
+; --- END ---
+; >>> c!
+; *** STACK CLEARED ***
+; >>> , :x :y 1 2 '=> 2bi$' s!
+; --- STACK ---
+; :y 2 =>
+; :x 1 =>
+; --- END ---
+
+:2bi$ [ dup 2bi~ ] def
+:2bi$' [ 'swap 2dip 2bi$ ] def
+
+; call multiple functions on their "paired" pair of values
+;
+; >>> , 1 2 3 4 '+ '- 2bi~ s!
+; --- STACK ---
+; -1
+; 3
+; --- END ---
+; >>> c!
+; *** STACK CLEARED ***
+; >>> , 1 3 2 4 '+ '- 2bi~' s!
+; --- STACK ---
+; -1
+; 3
+; --- END ---
+
+:2bi~ [ '2dip dip call ] def
+:2bi~' [ 'swap 3dip 2bi~ ] def
+
+; partially apply multiple functions to one value
+;
+; >>> 5 [ 37 + ] [ 37 - ] ~pos
+; 42
+; >>> 5 37 '+ '- $bi ~pos
+; 42
+
+:$bi [ x f g . 'x 'f $ 'x 'g $ ] def ; ⇔ [ [ '$ $ ] bi$ bi ]
+
+; partially apply "first" or "second" function to value
+;
+; >>> 5 'neg [ 37 + ] ~neg
+; 42
+; >>> 5 37 'neg '+ $snd ~neg
+; 42
+;
+; >>> 5 37 '+ 'neg '$ dip ~pos
+; 42
+; >>> 5 37 '+ 'neg $fst ~pos
+; 42
+
+:$fst [ '$ dip ] def
+:$snd [ x f g . 'f 'x 'g $ ] def
+
+ ; }}}1
+
+; -- Conditionals, Logic & Order -- ; {{{1
+
+; conditional expression that takes two values (instead of functions)
+;
+; foo bar ? ≈ [ foo ] [ bar ] if
+; foo bar ? ⇔ foo [] $ bar [] $ if
+;
+; NB: foo and bar are always evaluated.
+;
+; >>> #t 42 37 ?
+; 42
+
+:? [ '[ '1 ] bi$ if ] def
+
+; conditional w/ implicit "else branch" (that drops values -- if
+; necessary -- to match the arity of the "if branch")
+;
+; >>> 1 2 = [ "oh no!" say! ] when ; -0 +0 = 0
+; >>> 1 1 = [ "good!" say! ] when
+; good!
+; >>> , 42 dup 2 mod 0 = [ 2 div ] when s! ; -1 +1 = 0
+; --- STACK ---
+; 21
+; --- END ---
+; >>> c!
+; *** STACK CLEARED ***
+; >>> 1 2 2dup = '+ when1 ; -2 +1 = 1
+; 1
+; >>> 2 2 2 2dup = [ + * ] when2 ; -3 +1 = 2
+; 8
+
+:when [ [] if ] def
+:when1 [ 'drop if ] def
+:when2 [ '2drop if ] def
+
+; [ ... ] unless ⇔ not [ ... ] when
+;
+; >>> 1 1 = [ "oh no!" say! ] unless ; -0 +0 = 0
+; >>> 1 2 = [ "good!" say! ] unless
+; good!
+; >>> 2 2 2dup = '+ unless1 ; -2 +1 = 1
+; 2
+; >>> 1 2 3 2dup = [ + * ] unless2 ; -3 +1 = 2
+; 5
+
+:unless [ [] swap if ] def
+:unless1 [ 'drop swap if ] def
+:unless2 [ '2drop swap if ] def
+
+; predicate "branch"
+;
+; dup p? [ foo ] [ bar ] if ⇔ [ foo ] [ bar ] 'p? ~?
+;
+; >>> , :collatz [
+; ... [ [ 2 div ] [ 3 * 1 + ] 'even? ~? ]
+; ... iterate [ 1 not= ] take-while ( 1 ) ++
+; ... ] def
+; >>> 19 collatz ->list
+; ( 19 58 29 88 44 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1 )
+
+:~? [ 'dup % 2dip if ] def ; bltn
+
+; bool, logical inverse, conjunction & disjunction
+;
+; NB: see also bi-and, bi-or, bi$-and, bi$-or.
+;
+; NB: "and" and "or" return one of their operands (which are tested
+; for "truthyness", but do not need to be bools). They also cannot
+; "short-circuit" because they operate on the stack, not on
+; expressions.
+;
+; >>> 5 bool
+; #t
+; >>> 5 not
+; #f
+; >>> nil not
+; #t
+; >>> nil 5 or
+; 5
+; >>> nil 5 and
+; nil
+; >>> 2 3 or
+; 2
+; >>> 2 3 and
+; 3
+;
+; >>> [ nil ] [ "oops" fail ] and' ; "short-circuits"
+; nil
+; >>> [ 42 ] [ "oops" fail ] or'
+; 42
+
+:bool [ not not ] def
+:not [ #f #t ? ] def
+:and [ over ? ] def
+:or [ 'dup dip ? ] def
+
+:and' [ f g . f dup [ drop g ] [] if ] def
+:or' [ f g . f dup [] [ drop g ] if ] def
+
+; comparison "branch"
+;
+; >>> 41 'inc 'dec 41 ~[=]
+; 42
+; >>> 41 'dec 'inc 41 ~[not=]
+; 42
+; >>> 41 'inc 'dec 99 ~[<]
+; 42
+; >>> 43 'inc 'dec 37 ~[<=]
+; 42
+; >>> 41 'inc 'dec 37 ~[>]
+; 42
+; >>> 41 'inc 'dec 41 ~[>=]
+; 42
+;
+; >>> 42 37 '- '* '+ ~<=>
+; 79
+; >>> 37 [ :< ] [ := ] [ :> ] 42 ~[<=>] nip
+; :<
+;
+; NB: ~<=> leaves both operands, ~[<=>] only the "left".
+
+:~[=] [ '= $ ~? ] def
+:~[not=] [ 'not= $ ~? ] def
+:~[<] [ '< $ ~? ] def
+:~[<=] [ '<= $ ~? ] def
+:~[>] [ '> $ ~? ] def
+:~[>=] [ '>= $ ~? ] def
+
+:~<=> [ f g h . 2dup <=> [ drop g ] [ 0 < 'f 'h if ] 0 ~[=] ] def
+:~[<=>] [ [] $ 3dip [ 'drop % ] tri$ ~<=> ] def
+
+; alternative comparison "branch"
+;
+; >>> 41.0 'inc 'dec 41 ~[eq]
+; 42.0
+; >>> 41.0 'dec 'inc 41 ~[neq]
+; 42.0
+; >>> 41.0 'inc 'dec 99 ~[lt]
+; 42.0
+; >>> 43.0 'inc 'dec 37 ~[lte]
+; 42.0
+; >>> 41.0 'inc 'dec 37 ~[gt]
+; 42.0
+; >>> 41.0 'inc 'dec 41 ~[gte]
+; 42.0
+;
+; >>> 42 37.0 '- '* '+ ~cmp
+; 79.0
+; >>> 37 [ :< ] [ := ] [ :> ] 42.0 ~[cmp] nip
+; :<
+;
+; NB: ~cmp leaves both operands, ~[cmp] only the "left".
+
+:~[eq] [ 'eq $ ~? ] def
+:~[neq] [ 'neq $ ~? ] def
+:~[lt] [ 'lt $ ~? ] def
+:~[lte] [ 'lte $ ~? ] def
+:~[gt] [ 'gt $ ~? ] def
+:~[gte] [ 'gte $ ~? ] def
+
+:~cmp [ f g h . 2dup cmp [ drop g ] [ neg? 'f 'h if ] 0 ~[eq] ] def
+:~[cmp] [ [] $ 3dip [ 'drop % ] tri$ ~cmp ] def
+
+; minimum & maximum
+;
+; >>> 1 2 min
+; 1
+; >>> -1 -2 max
+; -1
+;
+; >>> 2 1.0 min
+; 2
+; >>> 2 1.0 min'
+; 1.0
+; >>> 2 1.0 max'
+; 2
+
+:min [ '<= min-by ] def
+:max [ '>= max-by ] def
+
+:min' [ 'lte min-by ] def
+:max' [ 'gte max-by ] def
+
+:min-by [ f . 2dup f 'drop 'nip if ] def
+:max-by [ f . 2dup f 'drop 'nip if ] def
+
+; conditional expression
+;
+; Takes a value and a list of tests and exprs. It evaluates each test
+; one at a time: functions are predicates and are called (with the
+; value pushed onto the stack); the result -- or the test itself if
+; not a function -- is tested for truthiness. If the test passes, its
+; corresponding expr is returned and called (if it's a block).
+;
+; >>> , :temp [
+; ... [ show " is " ++ ]
+; ... [ ( [ 15 < ] "cold!" [ 25 > ] "warm!" :else "ok!" ) cond1 ]
+; ... bi ++ say!
+; ... ] def
+; >>> 10 temp
+; 10 is cold!
+; >>> 20 temp
+; 20 is ok!
+; >>> 30 temp
+; 30 is warm!
+
+ :cond1 [ _cond1 dup block? 'call when ] def ; TODO
+ :_cond1 [ cons '_&cond1 apply ] def
+:_&cond1 [ x p? f & .
+ 'x 'p? 'call 'nip 'function? ~? [ 'f ] [ 'x '& _cond1 ] if
+ ] def
+
+; TODO: cond=, ...
+
+; combined "branch"
+;
+; >>> -1 [ :pos ] [ :neg ] [ :zero ] ( '~pos '~neg ) ~>> nip
+; :neg
+;
+; >>> , :~type [ .[ type '1 = ] ~? ] def
+; >>> , :~strint [ ( [ :str ~type ] [ :int ~type ] ) ~>> ] def
+; >>> , :f [ [ "bar" ++ ] [ 5 + ] [ drop :oops ] ~strint ] def
+; >>> "foo" f
+; "foobar"
+; >>> 37 f
+; 42
+; >>> nil f
+; :oops
+
+:~>> [ reverse _~>> ] def
+:_~>> [ 'call [ f ft . .[ '1 '2 f ] 'ft _~>> ] ^seq ] def
+
+ ; }}}1
+
+; -- Arithmetic -- ; {{{1
+
+; NB: see also math.
+
+; addition, subtraction & multiplication
+;
+; NB: when mixing ints and floats, ints are coerced to floats and may
+; lose precision.
+;
+; >>> 1 2 +
+; 3
+; >>> 4 3 -
+; 1
+; >>> 6 7 *
+; 42
+; >>> 1.0 2.0 +
+; 3.0
+; >>> 4.0 3 -
+; 1.0
+; >>> 6 7.0 *
+; 42.0
+
+:+ ( :int :int ) [ __int+__ ] defmulti
+:+ ( :float :float ) [ __float+__ ] defmulti
+:+ ( :int :float ) [ 'int->float dip + ] defmulti
+:+ ( :float :int ) [ int->float + ] defmulti
+
+:- ( :int :int ) [ __int-__ ] defmulti
+:- ( :float :float ) [ __float-__ ] defmulti
+:- ( :int :float ) [ 'int->float dip - ] defmulti
+:- ( :float :int ) [ int->float - ] defmulti
+
+:* ( :int :int ) [ __int*__ ] defmulti
+:* ( :float :float ) [ __float*__ ] defmulti
+:* ( :int :float ) [ 'int->float dip * ] defmulti
+:* ( :float :int ) [ int->float * ] defmulti
+
+; negation (additive inverse)
+;
+; >>> 10 neg
+; -10
+; >>> -10 neg
+; 10
+; >>> 3.14 neg
+; -3.14
+
+:neg '__neg__ def
+
+; division & modulo
+;
+; >>> 1.0 2.0 / ; float division
+; 0.5
+; >>> 8 3 div ; int division
+; 2
+; >>> 8 3 mod
+; 2
+;
+; >>> 8.0 3 floor/ ; floor division
+; 2
+; >>> -8 3.0 floor/
+; -3
+
+:/ '__float/__ def
+:div '__div__ def
+:mod '__mod__ def
+
+:floor/ ( :int :int ) [ div ] defmulti
+:floor/ ( :float :float ) [ / floor ] defmulti
+:floor/ ( :int :float ) [ 'int->float dip floor/ ] defmulti
+:floor/ ( :float :int ) [ int->float floor/ ] defmulti
+
+; common predicates
+;
+; >>> 10 3 div?
+; #f
+; >>> 42 7 div?
+; #t
+; >>> ( 2 3 4 ) 'even? filterl
+; ( 2 4 )
+; >>> ( 1 2 3 ) 'odd? filterl
+; ( 1 3 )
+;
+; >>> , ( -1 -1.1 0 0.0 1 1.1 )
+; >>> dup 'neg? filterl
+; ( -1 -1.1 )
+; >>> drop dup 'zero? filterl
+; ( 0 0.0 )
+; >>> drop dup 'pos? filterl
+; ( 1 1.1 )
+
+:div? [ mod 0 = ] def
+:even? [ 2 div? ] def
+:odd? [ even? not ] def
+
+:neg? [ 0 lt ] def
+:zero? [ 0 eq ] def
+:pos? [ 0 gt ] def
+
+; increment & decrement
+;
+; >>> 41 inc
+; 42
+; >>> dec
+; 41
+
+:inc [ 1 + ] def
+:dec [ 1 - ] def
+
+ ; }}}1
+
+; -- Strings & Characters -- ; {{{1
+
+; NB: see also "Regexes".
+
+; conversion between char (i.e. string of length 1) & int
+; (representing a unicode codepoint)
+;
+; >>> "猫" ord
+; 29483
+; >>> 0x732b chr
+; "猫"
+
+:ord '.ord def
+:chr '__chr__ def
+
+; is char (i.e. str of length 1)
+;
+; >>> ( "猫" "foo" "" 42 ) 'char? filterl
+; ( "猫" )
+
+:char? [ 'str? [ len 1 = ] bi-and ] def
+
+; convert to readable str
+;
+; >>> 42 show
+; "42"
+; >>> 0x20 show
+; "32"
+; >>> "foo" show
+; "\"foo\""
+; >>> :foo show
+; ":foo"
+; >>> x: 42 show
+; ":x 42 =>"
+; >>> { x: [1-), y: ( 1 nil :x ) } show
+; "{ :x 1 [m-) =>, :y ( 1 nil :x ) => }"
+
+:show ( :pair ) [ [ 'show bi$ " " ++sep++ " =>" ++ ] ^pair ] defmulti
+:show ( :list ) [ [ "()" ] [ "( " " " " )" _showseq ] ~seq ] defmulti
+:show ( :dict ) [ [ "{ }" ] [ "{ " ", " " }" _showseq ] ~seq ] defmulti
+:show ( :_ ) [ '_showrec '__show__ 'record? ~? ] defmulti
+
+:_showrec [ [ record-type record-type-name __show__ 1 [i-) ]
+ [ record->dict show ] bi ++ ] def
+:_showseq [ b d a . 'show map 'b swap 'd join-with 'a ++ ++ ] def
+
+; convert to str
+;
+; >>> "foo" show
+; "\"foo\""
+; >>> "foo" ->str
+; "foo"
+;
+; >>> :foo show
+; ":foo"
+; >>> :foo ->str
+; ":foo"
+; >>> :foo kwd->str
+; "foo"
+;
+; >>> 42 ->str
+; "42"
+
+:->str ( :str ) [ ] defmulti
+:->str ( :_ ) [ show ] defmulti
+
+:kwd->str [ show [ 2 -1 ] [ 1 nil ] [ "\"" ends-with? ] ~? [i-j) ] def
+
+; join a sequence of strings (separated by a separator)
+;
+; >>> "foobar" ->list
+; ( "f" "o" "o" "b" "a" "r" )
+; >>> join
+; "foobar"
+; >>> ( "Hello" "World" ) ", " join-with
+; "Hello, World"
+;
+; >>> "foo" "bar" " & " ++sep++
+; "foo & bar"
+
+:join [ "" join-with ] def ; TODO
+:join-with [ s . [ "" ] [ >< [ 's ++sep++ ] foldl ] ^seq ] def
+:++sep++ [ >< ++ ++ ] def
+
+; case conversion
+;
+; >>> "foo" upper-case
+; "FOO"
+; >>> "BAR" lower-case
+; "bar"
+
+:lower-case '.lower def
+:upper-case '.upper def
+
+; trimming whitespace
+;
+; >>> " foo " trim
+; "foo"
+; >>> " foo " triml
+; "foo "
+; >>> " foo " trimr
+; " foo"
+
+:trim '.trim def
+:triml '.triml def
+:trimr '.trimr def
+
+; prefix & suffix predicates
+;
+; >>> "foo" "f" starts-with? ; prefix
+; #t
+; >>> "bar" "ar" ends-with? ; suffix
+; #t
+;
+; >>> "foobar" "oba" elem? ; infix
+; #t
+
+:starts-with? [ swap !starts-with? ] def
+:ends-with? [ swap !ends-with? ] def
+
+ ; }}}1
+
+; -- Nil, Num, Pair & Tuples -- ; {{{1
+
+; nil "branch"
+;
+; >>> , :f [ [ "nil!" say! ] [ type show say! ] ~nil ] def
+; >>> nil f
+; nil!
+; >>> 42 f
+; :int
+;
+; >>> ( 1 ) 'rest ~> 'first ~> [ 1 + ] ~>
+; nil
+; >>> ( 1 2 ) 'rest ~> 'first ~> [ 1 + ] ~>
+; 3
+; >>> ( 3 4 ) ( 'rest 'first [ 1 + ] ) ~~>
+; 5
+
+:~nil [ [ 'drop % ] dip 'nil? ~? ] def ; bltn
+:~> [ [ nil ] swap ~nil ] def
+:~~> [ [ .[ .1 '2 ~~> ] ~> ] ^seq' ] def
+
+; "convert" to nil: turn "empty"/"zero" values into (falsy) nil
+;
+; >>> ( "foo" "" 42 0 ( 1 2 3 ) () ) '->nil mapl
+; ( "foo" nil 42 nil ( 1 2 3 ) nil )
+
+:->nil ( :nil ) [ ] defmulti
+:->nil ( :bool ) [ #t nil ? ] defmulti
+
+:->nil ( :int ) [ [ drop nil ] [] ~zero ] defmulti
+:->nil ( :_ ) [ [ nil ] [] ~seq ] defmulti
+
+; is int or float?
+;
+; >>> 1 num?
+; #t
+; >>> 3.14 num?
+; #t
+; >>> () num?
+; #f
+
+:num? [ 'int? 'float? bi-or ] def
+
+; TODO: is-nan?
+
+; number "branch"
+;
+; >>> 0 [ " negative" ] [ " non-negative" ] ~neg 'show dip ++ say!
+; 0 non-negative
+; >>> 0 [ " zero" ] [ " non-zero" ] ~zero 'show dip ++ say!
+; 0 zero
+; >>> 0 [ " positive" ] [ " non-positive" ] ~pos 'show dip ++ say!
+; 0 non-positive
+;
+; >>> 4 [ :neg ] [ :zero ] [ :pos ] ~num nip
+; :pos
+
+:~neg [ 0 ~[lt] ] def
+:~zero [ 0 ~[eq] ] def
+:~pos [ 0 ~[gt] ] def
+
+:~num [ 0 ~[cmp] ] def
+
+; pair "pattern match" & key/value
+;
+; >>> , x: 42 'swap ^pair, s!
+; --- STACK ---
+; :x
+; 42
+; --- END ---
+; >>> c!
+; *** STACK CLEARED ***
+; >>> , y: 37 'val 'key bi, s!
+; --- STACK ---
+; :y
+; 37
+; --- END ---
+
+:^pair [ [ 'key 'val bi ] dip call ] def
+
+:key '.key def
+:val '.value def
+
+; tuples (WIP)
+;
+; >>> 1 2 2T
+; T( 1 2 )
+; >>> dup .1st
+; 1
+; >>> drop .2nd
+; 2
+;
+; >>> T( 1 2 3 4 5 )
+; T( 1 2 3 4 5 )
+; >>> .5th
+; 5
+
+:T() [ 0T ] def
+:T [ & . '& '_T '& len get^ apply ] def ; TODO
+
+:0T ( ) defrecord
+:1T ( :1st ) defrecord
+:2T ( :1st :2nd ) defrecord
+:3T ( :1st :2nd :3rd ) defrecord
+:4T ( :1st :2nd :3rd :4th ) defrecord
+:5T ( :1st :2nd :3rd :4th :5th ) defrecord
+
+:_T ( '0T '1T '2T '3T '4T '5T ) def
+
+:show ( :0T ) [ tuple-show ] defmulti
+:show ( :1T ) [ tuple-show ] defmulti
+:show ( :2T ) [ tuple-show ] defmulti
+:show ( :3T ) [ tuple-show ] defmulti
+:show ( :4T ) [ tuple-show ] defmulti
+:show ( :5T ) [ tuple-show ] defmulti
+
+:len ( :0T ) [ drop 0 ] defmulti
+:len ( :1T ) [ drop 1 ] defmulti
+:len ( :2T ) [ drop 2 ] defmulti
+:len ( :3T ) [ drop 3 ] defmulti
+:len ( :4T ) [ drop 4 ] defmulti
+:len ( :5T ) [ drop 5 ] defmulti
+
+:->list ( :0T ) [ vals ] defmulti
+:->list ( :1T ) [ vals ] defmulti
+:->list ( :2T ) [ vals ] defmulti
+:->list ( :3T ) [ vals ] defmulti
+:->list ( :4T ) [ vals ] defmulti
+:->list ( :5T ) [ vals ] defmulti
+
+:tuple-show [ vals show "T" swap ++ ] def
+
+ ; }}}1
+
+; -- Sequences, Lists & Ranges -- ; {{{1
+
+; NB: inclusive; infinite if stop is nil.
+:Range ( :start :stop :step ) defrecord
+
+:show ( :Range ) [ [ m n s . { f: [ show " " ++ ] } let[ (
+ 'm f
+ 'n [ "" "" ")" ] [ f "n" "]" ] ~nil
+ 's [ drop "" "" ] [ f ":s" ] 1 ~[eq]
+ float tri$ ] when
+ 2dup float? and [ [ 2.0 / + ] keep ] when Range ] def
+
+:range-unseq [ [ nil nil ]
+ [ [ dup [ over + ] $ 2dip Range ] ^Range ] ~seq ] def
+:range-empty? [ [ >< [ 2drop #f ] [ rot> _pos<> ] ~nil ] ^Range ] def
+:range-len [ [ >< [ 2drop nil ] [ rot> '- dip floor/ inc 0 max ]
+ ~nil ] ^Range ] def
+
+:range-get^' [ over 0 < [ 2drop nil ] [ [ i m n s .
+ 'm 's 'i * + 'n
+ [] [ over 's _pos<> [ drop nil ] when ] ~nil
+ ] ^Range ] if ] def
+:range-has?' [ range-get^' nil? not ] def
+:range-elem?' [ [ k m n s .
+ 'k 'm 's _pos<>, 'n nil? not, 'n 'k 's _pos<>,
+ and or not
+ 'k 'm - 's, ; NB: be careful w/ elem? w/ float
+ 'k float? [ / dup trunc eq ] 'div? if and
+ ] ^Range ] def ; TODO
+
+:_->float [ dup int? 'int->float when ] def
+:_pos<> [ pos? '< '> if ] def
+
+; int ranges
+;
+; >>> 2 10 [m-n] ->list
+; ( 2 3 4 5 6 7 8 9 10 )
+; >>> 2 10 [m-n) ->list
+; ( 2 3 4 5 6 7 8 9 )
+; >>> 4 [m-) 10 take-first ->list
+; ( 4 5 6 7 8 9 10 11 12 13 )
+; >>> 10 [0-n] ->list
+; ( 0 1 2 3 4 5 6 7 8 9 10 )
+; >>> 10 [0-n) ->list
+; ( 0 1 2 3 4 5 6 7 8 9 )
+; >>> [0-) 10 take-first ->list
+; ( 0 1 2 3 4 5 6 7 8 9 )
+; >>> 10 [1-n] ->list
+; ( 1 2 3 4 5 6 7 8 9 10 )
+; >>> 10 [1-n) ->list
+; ( 1 2 3 4 5 6 7 8 9 )
+; >>> [1-) 10 take-first ->list
+; ( 1 2 3 4 5 6 7 8 9 10 )
+;
+; float ranges
+;
+; >>> 2.1 10.1 [m-n] ->list
+; ( 2.1 3.1 4.1 5.1 6.1 7.1 8.1 9.1 10.1 )
+; >>> 2.1 10.1 [m-n) ->list
+; ( 2.1 3.1 4.1 5.1 6.1 7.1 8.1 9.1 )
+; >>> 4.1 [m-) 10 take-first ->list
+; ( 4.1 5.1 6.1 7.1 8.1 9.1 10.1 11.1 12.1 13.1 )
+; >>> 10.0 [0-n] ->list
+; ( 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0 )
+; >>> 10.0 [0-n) ->list
+; ( 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 )
+; >>> 10.0 [1-n] ->list
+; ( 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0 )
+; >>> 10.0 [1-n) ->list
+; ( 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 )
+;
+; ranges with step
+;
+; >>> 2 10 2 [m-n:s] ->list
+; ( 2 4 6 8 10 )
+; >>> 2 11 2.0 [m-n:s) ->list
+; ( 2.0 4.0 6.0 8.0 10.0 )
+; >>> 4 2 [m-:s) 5 take-first ->list
+; ( 4 6 8 10 12 )
+; >>> 10.0 2 [0-n:s] ->list
+; ( 0.0 2.0 4.0 6.0 8.0 10.0 )
+; >>> 10 2 [0-n:s) ->list
+; ( 0 2 4 6 8 )
+; >>> 2.0 [0-:s) 5 take-first ->list
+; ( 0.0 2.0 4.0 6.0 8.0 )
+; >>> 10 3 [1-n:s] ->list
+; ( 1 4 7 10 )
+; >>> 10 3.0 [1-n:s) ->list
+; ( 1.0 4.0 7.0 )
+; >>> 2 [1-:s) 5 take-first ->list
+; ( 1 3 5 7 9 )
+
+:[m-n] [ 1 range ] def
+:[m-n) [ dec [m-n] ] def
+:[m-) [ nil [m-n] ] def
+:[0-n] [ 0 swap [m-n] ] def
+:[0-n) [ 0 swap [m-n) ] def
+:[0-) [ 0 nil [m-n] ] def
+:[1-n] [ 1 swap [m-n] ] def
+:[1-n) [ 1 swap [m-n) ] def
+:[1-) [ 1 nil [m-n] ] def
+
+:[m-n:s] 'range def
+:[m-n:s) [ '- keep [m-n:s] ] def
+:[m-:s) [ nil >< [m-n:s] ] def
+:[0-n:s] [ 0 rot> [m-n:s] ] def
+:[0-n:s) [ 0 rot> [m-n:s) ] def
+:[0-:s) [ 0 nil [m-n:s] ] def
+:[1-n:s) [ 1 rot> [m-n:s) ] def
+:[1-:s) [ 1 nil >> 42 1list
+; ( 42 )
+; >>> :x :y 2list
+; ( :x :y )
+; >>> :x :y :z 3list
+; ( :x :y :z )
+
+:1list [ () cons ] def
+:2list [ 1list cons ] def
+:3list [ 2list cons ] def
+
+; lazy sequences
+;
+; list block (lazy rest) append
+; >>> , :fibs ( 0 1 ) [ 'fibs dup rest '+ zip ] lseq def
+; >>> 'fibs 10 take-first ->list
+; ( 0 1 1 2 3 5 8 13 21 34 )
+;
+; >>> :head [ ( :tail :is :lazy ) ] lseq1 ->list ; singleton
+; ( :head :tail :is :lazy )
+;
+; NB: use of side-effects is for demonstration purposes only and
+; should be avoided in most code.
+;
+; >>> , [ "evaluated once" say!, ( 1 2 3 ) ] lazy-seq ; completely lazy
+; >>> dup !thunk
+; evaluated once
+; ( 1 2 3 )
+; >>> drop !thunk
+; ( 1 2 3 )
+
+:LSeq ( :chunk :thunk ) defrecord ; NB: chunk must be a list
+
+:show ( :LSeq ) [ .chunk show "#" ++ ++ ] defmulti
+
+:lseq [ __thunk__ LSeq ] def
+:lseq1 [ '1list dip lseq ] def
+:lazy-seq [ () swap lseq ] def
+
+; "as sequence"
+;
+; * returns nil if empty
+; * converts to a proper sequence type if needed
+; (e.g. strings & dicts to lists)
+; * otherwise returns the sequence unmodified
+;
+; NB: whether conversion is performed and to what type may change; the
+; only guarantee is that a "proper" sequence type is returned.
+;
+; >>> nil seq
+; nil
+; >>> "foo" seq ; str becomes a list
+; ( "f" "o" "o" )
+; >>> ( 1 2 3 ) seq
+; ( 1 2 3 )
+; >>> "" seq
+; nil
+; >>> () seq
+; nil
+; >>> { x: 1, y: 2 } seq ; dict becomes a list
+; ( :x 1 => :y 2 => )
+; >>> 10 [1-n] seq ->list
+; ( 1 2 3 4 5 6 7 8 9 10 )
+; >>> [ ( 1 2 3 ) ] lazy-seq seq ; checking emptiness forces evaluation
+; ( 1 2 3 )
+;
+; >>> ( nil "foo" { x: 1 } ( 1 2 ) [1-), ( 1 2 ) 'inc map, 42 ) 'seq? mapl
+; ( #t :partial :partial #t #t #t #f )
+
+:seq ( :nil ) [ ] defmulti
+:seq ( :str ) [ ->nil '->list ~> ] defmulti ; TODO
+:seq ( :dict ) [ ->nil '.pairs ~> ] defmulti ; TODO
+:seq ( :list ) [ ->nil ] defmulti
+:seq ( :Range ) [ ->nil ] defmulti
+:seq ( :LSeq ) [ lseq-seq ] defmulti
+
+:lseq-seq [ dup .chunk empty? [ !thunk seq ] when ] def
+
+:seq? ( :nil ) [ drop #t ] defmulti
+:seq? ( :str ) [ drop :partial ] defmulti
+:seq? ( :dict ) [ drop :partial ] defmulti
+:seq? ( :list ) [ drop #t ] defmulti
+:seq? ( :Range ) [ drop #t ] defmulti
+:seq? ( :LSeq ) [ drop #t ] defmulti
+:seq? ( :_ ) [ drop #f ] defmulti
+
+; generic "uncons"
+;
+; unseq ⇔ 'first 'rest bi
+;
+; >>> , ( 1 2 ) unseq s!
+; --- STACK ---
+; ( 2 )
+; 1
+; --- END ---
+; >>> c!
+; *** STACK CLEARED ***
+; >>> , 3 10 [m-n] unseq ->list s!
+; --- STACK ---
+; ( 4 5 6 7 8 9 10 )
+; 3
+; --- END ---
+; >>> c!
+; *** STACK CLEARED ***
+; >>> , [ ( 1 2 ) ] lazy-seq unseq s!
+; --- STACK ---
+; ( 2 )
+; 1
+; --- END ---
+
+:unseq ( :nil ) [ nil ] defmulti
+:unseq ( :list ) [ [ nil nil ] [] ^list ] defmulti
+:unseq ( :Range ) [ range-unseq ] defmulti
+:unseq ( :LSeq ) [ lseq-unseq ] defmulti
+
+:lseq-unseq [ [ t . [ t unseq ] [ .uncons^ 't LSeq ] ~seq ] ^LSeq ] def
+
+; generic "head" & "tail"
+;
+; 'first 'rest bi ⇔ unseq
+;
+; * first returns the first element
+; * rest returns the rest of the sequence
+; * both return nil if the sequence is empty
+;
+; >>> ( 1 2 3 ) first
+; 1
+; >>> 4 [1-n] rest ->list
+; ( 2 3 4 )
+
+:first ( :_ ) [ unseq drop ] defmulti
+:rest ( :_ ) [ unseq nip ] defmulti
+
+; is the sequence empty?
+;
+; empty? ⇔ seq not
+;
+; >>> "foo" empty?
+; #f
+; >>> () empty?
+; #t
+; >>> { x: 1 } empty?
+; #f
+; >>> 1 [1-n] rest empty?
+; #t
+; >>> ( 1 2 3 ) [ 1 + ] map empty?
+; #f
+
+:empty? ( :str ) [ .empty? ] defmulti
+:empty? ( :list ) [ .empty? ] defmulti
+:empty? ( :dict ) [ .empty? ] defmulti
+:empty? ( :Range ) [ range-empty? ] defmulti
+:empty? ( :_ ) [ seq not ] defmulti
+
+; sequence length
+;
+; NB: sequence must be finite (or a range).
+;
+; >>> "foo" len
+; 3
+; >>> ( 1 2 ) len
+; 2
+; >>> { x: 1 } len
+; 1
+; >>> 37 42 [m-n) len
+; 5
+; >>> 42 [m-) len ; infinite
+; nil
+; >>> ( 1 2 3 ) [ 2 >= ] filter len
+; 2
+
+:len ( :str ) [ .len ] defmulti
+:len ( :list ) [ .len ] defmulti
+:len ( :dict ) [ .len ] defmulti
+:len ( :Range ) [ range-len ] defmulti
+:len ( :_ ) [ seq-len ] defmulti
+
+:seq-len [ 0 swap [ drop inc ] each ] def
+
+; append two sequences
+;
+; NB: to merge two dicts, use update.
+;
+; >>> "foo" "bar" ++
+; "foobar"
+; >>> ( 1 2 3 ) ( 4 5 ) ++
+; ( 1 2 3 4 5 )
+;
+; >>> ( 1 2 3 ) [ ( 4 5 ) ] lazy-seq ++ ->list
+; ( 1 2 3 4 5 )
+; >>> [ ( 1 2 3 ) ] lazy-seq ( 4 5 ) ++ ->list
+; ( 1 2 3 4 5 )
+
+:++ ( :str :str ) [ !append ] defmulti
+:++ ( :list :list ) [ !append ] defmulti
+
+:++ ( :nil :list ) [ nip ] defmulti ; TODO
+:++ ( :nil :LSeq ) [ nip ] defmulti
+
+:++ ( :list :nil ) [ drop ] defmulti ; TODO
+:++ ( :LSeq :nil ) [ drop ] defmulti
+
+:++ ( :list :LSeq ) [ [ '++ dip LSeq ] ^LSeq ] defmulti
+:++ ( :LSeq :list ) [ _lseq++ ] defmulti
+:++ ( :LSeq :LSeq ) [ _lseq++ ] defmulti
+
+:_lseq++ [ .[ [ '1 ++ ] @ lseq ] ^LSeq ] def
+
+; convert to list
+;
+; >>> "foo" ->list
+; ( "f" "o" "o" )
+; >>> ( 1 2 3 ) ->list
+; ( 1 2 3 )
+; >>> { x: 1, y: 2 } ->list
+; ( :x 1 => :y 2 => )
+
+:->list ( :str ) [ .->list ] defmulti
+:->list ( :list ) [ ] defmulti
+:->list ( :dict ) [ .pairs ] defmulti
+
+:->list ( :_ ) [ xs . ( 'xs [] each ) ] defmulti ; TODO
+ ; [ [ () ] [ ->list cons ] ^seq ]
+
+; list & sequence "pattern match"
+;
+; * ^seq uses seq and "unseq"s the sequence when not empty
+; * ~seq uses empty? and returns the original sequence when not empty
+;
+; >>> ( 1 2 3 ) [ "empty" ] [ hd tl . 'hd ] ^list ; head or "empty"
+; 1
+; >>> () [ "empty" ] 'drop ^seq
+; "empty"
+; >>> ( 4 5 ) [ "empty" ] 'head^ ~seq
+; 4
+; >>> "foo" [ () ] 'nip ^seq
+; ( "o" "o" )
+; >>> "foo" [ "" ] [] ~seq
+; "foo"
+
+:^list [ [ 'drop % ] dip '.uncons^ % '.empty? ~? ] def
+:^seq [ 'seq 2dip 'unseq % ~nil ] def
+:~seq [ [ 'drop % ] dip 'empty? ~? ] def
+
+:^seq' [ [] swap ^seq ] def
+
+; sequence conditional & "pattern match"
+;
+; NB: the difference between when-seq and with-seq is that the latter
+; "unseq"s the sequence when not empty.
+;
+; >>> () 'len when-seq
+; nil
+; >>> ( 1 2 3 ) 'len when-seq
+; 3
+; >>> ( 1 2 3 ) 'drop with-seq
+; 1
+; >>> () 'drop with-seq
+; nil
+
+:when-seq [ [ seq dup ] dip when ] def
+:with-seq [ [ nil ] swap ^seq ] def
+
+; "lazy" map & filter
+;
+; >>> ( 1 2 3 ) [ dup * ] map ->list
+; ( 1 4 9 )
+; >>> ( 1 2 3 ) 'dup map ->list ; multiple return values is OK
+; ( 1 1 2 2 3 3 )
+; >>> ( 1 2 3 4 ) 'even? filterl
+; ( 2 4 )
+
+:map [ f . [ () swap [ [ x xt . ( 'x f ) !append 'xt ] with-seq ]
+ 32 times .[ '1 'f map ] lseq ] when-seq ] def ; TODO
+ ; [ f . [ x xt . ( 'x f ) [ 'xt 'f map ] lseq ] with-seq ]
+:filter [ .[ [] 'drop '1 ~? ] map ] def
+
+:mapl [ map ->list ] def
+:filterl [ filter ->list ] def
+
+; zip(with)
+;
+; >>> ( :x :y ) ( 1 2 3 ) zip' ->list
+; ( T( :x 1 ) T( :y 2 ) )
+; >>> ( :x :y ) ( 1 2 3 ) [] zip ->list ; multiple return values is OK
+; ( :x 1 :y 2 )
+; >>> [1-) ( :x :y ) [ swap => ] zip ->list dict
+; { :x 1 =>, :y 2 => }
+
+:zip [ f . [ drop nil ] [ y yt . [ x xt .
+ ( 'x 'y f ) [ 'xt 'yt 'f zip ] lseq
+ ] with-seq ] ^seq ] def
+:zip' [ '2T zip ] def
+
+; TODO: unzip
+
+; folding (left- and right-associative)
+;
+; NB: foldr' only partially applies the recursive step, allowing
+; short-circuiting/laziness.
+;
+; >>> ( 2 3 4 ) 10 '- foldl ; ⇔ 10 2 - 3 - 4 -
+; 1
+; >>> ( 2 3 4 ) 10 '- foldr ; ⇔ 2 3 4 10 - - -
+; -7
+; >>> ( 2 3 4 ) () [ [ 1 + ] dip cons ] foldr ; "strict"
+; ( 3 4 5 )
+; >>> ( 2 3 4 ) () [ [ 1 + ] dip call cons ] foldr' ; "lazy"
+; ( 3 4 5 )
+
+:foldl [ f . swap [ rot> f 'f foldl ] ^seq' ] def
+:foldr [ f . swap [ >> ( ( 1 2 3 ) dup [ dup * ] map dup 'even? filter ) concat ->list
+; ( 1 2 3 1 4 9 4 )
+
+:concat [ () [ lazy-seq ++ ] foldr' ] def
+
+; reverse order of elements; "strict"
+;
+; NB: reversing a list or str is guaranteed to return a value of the
+; same type; reversing (most) other sequences returns a list.
+;
+; >>> ( 1 2 3 ) reverse
+; ( 3 2 1 )
+; >>> ( 1 2 3 ) [ dup * ] map reverse
+; ( 9 4 1 )
+; >>> "foobar" reverse
+; "raboof"
+; >>> 10 20 [m-n] reverse ->list
+; ( 20 19 18 17 16 15 14 13 12 11 10 )
+
+:reverse ( :str ) [ .reverse ] defmulti
+:reverse ( :Range ) [ range-reverse ] defmulti
+:reverse ( :_ ) [ reverse-as-list ] defmulti
+
+:range-reverse [ [ m n s . 'n [ "reverse: infinite range" fail ]
+ [ 'm 's neg Range ] ~nil ] ^Range ] def
+:reverse-as-list [ () [ swap cons ] foldl ] def
+
+; iterating over a sequence
+;
+; >>> , ( "Hello" "World" ) 'say! each
+; Hello
+; World
+; >>> , ( 1 2 3 ) [] each s!
+; --- STACK ---
+; 3
+; 2
+; 1
+; --- END ---
+; >>> ( ( 1 2 ) 'dup each )
+; ( 1 1 2 2 )
+
+:each [ f . unseq dup [ 'f dip 'f each ] when2 ] def ; TODO
+ ; [ f . [ 'f dip 'f each ] ^seq' ] ; currently 2x slower :(
+
+; generating (infinite) sequences & taking subsequences
+;
+; >>> ( 1 2 3 ) cycle 10 take-first ->list
+; ( 1 2 3 1 2 3 1 2 3 1 )
+; >>> 0 'inc iterate 10 take-first 2 drop-first ->list
+; ( 2 3 4 5 6 7 8 9 )
+; >>> 1 [ 2 * ] iterate [ 10 < ] drop-while [ 80 < ] take-while ->list
+; ( 16 32 64 )
+; >>> 42 repeat 4 take-first ->list
+; ( 42 42 42 42 )
+; >>> :x 3 replicate ->list
+; ( :x :x :x )
+; >>> 10 [1-n] 2 take-nth ->list
+; ( 1 3 5 7 9 )
+
+:iterate [ x f . ( 'x [ dup f ] 31 times ) dup 31 swap !get^
+ .[ '1 f 'f iterate ] lseq ] def ; TODO
+ ; [ f . () swap [ [ 1list ++ ] keep f ] 32 times
+ ; .[ '1 'f iterate ] lseq ] ; slower :(
+ ; [ x f . 'x [ 'x f 'f iterate ] lseq1 ] ; w/o chunking
+
+:cycle [ repeat concat ] def
+:repeat [ dup 'repeat $ lseq1 ] def
+:replicate [ 'repeat dip take-first ] def
+
+:take-first [ .[ '1 [ dec 'take-first 2$ lseq1 ] [ 3drop nil ] ~pos ]
+ with-seq ] def
+:drop-first [ .[ '1 0 > [ rest '1 dec drop-first ] when ] when-seq ] def
+
+:take-while [ p? . nil [ over p? 'lseq1 [ 2drop nil ] if ] foldr' ] def
+:drop-while [ p? . [ dup first p? [ rest 'p? drop-while ] when ]
+ when-seq ] def
+
+:take-nth [ n . [ [ 'n dec drop-first 'n take-nth ] $ lseq1 ]
+ with-seq ] def
+
+; TODO: split-at, split-w/, ...
+; TODO: init
+
+; searching
+;
+; NB: see also elem?.
+;
+; >>> [1-) [ 4 > ] find
+; 5
+; >>> 10 [1-n] [ 0 < ] find
+; nil
+
+:find [ filter 'drop with-seq ] def
+
+; partitioning a sequence (into a sequence of elements that do and one
+; of elements that do not satisfy a predicate)
+;
+; NB: unlike Haskell, we can't do both results at the same time with
+; foldr :(
+;
+; >>> , "Hello World!" [ "aeiou" elem?' ] partition 'join bi$ s!
+; --- STACK ---
+; "Hll Wrld!"
+; "eoo"
+; --- END ---
+
+:partition [ 'filter [ 'not @ filter ] 2bi ] def ; TODO
+
+; least & largest element of a non-empty sequence
+;
+; >>> ( 1 2 4 -1 7 3 ) minimum
+; -1
+; >>> ( 1 2 4 -1 7 3 ) maximum
+; 7
+; >>> () maximum
+; *** ERROR: maximum: empty list
+
+:minimum [ [ "minimum: empty list" fail ] [ swap 'min foldl ] ^seq ] def
+:maximum [ [ "maximum: empty list" fail ] [ swap 'max foldl ] ^seq ] def
+
+; sum & product of a sequence
+;
+; >>> ( 1 2 3 4 ) sum
+; 10
+; >>> ( 1 2 3 4 ) product
+; 24
+; >>> () sum
+; 0
+; >>> () product
+; 1
+
+:sum [ 0 '+ foldl ] def
+:product [ 1 '* foldl ] def
+
+ ; }}}1
+
+; -- Lists, Dicts & Indexing -- ; {{{1
+
+; lists: head & tail ("safe" & "unsafe"), (un)cons
+;
+; NB: ^seq/first/rest is usually a better choice than
+; uncons^/head/tail.
+;
+; >>> ( 1 2 3 )
+; ( 1 2 3 )
+; >>> dup head^
+; 1
+; >>> drop dup tail^
+; ( 2 3 )
+; >>> , drop uncons^ s!
+; --- STACK ---
+; ( 2 3 )
+; 1
+; --- END ---
+; >>> cons
+; ( 1 2 3 )
+;
+; >>> () head^ ; partial function
+; *** ERROR: list.head^: empty list
+; >>> () tail^
+; *** ERROR: list.tail^: empty list
+; >>> () head
+; nil
+; >>> () tail
+; nil
+
+:head^ '.head^ def
+:tail^ '.tail^ def
+
+:head [ ->nil 'head^ ~> ] def
+:tail [ ->nil 'tail^ ~> ] def
+
+:uncons^ '.uncons^ def
+:cons '!cons def
+
+; sorted list
+;
+; >>> ( 4 2 1 3 ) sort
+; ( 1 2 3 4 )
+;
+; >>> ( nil #f #t 0 10 -2.0 4.0 "foo" :bar ) dup sort =
+; #t
+;
+; >>> ( 1 2.0 3 4.0 ) sort ; <=> :-(
+; ( 1 3 2.0 4.0 )
+; >>> ( 1 2.0 3 4.0 ) sort' ; cmp :-)
+; ( 1 2.0 3 4.0 )
+
+:sort [ ->list .sort ] def
+:sort' [ ->list .sort' ] def
+
+; TODO: sort-by
+
+; remove consecutive duplicates
+;
+; >>> ( 1 2 2 3 2 ) uniq ->list
+; ( 1 2 3 2 )
+; >>> ( 1 2 2 3 2 ) sort uniq ->list
+; ( 1 2 3 )
+;
+; >>> ( 0.0 0.0 / dup ) uniq ->list
+; ( NaN NaN )
+
+:uniq [ '= uniq-by ] def
+:uniq-by [ f . [ over .[ '1 [ '2 swap f ] drop-while 'f uniq-by ]
+ lseq1 ] with-seq ] def
+
+; merge dicts & update record
+;
+; >>> { x: 1, y: 2 } { x: 99 } update
+; { :x 99 =>, :y 2 => }
+;
+; >>> , :Point ( :x :y ) defrecord
+; >>> Point( 1 2 )
+; Point{ :x 1 =>, :y 2 => }
+; >>> { y: 3 } update
+; Point{ :x 1 =>, :y 3 => }
+
+:update ( :dict :dict ) [ !merge ] defmulti
+:update ( :_ :_ ) [ over [ 'record->dict dip !merge ] dip
+ record-type apply-dict ] defmulti ; TODO
+
+; TODO: update-with function
+
+; keys & values
+;
+; >>> { x: 1, y: 2 } dup keys
+; ( :x :y )
+; >>> drop vals
+; ( 1 2 )
+;
+; >>> c!
+; *** STACK CLEARED ***
+; >>> , :Point ( :x :y ) defrecord
+; >>> , Point( 1 2 ) 'keys 'vals bi s!
+; --- STACK ---
+; ( 1 2 )
+; ( :x :y )
+; --- END ---
+
+:keys ( :dict ) [ .keys ] defmulti
+:values ( :dict ) [ .values ] defmulti
+
+:keys ( :_ ) [ record-type record-type-fields ] defmulti
+:values ( :_ ) [ record-values ] defmulti
+
+:vals 'values def
+
+; slicing (WIP)
+;
+; * ranges support any step != 0;
+; * lazy sequences support step >= 1;
+; * (currently) other sequences -- e.g. list -- only support step = 1;
+; * neither infinite ranges nor lazy sequences support negative indices.
+;
+; NB: see also take-first, drop-first, take-nth.
+;
+; >>> "0123456789" 5 [i-)
+; "56789"
+; >>> "0123456789" -5 [-j)
+; "01234"
+; >>> "0123456789" 3 -3 [i-j)
+; "3456"
+;
+; >>> ( 0 1 2 3 4 5 6 7 8 9 ) -5 [i-)
+; ( 5 6 7 8 9 )
+; >>> ( 0 1 2 3 4 5 6 7 8 9 ) 5 [-j)
+; ( 0 1 2 3 4 )
+;
+; >>> 10 20 [m-n] 2 -2 [i-j) ->list
+; ( 12 13 14 15 16 17 18 )
+; >>> [1-) 10 [-j) ->list
+; ( 1 2 3 4 5 6 7 8 9 10 )
+; >>> 10 -2 -2 [m-n:s] -2 0 -2 [i-j:s) ->list
+; ( 0 4 8 )
+; >>> 10 -2 -2 [m-n:s] -2 2 -1 [i-j:s) ->list
+; ( 0 2 4 )
+; >>> [1-) -2 [-j)
+; *** ERROR: range-slice: infinite range w/ negative index
+;
+; >>> [1-) [ dup * ] map 2 10 2 [i-j:s) ->list
+; ( 9 25 49 81 )
+
+:slice [ [i-j:s) ] def
+:[:s) [ nil nil range-slice ] defmulti
+:slice' ( :LSeq ) [ rot4> seq-slice ] defmulti
+
+:range-slice [ i j t . [ m n s .
+ { :tn 't neg? =>,
+ f: [ inc 's * 'n
+ [ "range-slice: infinite range w/ negative "
+ "index" ++ fail ] [] ~nil + ],
+ g: [ 's * 'm + ] }
+ let[
+ 'i [ 'tn 'n 'm ? ] [ 'f 'g ~neg ] ~nil,
+ 'j [ 'tn 'm 'n ? ] [
+ 'tn 'inc 'dec if
+ 'f [ g 'n [] [ 's neg? 'max 'min if ] ~nil ] ~neg
+ ] ~nil, 's 't *
+ ] Range ] ^Range ] def ; TODO
+
+:seq-slice [ i j s .
+ 'i [] 'drop-first ~nil
+ 'j [] [ 'i 0 or - take-first ] ~nil
+ 's 1 = [ 's take-nth ] unless
+ ] def ; TODO
+
+; get value at key/index & membership test
+;
+; >>> ( :one :two :three ) 1 get^
+; :two
+; >>> () 0 get^
+; *** ERROR: list.get^: index 0 is out of range
+; >>> ( 1 2 3 ) 1 get
+; 2
+; >>> () 0 get
+; nil
+;
+; >>> { x: 1, y: 2 } dup :x get
+; 1
+; >>> drop :z get
+; nil
+; >>> "foobar" 3 get
+; "b"
+; >>> "foobar" 10 get
+; nil
+; >>> [1-) 10 get
+; 11
+; >>> 10 [1-n] 10 get
+; nil
+;
+; >>> ( :one :two :three ) 1 has? ; valid index of
+; #t
+; >>> ( :one :two :three ) :two elem? ; element of
+; #t
+; >>> { x: 1, y: 2 } :y has?
+; #t
+; >>> "foobar" 3 has?
+; #t
+; >>> "hypotheekofferte" "theekoffer" elem? ; is substring
+; #t
+;
+; >>> [1-) 0 has?
+; #t
+; >>> [1-) 0 elem?
+; #f
+; >>> [1-) 99 elem?
+; #t
+; >>> 100 [1-n) 100 elem?
+; #f
+
+:get [ 2dup has? 'get^ [ 2drop nil ] if ] def
+
+:get^ [ swap get^' ] def
+:has? [ swap has?' ] def
+:elem? [ swap elem?' ] def
+
+:get^' ( :_ ) [ !get^ ] defmulti
+:has?' ( :_ ) [ !has? ] defmulti
+:elem?' ( :_ ) [ !elem? ] defmulti
+
+:has?' ( :nil ) [ 2drop #f ] defmulti ; for assoc-in
+
+:get^' ( :Range ) [ range-get^' ] defmulti
+:has?' ( :Range ) [ range-has?' ] defmulti
+:elem?' ( :Range ) [ range-elem?' ] defmulti
+
+; first, second & third element
+;
+; >>> :x :y 2list
+; ( :x :y )
+; >>> , '1st '2nd bi s!
+; --- STACK ---
+; :y
+; :x
+; --- END ---
+; >>> ( 1 2 3 4 5 ) 3rd
+; 3
+
+:1st 'first def
+:2nd [ rest '1st ~> ] def
+:3rd [ rest '2nd ~> ] def
+
+; last element
+;
+; >>> () last
+; nil
+; >>> ( 1 2 3 ) last
+; 3
+; >>> ( 1 2 3 ) [ dup * ] map last
+; 9
+; >>> () last^
+; *** ERROR: list.get^: index -1 is out of range
+; >>> ( :x :y :z ) last
+; :z
+
+:last ( :LSeq ) [ :_ nil >> [1-) 10 nth
+; 11
+; >>> [1-) [ dup * ] map 10 nth
+; 121
+
+:nth [ swap nth' ] def ; TODO
+
+:nth' ( :_ ) [ swap get ] defmulti
+:nth' ( :LSeq ) [ [ drop nil ]
+ [ x xt . [ dec 'xt nth' ] [ drop 'x ] ~pos ]
+ ^seq ] defmulti
+
+; pair each element with its index
+;
+; >>> "foo" indexed ->list
+; ( T( 0 "f" ) T( 1 "o" ) T( 2 "o" ) )
+; >>> "foo" indexed' ->list
+; ( T( "f" 0 ) T( "o" 1 ) T( "o" 2 ) )
+
+:indexed [ [0-) swap zip' ] def
+:indexed' [ [0-) zip' ] def
+
+; get value in nested associative structure
+;
+; >>> , ( { x: 42 } { y: ( 37 ) } )
+; >>> dup ( 0 :x ) get-in
+; 42
+; >>> drop ( 1 :y 0 ) get-in
+; 37
+
+:get-in [ [ 'get $ ] map ~~> ] def
+
+; associate value in (nested) associative structure
+;
+; >>> { x: 1, y: 2 } 3 :z assoc
+; { :x 1 =>, :y 2 =>, :z 3 => }
+;
+; >>> , ( { x: 42 } { y: ( 37 ) } )
+; >>> #t ( 1 :z ) assoc-in
+; ( { :x 42 => } { :y ( 37 ) =>, :z #t => } )
+; >>> nil "magic" ( :x :y :z ) assoc-in
+; { :x { :y { :z "magic" => } => } => }
+;
+; >>> ( 1 2 ) :x 2 assoc
+; ( 1 2 :x )
+; >>> ( 1 2 ) :x 3 assoc
+; *** ERROR: assoc: index 3 is out of range
+
+:assoc [ } ] defmulti
+:assoc' ( :list ) [ v i l .
+ 'l len inc 'i "assoc" assert-in-range
+ 'l 'i [-j) ( 'v ) 'l 'i inc [i-) ++ ++
+ ] defmulti
+:assoc' ( :dict ) [ v k d . 'd { 'k 'v => } !merge ] defmulti
+
+:assert-in-range [ l i s . 'i 0 < 'i 'l >= or [
+ ( 's 'i ) "${0}: index ${1} is out of range" fmt
+ fail
+ ] when ] def
+
+; "update" value in (nested) associative structure
+;
+; >>> { x: 1, y: 2 } 'inc :x modify
+; { :x 2 =>, :y 2 => }
+;
+; >>> { x: { y: 1 } } 'inc ( :x :y ) modify-in
+; { :x { :y 2 => } => }
+; >>> { x: { y: 1 } } [ [ 42 ] 'inc ~nil ] ( :x :z ) modify-in
+; { :x { :y 1 =>, :z 42 => } => }
+;
+; >>> { x: 1, y: 2 } :x 'dec modify'
+; { :x 0 =>, :y 2 => }
+; >>> { x: { y: 1 } } ( :x :y ) 'dec modify-in'
+; { :x { :y 0 => } => }
+
+:modify [ f k . dup 'k get f 'k assoc ] def
+:modify-in [ f ks . dup 'ks get-in f 'ks assoc-in ] def ; TODO
+
+:modify' [ swap modify ] def
+:modify-in' [ swap modify-in ] def
+
+; remove mapping for key from associative structure
+;
+; >>> { x: 1, y: 2, z: 3 } :y dissoc
+; { :x 1 =>, :z 3 => }
+; >>> :foo dissoc
+; { :x 1 =>, :z 3 => }
+
+:dissoc [ swap dissoc' ] def
+
+:dissoc' ( :dict ) [ !delete ] defmulti
+
+ ; }}}1
+
+; -- Regexes & String Formatting -- ; {{{1
+
+; match
+;
+; NB: see also rx-match.
+;
+; >>> "foo" "^f" =~ ; boolean
+; #t
+; >>> "bar" "^f" =~
+; #f
+
+:=~ ( :str :str ) [ rx-match bool ] defmulti ; TODO
+
+; filter using =~
+;
+; >>> ( "one" "two" "three" ) "^o|ee" grep ->list
+; ( "one" "three" )
+
+:grep [ '=~ $ filter ] def
+
+; substitute/replace
+;
+; NB: see also rx-sub.
+;
+; >>> "1 2 3 4" "$2 $1" "(\w+) (\w+)" rx-sub1
+; "2 1 3 4"
+; >>> "1 2 3 4" "$2 $1" "(\w+) (\w+)" rx-suball
+; "2 1 4 3"
+;
+; >>> "foo bar baz" [ reverse ] "\w+" s/// ; Perl-style alias
+; "oof bar baz"
+; >>> "foo bar baz" [ reverse ] "\w+" s///g
+; "oof rab zab"
+
+:rx-sub1 [ #f rx-sub ] def
+:rx-suball [ #t rx-sub ] def
+
+:s/// 'rx-sub1 def
+:s///g 'rx-suball def
+
+; string formatting (WIP)
+;
+; >>> ( :x 42 "foo" ) "${2} ${1} ${0}" fmt
+; "foo 42 :x"
+
+:fmt [ >< .[ '1 >< str->int get ->str nip ]
+ "\$\{(\d+)\}" s///g ] def ; TODO
+
+; TODO: width, zero-fill, justify, dict key, ...
+
+ ; }}}1
+
+; -- "Quasi-Macros" -- ; {{{1
+
+; lexical bindings
+;
+; >>> { x: 1, y: 2 } [ 'y 'x + ] let
+; 3
+; >>> { x: 1, y: 2 } let[ 'y 'x + ]
+; 3
+
+:let [ [ 'vals 'keys bi ] dip '__block-code__ keep __block__
+ apply ] def ; TODO
+
+ ; }}}1
+
+; -- Miscellaneous: Looping, I/O, Exceptions, etc. -- ; {{{1
+
+; identity function
+;
+; >>> id
+; >>> []
+; [ ]
+
+:id [ ] def
+:[] [ 'id ] def
+
+; const
+;
+; >>> ( 1 2 3 ) 42 const mapl
+; ( 42 42 42 )
+
+:const '[ drop '1 ] def
+
+; call n times
+;
+; >>> , [ "Hi!" say! ] 5 times
+; Hi!
+; Hi!
+; Hi!
+; Hi!
+; Hi!
+; >>> 0 1 [ '+ keep swap ] 5 times
+; 8
+
+:times [ f n . 'n 0 > [ f 'f 'n dec times ] when ] def
+ ; [ [1-n] swap 'drop % each ] ; currently 10x slower :(
+
+; loop, while & until
+;
+; >>> , :next-collatz [ [ 2 div ] [ 3 * 1 + ] 'even? ~? ] def
+;
+; >>> ( 12 [ dup next-collatz dup 1 not= ] loop )
+; ( 12 6 3 10 5 16 8 4 2 1 )
+; >>> ( 12 [ dup 1 not= ] [ dup next-collatz ] while )
+; ( 12 6 3 10 5 16 8 4 2 1 )
+; >>> ( 12 [ dup 1 = ] [ dup next-collatz ] until )
+; ( 12 6 3 10 5 16 8 4 2 1 )
+;
+; >>> ( 1 [ dup next-collatz dup 1 not= ] loop )
+; ( 1 4 2 1 )
+;
+; >>> ( 1 [ dup 1 not= ] [ dup next-collatz ] while ) ; may run 0x
+; ( 1 )
+; >>> ( 1 [ dup 1 = ] [ dup next-collatz ] until )
+; ( 1 )
+;
+; >>> ( 1 [ dup 1 not= ] [ dup next-collatz ] do- while ) ; run >= 1x
+; ( 1 4 2 1 )
+; >>> ( 1 [ dup 1 = ] [ dup next-collatz ] do- until )
+; ( 1 4 2 1 )
+
+:loop [ f . f [ 'f loop ] when ] def
+:while [ p? f . p? [ f 'p? 'f while ] when ] def
+:until [ [ 'not @ ] dip while ] def
+
+:do- [ dup 2dip ] def
+:do-while [ do- while ] def
+:do-until [ do- until ] def
+
+; print str or value to stdout
+;
+; >>> "Hello, World!" say!
+; Hello, World!
+;
+; >>> 42 display!
+; 42
+; >>> "foo" ddisplay! ; ⇔ dup display!
+; foo
+; "foo"
+;
+; >>> , ( :x 42 "foo" ) "${2} ${1} ${0}\n" fmt! ; ⇔ fmt puts!
+; foo 42 :x
+
+:say! [ "\n" !append puts! ] def
+:display! [ ->str say! ] def
+:ddisplay! [ dup display! ] def
+:fmt! [ fmt puts! ] def
+
+; output message & show stack (use for debugging only!)
+;
+; >>> , :foo [ 1 2, "foo" trace!, + ] def
+; >>> foo
+; --- TRACE: foo ---
+; --- STACK ---
+; 2
+; 1
+; --- END ---
+; 3
+
+:trace! [ 1list "--- TRACE: ${0} ---" fmt say! __show-stack!__ ] def
+
+; read lines from stdin
+;
+; NB: read-line! (like ask!) returns nil at EOF.
+
+:read-line! [ nil ask! ] def ; TODO
+:lines! [ read-line! [ 'lines! lseq1 ] ~> ] def
+
+; try w/o finally/catch
+;
+; >>> [ ... ] [ _ _ _ . :caught #t ] try-catch
+; :caught
+; >>> [ ... ] [ :finally ] try-finally
+; *** ERROR: name __ellipsis__ is not defined
+
+:try-catch [ [] try ] def
+:try-finally [ nil swap try ] def
+
+; assertion
+;
+; >>> [ 1 1 = ] assert
+; >>> [ 1 2 = ] assert
+; *** ERROR: assert failed: [ 1 2 = ]
+
+:assert [ b . b [ "assert failed: " 'b ->str ++ fail ] unless ] def
+
+ ; }}}1
+
+; -- Either, Functor, Monad, etc. -- ; {{{1
+
+:Left ( :val ) defrecord
+:Right ( :val ) defrecord
+
+:left 'Left def
+:right 'Right def
+
+:show ( :Left ) [ .val show "left( " swap ++ " )" ++ ] defmulti
+:show ( :Right ) [ .val show "right( " swap ++ " )" ++ ] defmulti
+
+; values with two possibilities
+;
+; NB: by convention, left is often for errors and right for "correct"
+; values.
+;
+; >>> , :f [ [ 2 div ] [ 2.0 / ] ^either ] def
+; >>> 5 left f
+; 2
+; >>> 7.0 right f
+; 3.5
+;
+; >>> [ 1 0 div ] try->either
+; left( ( :DivideByZero "divide by zero" () ) )
+; >>> [ 5 2 div ] try->either
+; right( 2 )
+;
+; >>> "oops" left either->fail
+; *** ERROR: oops
+; >>> 42 right either->fail
+; 42
+
+:~either [ either [ f . [ Right( f ) ] [ 3list Left #t ] [] try ] def
+:either->fail [ 'fail [] ^either ] def
+
+; functor (WIP)
+;
+; >>> , :f [ 'inc -> [ dup * ] -> ] def
+; >>> nil f ; NB: using ~> for nil is better
+; nil
+; >>> x: 7 f
+; :x 64 =>
+; >>> ( 1 2 3 ) f ->list
+; ( 4 9 16 )
+; >>> ( 1 2 3 ) 'odd? filter f ->list
+; ( 4 16 )
+; >>> :oops left f
+; left( :oops )
+; >>> 7 right f
+; right( 64 )
+
+:-> [ swap ->' ] def
+
+:->' ( :nil ) [ nip ] defmulti
+; ( :bool ) [ swap call ] defmulti ; TODO
+; ( :int ) [ swap call ] defmulti ; TODO
+; ( :float ) [ swap call ] defmulti ; TODO
+; ( :str ) [ ... ] defmulti ; TODO
+; ( :kwd ) [ swap call ] defmulti ; TODO
+:->' ( :pair ) [ swap ^pair => ] defmulti
+:->' ( :list ) [ swap map ] defmulti
+; ( :dict ) [ ... ] defmulti ; TODO
+:->' ( :block ) [ % ] defmulti ; TODO
+:->' ( :builtin ) [ % ] defmulti ; TODO
+:->' ( :multi ) [ % ] defmulti ; TODO
+
+:->' ( :LSeq ) [ swap map ] defmulti
+:->' ( :Left ) [ nip ] defmulti
+:->' ( :Right ) [ swap ^Right Right ] defmulti
+
+; monad (WIP)
+;
+; >>> ( 1 2 3 ) [ 'inc [ dup * ] bi 2list ] >>= ->list
+; ( 2 1 3 4 4 9 )
+; >>> ( 1 2 3 ) [ x ret . ( 4 5 ) [ y . T( 'x 'y ) ret ] bind ]
+; ... bind-with ->list
+; ( T( 1 4 ) T( 1 5 ) T( 2 4 ) T( 2 5 ) T( 3 4 ) T( 3 5 ) )
+;
+; >>> do[ ( 1 2 3 ) :x <- ( 4 5 ) :y <- T( 'x 'y ) return ] ->list
+; ( T( 1 4 ) T( 1 5 ) T( 2 4 ) T( 2 5 ) T( 3 4 ) T( 3 5 ) )
+;
+; >>> , :f [ [ drop "neg" left ] [ dup * right ] ~neg ] def
+; >>> "oops" left 'f >>=
+; left( "oops" )
+; >>> -4 right 'f >>=
+; left( "neg" )
+; >>> 4 right 'f >>=
+; right( 16 )
+;
+; >>> right( :x ) right( :y ) >>
+; right( :y )
+;
+; >>> nil 4 replicate ( 1 2 ) >> '1list >>= ->list
+; ( 1 2 1 2 1 2 1 2 )
+; >>> do[ nil 4 replicate & ( 1 2 ) :x <- 'x return ] ->list
+; ( 1 2 1 2 1 2 1 2 )
+
+:>>= [ swap =<< ] def
+:>> [ const >>= ] def
+
+:=<< ( :list ) [ swap map concat ] defmulti
+:=<< ( :LSeq ) [ swap map concat ] defmulti
+:=<< ( :Left ) [ nip ] defmulti
+:=<< ( :Right ) [ swap ^Right ] defmulti
+
+:return-as ( :list ) [ drop 1list ] defmulti
+:return-as ( :LSeq ) [ drop 1list ] defmulti
+:return-as ( :Left ) [ drop Right ] defmulti
+:return-as ( :Right ) [ drop Right ] defmulti
+
+:bind '>>= def
+:bind-with [ x f . 'x [ [ 'x return-as ] f ] >>= ] def
+
+{ :_& :& __ident__ =>, :_<- :<- __ident__ =>, blk: '__block__,
+ ret: :return, :bw :bind-with __ident__ => } let[
+
+:do [ b . () 'b __block-code__ _do& 'b _do 'b blk call ] def
+:_do& [ [ dup '_& = [ drop :_ '_<- ] when ] mapl ] def
+:_do [ b . [ () ] [ dup 1st '_<- =
+ [ uncons^ nip [ 'ret 2list ] dip 'b _do 'b blk 'bw 2list ]
+ [ 'b _do cons ] if ] ^list ] def ; TODO
+
+]
+
+ ; }}}1
+
+; -- The Joy of Recursion -- ; {{{1
+
+; linear & binary recursion combinators (inspired by Joy)
+;
+; >>> , :fac1 [ dup zero? 'inc [ dup dec fac1 * ] if ] def
+; >>> 5 fac1
+; 120
+; >>> , :fac2 [ 'zero? 'inc [ dup dec ] '* linrec ] def
+; >>> 5 fac2
+; 120
+;
+; >>> , :qsort1 [ dup empty? [] [ unseq over '< $ partition
+; ... 'qsort1 bi$ [ swap 1list ] dip ++ ++ ] if ] def
+; >>> ( 5 2 7 2 -4 1 ) qsort1 ->list
+; ( -4 1 2 2 5 7 )
+; >>> , :qsort2 [ 'empty? [] [ unseq over '< $ partition ]
+; ... [ [ swap 1list ] dip ++ ++ ] binrec ] def
+; >>> ( 5 2 7 2 -4 1 ) qsort2 ->list
+; ( -4 1 2 2 5 7 )
+
+:linrec [ p? f g h . dup p? 'f [ g 'p? 'f 'g 'h linrec h ] if ] def
+:binrec [ p? f g h . dup p? 'f [ g [ 'p? 'f 'g 'h binrec ] bi$
+ h ] if ] def ; TODO
+
+ ; }}}1
+
+; -- Conversion -- ; {{{1
+
+; conversion
+;
+; >>> ( 1 2 3 ) [ 'inc map ] as
+; ( 2 3 4 )
+; >>> "foo" [ 'upper-case map ] as
+; "FOO"
+
+:as [ over convert-> 'call dip call ] def
+
+:convert-> ( :str ) [ drop 'convert->str ] defmulti ; TODO
+:convert-> ( :list ) [ drop 'convert->list ] defmulti
+
+:convert->str ( :str ) [ ] defmulti ; TODO
+:convert->str ( :list ) [ join ] defmulti
+:convert->str ( :LSeq ) [ join ] defmulti
+
+:convert->list ( :list ) [ ] defmulti ; TODO
+:convert->list ( :str ) [ ->list ] defmulti
+:convert->list ( :LSeq ) [ ->list ] defmulti
+
+ ; }}}1
+
+; -- Modules -- ; {{{1
+
+; require module (loads from file if not defined)
+;
+; >>> , :no-such-module require
+; *** ERROR: cannot load module no-such-module
+; >>> , :no-such-module [] defmodule ; ^^'
+; >>> , :no-such-module require
+
+:require [ dup __modules__ !elem? '__load-module__ unless1 ] def
+
+; use module (require + import(-from))
+;
+; >>> , :_test use
+; loading module _test...
+; >>> 'x
+; 1
+;
+; >>> , ( :x :y ) :_test use-from
+; >>> 'y
+; 2
+
+:use [ __caller-module__ . 'require
+ [ '__caller-module__ defmodule[ import ] ] bi ] def
+:use-from [ __caller-module__ . 'require
+ [ '__caller-module__ defmodule[ import-from ] ] bi ] def
+
+ ; }}}1
+
+; -- Unicode Aliases -- ; {{{1
+
+:← 'def def ; ^k<- (vim digraph)
+
+:≠ 'not= ← ; ^k!=
+:≤ '<= ← ; ^k=<
+:≥ '>= ← ; ^k=>
+
+:∘ '% ← ; ^kOb
+
+:¬ 'not ← ; ^kNO
+:∧ 'and ← ; ^kAN
+:∨ 'or ← ; ^kOR
+
+:~[≠] '~[not=] ←
+:~[≤] '~[<=] ←
+:~[≥] '~[>=] ←
+
+:∋ 'elem? ← ; ^k-)
+:∌ [ ∋ not ] ←
+
+ ; }}}1
+
+; ...
+
+; -- END --
+
+] ; defmodule
+
+; vim: set tw=70 sw=2 sts=2 et fdm=marker :
diff --git a/lib/str.knk b/lib/str.knk
new file mode 100644
--- /dev/null
+++ b/lib/str.knk
@@ -0,0 +1,62 @@
+; -- ; {{{1
+;
+; File : str.knk
+; Maintainer : Felix C. Stegerman
+; Date : 2020-02-10
+;
+; Copyright : Copyright (C) 2020 Felix C. Stegerman
+; Version : v0.0.1
+; License : LGPLv3+
+;
+; -- ; }}}1
+
+:str defmodule[
+
+; -- Predicates -- ; {{{1
+
+; character classification
+;
+; >>> :str use
+; >>> "猫" is-letter?
+; #t
+; >>> "foo" is-lower?
+; #t
+; >>> "FOO" is-upper?
+; #t
+; >>> "ⅵ" is-number?
+; #t
+; >>> "…" is-punct?
+; #t
+; >>> "\u0308" is-mark? ; diaeresis
+; #t
+; >>> "€" is-symbol?
+; #t
+; >>> "\u2028" is-sep? ; line separator
+; #t
+; >>> "\u00a0" is-space? ; nbsp
+; #t
+; >>> "42" is-digit?
+; #t
+; >>> "00a0" is-hex?
+; #t
+; >>> "0644" is-oct?
+; #t
+
+:is-letter? [ "^\p{L}+$" =~ ] def ; TODO
+:is-lower? [ "^\p{Ll}+$" =~ ] def
+:is-upper? [ "^\p{Lu}+$" =~ ] def
+:is-number? [ "^\p{N}+$" =~ ] def
+:is-punct? [ "^\p{P}+$" =~ ] def
+:is-mark? [ "^\p{M}+$" =~ ] def
+:is-symbol? [ "^\p{S}+$" =~ ] def
+:is-sep? [ "^\p{Z}+$" =~ ] def
+:is-space? [ "^\p{Zs}+$" =~ ] def
+:is-digit? [ "^[0-9]+$" =~ ] def
+:is-hex? [ "^[0-9a-fA-F]+$" =~ ] def
+:is-oct? [ "^[0-7]+$" =~ ] def
+
+ ; }}}1
+
+] ; defmodule
+
+; vim: set tw=70 sw=2 sts=2 et fdm=marker :
diff --git a/nya/katze.cat b/nya/katze.cat
new file mode 100644
--- /dev/null
+++ b/nya/katze.cat
@@ -0,0 +1,30 @@
+[0m[7m[38;5;237m子[0m[7m[38;5;237m猫[0m[7m[38;5;238m子[0m[7m[38;5;238m猫[0m[7m[38;5;237m子[0m[7m[38;5;237m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m[7m[38;5;237m子[0m[7m[38;5;238m猫[0m[7m[38;5;240m子[0m[7m[38;5;235m猫[0m[7m[38;5;236m子[0m[7m[38;5;241m猫[0m[7m[38;5;239m子[0m[7m[38;5;234m猫[0m[7m[38;5;238m子[0m[7m[38;5;235m猫[0m[7m[38;5;234m子[0m[7m[38;5;236m猫[0m[7m[38;5;234m子[0m[7m[38;5;237m猫[0m[7m[38;5;59m子[0m[7m[38;5;240m猫[0m[7m[38;5;234m子[0m[7m[38;5;233m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m[7m[38;5;238m子[0m[7m[38;5;237m猫[0m[7m[38;5;237m子[0m[7m[38;5;237m猫[0m[7m[38;5;238m子[0m[7m[38;5;237m猫[0m[7m[38;5;236m子[0m[7m[38;5;237m猫[0m[7m[38;5;236m子[0m[7m[38;5;236m猫[0m[7m[38;5;237m子[0m[7m[38;5;237m猫[0m
+[0m[7m[38;5;59m猫[0m[7m[38;5;241m子[0m[7m[38;5;238m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m[7m[38;5;59m子[0m[7m[38;5;101m猫[0m[7m[38;5;101m子[0m[7m[38;5;138m猫[0m[7m[38;5;246m子[0m[7m[38;5;144m猫[0m[7m[38;5;240m子[0m[7m[38;5;241m猫[0m[7m[38;5;144m子[0m[7m[38;5;101m猫[0m[7m[38;5;238m子[0m[7m[38;5;242m猫[0m[7m[38;5;238m子[0m[7m[38;5;101m猫[0m[7m[38;5;240m子[0m[7m[38;5;235m猫[0m[7m[38;5;242m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m[7m[38;5;233m猫[0m[7m[38;5;237m子[0m[7m[38;5;244m猫[0m[7m[38;5;241m子[0m[7m[38;5;238m猫[0m[7m[38;5;239m子[0m[7m[38;5;241m猫[0m[7m[38;5;241m子[0m[7m[38;5;59m猫[0m[7m[38;5;240m子[0m[7m[38;5;240m猫[0m[7m[38;5;240m子[0m[7m[38;5;239m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m[7m[38;5;238m子[0m
+[0m[7m[38;5;95m子[0m[7m[38;5;241m猫[0m[7m[38;5;238m子[0m[7m[38;5;237m猫[0m[7m[38;5;238m子[0m[7m[38;5;238m猫[0m[7m[38;5;239m子[0m[7m[38;5;236m猫[0m[7m[38;5;59m子[0m[7m[38;5;101m猫[0m[7m[38;5;144m子[0m[7m[38;5;144m猫[0m[7m[38;5;101m子[0m[7m[38;5;144m猫[0m[7m[38;5;101m子[0m[7m[38;5;102m猫[0m[7m[38;5;101m子[0m[7m[38;5;59m猫[0m[7m[38;5;102m子[0m[7m[38;5;242m猫[0m[7m[38;5;238m子[0m[7m[38;5;102m猫[0m[7m[38;5;244m子[0m[7m[38;5;242m猫[0m[7m[38;5;234m子[0m[7m[38;5;244m猫[0m[7m[38;5;244m子[0m[7m[38;5;59m猫[0m[7m[38;5;236m子[0m[7m[38;5;240m猫[0m[7m[38;5;242m子[0m[7m[38;5;243m猫[0m[7m[38;5;242m子[0m[7m[38;5;240m猫[0m[7m[38;5;59m子[0m[7m[38;5;240m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m[7m[38;5;238m子[0m[7m[38;5;237m猫[0m
+[0m[7m[38;5;241m猫[0m[7m[38;5;101m子[0m[7m[38;5;101m猫[0m[7m[38;5;59m子[0m[7m[38;5;95m猫[0m[7m[38;5;101m子[0m[7m[38;5;95m猫[0m[7m[38;5;236m子[0m[7m[38;5;70m猫[0m[7m[38;5;76m子[0m[7m[38;5;71m猫[0m[7m[38;5;150m子[0m[7m[38;5;180m猫[0m[7m[38;5;144m子[0m[7m[38;5;95m猫[0m[7m[38;5;101m子[0m[7m[38;5;101m猫[0m[7m[38;5;95m子[0m[7m[38;5;138m猫[0m[7m[38;5;144m子[0m[7m[38;5;239m猫[0m[7m[38;5;102m子[0m[7m[38;5;138m猫[0m[7m[38;5;237m子[0m[7m[38;5;239m猫[0m[7m[38;5;247m子[0m[7m[38;5;246m猫[0m[7m[38;5;242m子[0m[7m[38;5;243m猫[0m[7m[38;5;244m子[0m[7m[38;5;246m猫[0m[7m[38;5;244m子[0m[7m[38;5;242m猫[0m[7m[38;5;59m子[0m[7m[38;5;240m猫[0m[7m[38;5;239m子[0m[7m[38;5;238m猫[0m[7m[38;5;238m子[0m[7m[38;5;238m猫[0m[7m[38;5;239m子[0m
+[0m[7m[38;5;95m子[0m[7m[38;5;138m猫[0m[7m[38;5;102m子[0m[7m[38;5;95m猫[0m[7m[38;5;240m子[0m[7m[38;5;244m猫[0m[7m[38;5;246m子[0m[7m[38;5;238m猫[0m[7m[38;5;64m子[0m[7m[38;5;113m猫[0m[7m[38;5;113m子[0m[7m[38;5;119m猫[0m[7m[38;5;150m子[0m[7m[38;5;187m猫[0m[7m[38;5;138m子[0m[7m[38;5;144m猫[0m[7m[38;5;101m子[0m[7m[38;5;101m猫[0m[7m[38;5;138m子[0m[7m[38;5;95m猫[0m[7m[38;5;239m子[0m[7m[38;5;102m猫[0m[7m[38;5;138m子[0m[7m[38;5;95m猫[0m[7m[38;5;144m子[0m[7m[38;5;144m猫[0m[7m[38;5;101m子[0m[7m[38;5;101m猫[0m[7m[38;5;242m子[0m[7m[38;5;101m猫[0m[7m[38;5;101m子[0m[7m[38;5;244m猫[0m[7m[38;5;101m子[0m[7m[38;5;240m猫[0m[7m[38;5;239m子[0m[7m[38;5;59m猫[0m[7m[38;5;59m子[0m[7m[38;5;59m猫[0m[7m[38;5;239m子[0m[7m[38;5;240m猫[0m
+[0m[7m[38;5;242m猫[0m[7m[38;5;138m子[0m[7m[38;5;101m猫[0m[7m[38;5;101m子[0m[7m[38;5;240m猫[0m[7m[38;5;240m子[0m[7m[38;5;247m猫[0m[7m[38;5;242m子[0m[7m[38;5;237m猫[0m[7m[38;5;113m子[0m[7m[38;5;155m猫[0m[7m[38;5;155m子[0m[7m[38;5;113m猫[0m[7m[38;5;187m子[0m[7m[38;5;144m猫[0m[7m[38;5;144m子[0m[7m[38;5;138m猫[0m[7m[38;5;102m子[0m[7m[38;5;138m猫[0m[7m[38;5;101m子[0m[7m[38;5;95m猫[0m[7m[38;5;138m子[0m[7m[38;5;181m猫[0m[7m[38;5;180m子[0m[7m[38;5;101m猫[0m[7m[38;5;64m子[0m[7m[38;5;70m猫[0m[7m[38;5;70m子[0m[7m[38;5;112m猫[0m[7m[38;5;76m子[0m[7m[38;5;58m猫[0m[7m[38;5;239m子[0m[7m[38;5;95m猫[0m[7m[38;5;59m子[0m[7m[38;5;239m猫[0m[7m[38;5;240m子[0m[7m[38;5;239m猫[0m[7m[38;5;239m子[0m[7m[38;5;240m猫[0m[7m[38;5;59m子[0m
+[0m[7m[38;5;241m子[0m[7m[38;5;145m猫[0m[7m[38;5;138m子[0m[7m[38;5;101m猫[0m[7m[38;5;242m子[0m[7m[38;5;238m猫[0m[7m[38;5;240m子[0m[7m[38;5;247m猫[0m[7m[38;5;238m子[0m[7m[38;5;64m猫[0m[7m[38;5;76m子[0m[7m[38;5;112m猫[0m[7m[38;5;76m子[0m[7m[38;5;101m猫[0m[7m[38;5;250m子[0m[7m[38;5;138m猫[0m[7m[38;5;246m子[0m[7m[38;5;102m猫[0m[7m[38;5;244m子[0m[7m[38;5;101m猫[0m[7m[38;5;101m子[0m[7m[38;5;144m猫[0m[7m[38;5;181m子[0m[7m[38;5;59m猫[0m[7m[38;5;64m子[0m[7m[38;5;112m猫[0m[7m[38;5;119m子[0m[7m[38;5;112m猫[0m[7m[38;5;119m子[0m[7m[38;5;118m猫[0m[7m[38;5;237m子[0m[7m[38;5;101m猫[0m[7m[38;5;95m子[0m[7m[38;5;239m猫[0m[7m[38;5;238m子[0m[7m[38;5;237m猫[0m[7m[38;5;235m子[0m[7m[38;5;237m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m
+[0m[7m[38;5;242m猫[0m[7m[38;5;145m子[0m[7m[38;5;144m猫[0m[7m[38;5;101m子[0m[7m[38;5;59m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m[7m[38;5;242m子[0m[7m[38;5;246m猫[0m[7m[38;5;240m子[0m[7m[38;5;236m猫[0m[7m[38;5;237m子[0m[7m[38;5;235m猫[0m[7m[38;5;241m子[0m[7m[38;5;249m猫[0m[7m[38;5;138m子[0m[7m[38;5;138m猫[0m[7m[38;5;244m子[0m[7m[38;5;101m猫[0m[7m[38;5;242m子[0m[7m[38;5;101m猫[0m[7m[38;5;187m子[0m[7m[38;5;138m猫[0m[7m[38;5;233m子[0m[7m[38;5;64m猫[0m[7m[38;5;119m子[0m[7m[38;5;155m猫[0m[7m[38;5;119m子[0m[7m[38;5;119m猫[0m[7m[38;5;70m子[0m[7m[38;5;101m猫[0m[7m[38;5;144m子[0m[7m[38;5;244m猫[0m[7m[38;5;240m子[0m[7m[38;5;240m猫[0m[7m[38;5;241m子[0m[7m[38;5;237m猫[0m[7m[38;5;235m子[0m[7m[38;5;234m猫[0m[7m[38;5;236m子[0m
+[0m[7m[38;5;244m子[0m[7m[38;5;144m猫[0m[7m[38;5;138m子[0m[7m[38;5;138m猫[0m[7m[38;5;101m子[0m[7m[38;5;241m猫[0m[7m[38;5;240m子[0m[7m[38;5;59m猫[0m[7m[38;5;241m子[0m[7m[38;5;244m猫[0m[7m[38;5;102m子[0m[7m[38;5;240m猫[0m[7m[38;5;237m子[0m[7m[38;5;242m猫[0m[7m[38;5;144m子[0m[7m[38;5;144m猫[0m[7m[38;5;102m子[0m[7m[38;5;244m猫[0m[7m[38;5;101m子[0m[7m[38;5;242m猫[0m[7m[38;5;244m子[0m[7m[38;5;187m猫[0m[7m[38;5;239m子[0m[7m[38;5;235m猫[0m[7m[38;5;237m子[0m[7m[38;5;76m猫[0m[7m[38;5;118m子[0m[7m[38;5;113m猫[0m[7m[38;5;64m子[0m[7m[38;5;242m猫[0m[7m[38;5;247m子[0m[7m[38;5;242m猫[0m[7m[38;5;239m子[0m[7m[38;5;240m猫[0m[7m[38;5;239m子[0m[7m[38;5;59m猫[0m[7m[38;5;59m子[0m[7m[38;5;239m猫[0m[7m[38;5;237m子[0m[7m[38;5;235m猫[0m
+[0m[7m[38;5;244m猫[0m[7m[38;5;249m子[0m[7m[38;5;181m猫[0m[7m[38;5;138m子[0m[7m[38;5;101m猫[0m[7m[38;5;59m子[0m[7m[38;5;239m猫[0m[7m[38;5;240m子[0m[7m[38;5;59m猫[0m[7m[38;5;241m子[0m[7m[38;5;101m猫[0m[7m[38;5;144m子[0m[7m[38;5;239m猫[0m[7m[38;5;59m子[0m[7m[38;5;244m猫[0m[7m[38;5;102m子[0m[7m[38;5;101m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m[7m[38;5;138m猫[0m[7m[38;5;144m子[0m[7m[38;5;236m猫[0m[7m[38;5;235m子[0m[7m[38;5;234m猫[0m[7m[38;5;234m子[0m[7m[38;5;236m猫[0m[7m[38;5;238m子[0m[7m[38;5;244m猫[0m[7m[38;5;247m子[0m[7m[38;5;241m猫[0m[7m[38;5;238m子[0m[7m[38;5;238m猫[0m[7m[38;5;240m子[0m[7m[38;5;240m猫[0m[7m[38;5;240m子[0m[7m[38;5;241m猫[0m[7m[38;5;241m子[0m[7m[38;5;239m猫[0m[7m[38;5;234m子[0m
+[0m[7m[38;5;101m子[0m[7m[38;5;101m猫[0m[7m[38;5;144m子[0m[7m[38;5;144m猫[0m[7m[38;5;101m子[0m[7m[38;5;242m猫[0m[7m[38;5;240m子[0m[7m[38;5;240m猫[0m[7m[38;5;240m子[0m[7m[38;5;240m猫[0m[7m[38;5;240m子[0m[7m[38;5;95m猫[0m[7m[38;5;236m子[0m[7m[38;5;237m猫[0m[7m[38;5;101m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;101m子[0m[7m[38;5;243m猫[0m[7m[38;5;243m子[0m[7m[38;5;95m猫[0m[7m[38;5;236m子[0m[7m[38;5;239m猫[0m[7m[38;5;101m子[0m[7m[38;5;242m猫[0m[7m[38;5;102m子[0m[7m[38;5;244m猫[0m[7m[38;5;242m子[0m[7m[38;5;239m猫[0m[7m[38;5;239m子[0m[7m[38;5;238m猫[0m[7m[38;5;238m子[0m[7m[38;5;238m猫[0m[7m[38;5;239m子[0m[7m[38;5;241m猫[0m[7m[38;5;59m子[0m[7m[38;5;241m猫[0m[7m[38;5;239m子[0m[7m[38;5;238m猫[0m
+[0m[7m[38;5;95m猫[0m[7m[38;5;240m子[0m[7m[38;5;238m猫[0m[7m[38;5;101m子[0m[7m[38;5;101m猫[0m[7m[38;5;59m子[0m[7m[38;5;241m猫[0m[7m[38;5;240m子[0m[7m[38;5;59m猫[0m[7m[38;5;241m子[0m[7m[38;5;241m猫[0m[7m[38;5;239m子[0m[7m[38;5;235m猫[0m[7m[38;5;95m子[0m[7m[38;5;101m猫[0m[7m[38;5;244m子[0m[7m[38;5;95m猫[0m[7m[38;5;101m子[0m[7m[38;5;101m猫[0m[7m[38;5;101m子[0m[7m[38;5;95m猫[0m[7m[38;5;236m子[0m[7m[38;5;234m猫[0m[7m[38;5;95m子[0m[7m[38;5;144m猫[0m[7m[38;5;101m子[0m[7m[38;5;240m猫[0m[7m[38;5;59m子[0m[7m[38;5;240m猫[0m[7m[38;5;240m子[0m[7m[38;5;238m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m[7m[38;5;239m子[0m[7m[38;5;240m猫[0m[7m[38;5;241m子[0m[7m[38;5;239m猫[0m[7m[38;5;240m子[0m[7m[38;5;240m猫[0m[7m[38;5;239m子[0m
+[0m[7m[38;5;95m子[0m[7m[38;5;95m猫[0m[7m[38;5;239m子[0m[7m[38;5;95m猫[0m[7m[38;5;102m子[0m[7m[38;5;138m猫[0m[7m[38;5;101m子[0m[7m[38;5;95m猫[0m[7m[38;5;101m子[0m[7m[38;5;102m猫[0m[7m[38;5;241m子[0m[7m[38;5;237m猫[0m[7m[38;5;239m子[0m[7m[38;5;240m猫[0m[7m[38;5;95m子[0m[7m[38;5;101m猫[0m[7m[38;5;101m子[0m[7m[38;5;101m猫[0m[7m[38;5;95m子[0m[7m[38;5;95m猫[0m[7m[38;5;95m子[0m[7m[38;5;237m猫[0m[7m[38;5;233m子[0m[7m[38;5;95m猫[0m[7m[38;5;95m子[0m[7m[38;5;240m猫[0m[7m[38;5;59m子[0m[7m[38;5;59m猫[0m[7m[38;5;240m子[0m[7m[38;5;238m猫[0m[7m[38;5;238m子[0m[7m[38;5;238m猫[0m[7m[38;5;239m子[0m[7m[38;5;241m猫[0m[7m[38;5;241m子[0m[7m[38;5;59m猫[0m[7m[38;5;240m子[0m[7m[38;5;59m猫[0m[7m[38;5;240m子[0m[7m[38;5;59m猫[0m
+[0m[7m[38;5;101m猫[0m[7m[38;5;101m子[0m[7m[38;5;95m猫[0m[7m[38;5;101m子[0m[7m[38;5;101m猫[0m[7m[38;5;101m子[0m[7m[38;5;144m猫[0m[7m[38;5;138m子[0m[7m[38;5;138m猫[0m[7m[38;5;101m子[0m[7m[38;5;239m猫[0m[7m[38;5;238m子[0m[7m[38;5;239m猫[0m[7m[38;5;240m子[0m[7m[38;5;95m猫[0m[7m[38;5;101m子[0m[7m[38;5;101m猫[0m[7m[38;5;95m子[0m[7m[38;5;240m猫[0m[7m[38;5;95m子[0m[7m[38;5;239m猫[0m[7m[38;5;240m子[0m[7m[38;5;234m猫[0m[7m[38;5;240m子[0m[7m[38;5;241m猫[0m[7m[38;5;59m子[0m[7m[38;5;241m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m[7m[38;5;239m子[0m[7m[38;5;238m猫[0m[7m[38;5;238m子[0m[7m[38;5;239m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m[7m[38;5;239m子[0m[7m[38;5;59m猫[0m[7m[38;5;242m子[0m[7m[38;5;59m猫[0m[7m[38;5;240m子[0m
+[0m[7m[38;5;241m子[0m[7m[38;5;243m猫[0m[7m[38;5;101m子[0m[7m[38;5;101m猫[0m[7m[38;5;101m子[0m[7m[38;5;138m猫[0m[7m[38;5;138m子[0m[7m[38;5;144m猫[0m[7m[38;5;95m子[0m[7m[38;5;240m猫[0m[7m[38;5;95m子[0m[7m[38;5;95m猫[0m[7m[38;5;239m子[0m[7m[38;5;240m猫[0m[7m[38;5;95m子[0m[7m[38;5;101m猫[0m[7m[38;5;101m子[0m[7m[38;5;95m猫[0m[7m[38;5;240m子[0m[7m[38;5;238m猫[0m[7m[38;5;237m子[0m[7m[38;5;240m猫[0m[7m[38;5;237m子[0m[7m[38;5;239m猫[0m[7m[38;5;243m子[0m[7m[38;5;101m猫[0m[7m[38;5;240m子[0m[7m[38;5;239m猫[0m[7m[38;5;237m子[0m[7m[38;5;238m猫[0m[7m[38;5;239m子[0m[7m[38;5;240m猫[0m[7m[38;5;59m子[0m[7m[38;5;242m猫[0m[7m[38;5;242m子[0m[7m[38;5;243m猫[0m[7m[38;5;242m子[0m[7m[38;5;242m猫[0m[7m[38;5;242m子[0m[7m[38;5;241m猫[0m
+[0m[7m[38;5;243m猫[0m[7m[38;5;101m子[0m[7m[38;5;101m猫[0m[7m[38;5;101m子[0m[7m[38;5;242m猫[0m[7m[38;5;241m子[0m[7m[38;5;242m猫[0m[7m[38;5;101m子[0m[7m[38;5;238m猫[0m[7m[38;5;95m子[0m[7m[38;5;101m猫[0m[7m[38;5;101m子[0m[7m[38;5;95m猫[0m[7m[38;5;240m子[0m[7m[38;5;95m猫[0m[7m[38;5;101m子[0m[7m[38;5;101m猫[0m[7m[38;5;241m子[0m[7m[38;5;239m猫[0m[7m[38;5;238m子[0m[7m[38;5;238m猫[0m[7m[38;5;95m子[0m[7m[38;5;59m猫[0m[7m[38;5;239m子[0m[7m[38;5;241m猫[0m[7m[38;5;244m子[0m[7m[38;5;243m猫[0m[7m[38;5;239m子[0m[7m[38;5;240m猫[0m[7m[38;5;241m子[0m[7m[38;5;241m猫[0m[7m[38;5;242m子[0m[7m[38;5;242m猫[0m[7m[38;5;243m子[0m[7m[38;5;243m猫[0m[7m[38;5;240m子[0m[7m[38;5;239m猫[0m[7m[38;5;237m子[0m[7m[38;5;236m猫[0m[7m[38;5;238m子[0m
+[0m[7m[38;5;242m子[0m[7m[38;5;95m猫[0m[7m[38;5;59m子[0m[7m[38;5;240m猫[0m[7m[38;5;240m子[0m[7m[38;5;59m猫[0m[7m[38;5;101m子[0m[7m[38;5;144m猫[0m[7m[38;5;241m子[0m[7m[38;5;237m猫[0m[7m[38;5;95m子[0m[7m[38;5;137m猫[0m[7m[38;5;95m子[0m[7m[38;5;95m猫[0m[7m[38;5;95m子[0m[7m[38;5;137m猫[0m[7m[38;5;95m子[0m[7m[38;5;239m猫[0m[7m[38;5;236m子[0m[7m[38;5;238m猫[0m[7m[38;5;95m子[0m[7m[38;5;95m猫[0m[7m[38;5;101m子[0m[7m[38;5;101m猫[0m[7m[38;5;239m子[0m[7m[38;5;238m猫[0m[7m[38;5;95m子[0m[7m[38;5;242m猫[0m[7m[38;5;59m子[0m[7m[38;5;240m猫[0m[7m[38;5;241m子[0m[7m[38;5;242m猫[0m[7m[38;5;241m子[0m[7m[38;5;59m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m[7m[38;5;237m子[0m[7m[38;5;236m猫[0m
+[0m[7m[38;5;242m猫[0m[7m[38;5;244m子[0m[7m[38;5;102m猫[0m[7m[38;5;244m子[0m[7m[38;5;246m猫[0m[7m[38;5;246m子[0m[7m[38;5;247m猫[0m[7m[38;5;246m子[0m[7m[38;5;138m猫[0m[7m[38;5;101m子[0m[7m[38;5;101m猫[0m[7m[38;5;138m子[0m[7m[38;5;181m猫[0m[7m[38;5;138m子[0m[7m[38;5;137m猫[0m[7m[38;5;174m子[0m[7m[38;5;131m猫[0m[7m[38;5;95m子[0m[7m[38;5;238m猫[0m[7m[38;5;95m子[0m[7m[38;5;101m猫[0m[7m[38;5;95m子[0m[7m[38;5;101m猫[0m[7m[38;5;59m子[0m[7m[38;5;237m猫[0m[7m[38;5;235m子[0m[7m[38;5;237m猫[0m[7m[38;5;239m子[0m[7m[38;5;59m猫[0m[7m[38;5;59m子[0m[7m[38;5;59m猫[0m[7m[38;5;242m子[0m[7m[38;5;59m猫[0m[7m[38;5;241m子[0m[7m[38;5;59m猫[0m[7m[38;5;59m子[0m[7m[38;5;239m猫[0m[7m[38;5;238m子[0m[7m[38;5;240m猫[0m[7m[38;5;239m子[0m
+[0m[7m[38;5;244m子[0m[7m[38;5;102m猫[0m[7m[38;5;244m子[0m[7m[38;5;243m猫[0m[7m[38;5;243m子[0m[7m[38;5;243m猫[0m[7m[38;5;247m子[0m[7m[38;5;144m猫[0m[7m[38;5;59m子[0m[7m[38;5;238m猫[0m[7m[38;5;95m子[0m[7m[38;5;144m猫[0m[7m[38;5;252m子[0m[7m[38;5;253m猫[0m[7m[38;5;102m子[0m[7m[38;5;137m猫[0m[7m[38;5;95m子[0m[7m[38;5;242m猫[0m[7m[38;5;250m子[0m[7m[38;5;249m猫[0m[7m[38;5;138m子[0m[7m[38;5;101m猫[0m[7m[38;5;239m子[0m[7m[38;5;236m猫[0m[7m[38;5;237m子[0m[7m[38;5;237m猫[0m[7m[38;5;237m子[0m[7m[38;5;238m猫[0m[7m[38;5;237m子[0m[7m[38;5;59m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m[7m[38;5;243m猫[0m[7m[38;5;243m子[0m[7m[38;5;243m猫[0m[7m[38;5;242m子[0m[7m[38;5;241m猫[0m[7m[38;5;240m子[0m[7m[38;5;239m猫[0m
+[0m[7m[38;5;242m猫[0m[7m[38;5;243m子[0m[7m[38;5;242m猫[0m[7m[38;5;59m子[0m[7m[38;5;59m猫[0m[7m[38;5;241m子[0m[7m[38;5;102m猫[0m[7m[38;5;144m子[0m[7m[38;5;138m猫[0m[7m[38;5;138m子[0m[7m[38;5;138m猫[0m[7m[38;5;144m子[0m[7m[38;5;251m猫[0m[7m[38;5;254m子[0m[7m[38;5;250m猫[0m[7m[38;5;238m子[0m[7m[38;5;95m猫[0m[7m[38;5;188m子[0m[7m[38;5;253m猫[0m[7m[38;5;250m子[0m[7m[38;5;138m猫[0m[7m[38;5;95m子[0m[7m[38;5;59m猫[0m[7m[38;5;95m子[0m[7m[38;5;243m猫[0m[7m[38;5;244m子[0m[7m[38;5;102m猫[0m[7m[38;5;246m子[0m[7m[38;5;243m猫[0m[7m[38;5;241m子[0m[7m[38;5;243m猫[0m[7m[38;5;243m子[0m[7m[38;5;243m猫[0m[7m[38;5;242m子[0m[7m[38;5;59m猫[0m[7m[38;5;240m子[0m[7m[38;5;239m猫[0m[7m[38;5;239m子[0m[7m[38;5;238m猫[0m[7m[38;5;238m子[0m
+[0m[7m[38;5;236m子[0m[7m[38;5;237m猫[0m[7m[38;5;239m子[0m[7m[38;5;241m猫[0m[7m[38;5;243m子[0m[7m[38;5;247m猫[0m[7m[38;5;248m子[0m[7m[38;5;247m猫[0m[7m[38;5;145m子[0m[7m[38;5;144m猫[0m[7m[38;5;249m子[0m[7m[38;5;252m猫[0m[7m[38;5;252m子[0m[7m[38;5;252m猫[0m[7m[38;5;251m子[0m[7m[38;5;242m猫[0m[7m[38;5;247m子[0m[7m[38;5;253m猫[0m[7m[38;5;188m子[0m[7m[38;5;251m猫[0m[7m[38;5;138m子[0m[7m[38;5;241m猫[0m[7m[38;5;59m子[0m[7m[38;5;240m猫[0m[7m[38;5;238m子[0m[7m[38;5;240m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;244m子[0m[7m[38;5;244m猫[0m[7m[38;5;244m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m[7m[38;5;242m猫[0m[7m[38;5;59m子[0m[7m[38;5;238m猫[0m[7m[38;5;238m子[0m[7m[38;5;237m猫[0m[7m[38;5;236m子[0m[7m[38;5;237m猫[0m
+[0m[7m[38;5;239m猫[0m[7m[38;5;240m子[0m[7m[38;5;242m猫[0m[7m[38;5;102m子[0m[7m[38;5;244m猫[0m[7m[38;5;241m子[0m[7m[38;5;239m猫[0m[7m[38;5;240m子[0m[7m[38;5;243m猫[0m[7m[38;5;102m子[0m[7m[38;5;250m猫[0m[7m[38;5;252m子[0m[7m[38;5;251m猫[0m[7m[38;5;250m子[0m[7m[38;5;248m猫[0m[7m[38;5;243m子[0m[7m[38;5;102m猫[0m[7m[38;5;247m子[0m[7m[38;5;145m猫[0m[7m[38;5;247m子[0m[7m[38;5;248m猫[0m[7m[38;5;102m子[0m[7m[38;5;243m猫[0m[7m[38;5;242m子[0m[7m[38;5;95m猫[0m[7m[38;5;241m子[0m[7m[38;5;95m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;102m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m[7m[38;5;242m猫[0m[7m[38;5;242m子[0m[7m[38;5;241m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m[7m[38;5;59m子[0m[7m[38;5;239m猫[0m[7m[38;5;238m子[0m
+[0m[7m[38;5;242m子[0m[7m[38;5;243m猫[0m[7m[38;5;59m子[0m[7m[38;5;237m猫[0m[7m[38;5;237m子[0m[7m[38;5;237m猫[0m[7m[38;5;238m子[0m[7m[38;5;242m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;246m子[0m[7m[38;5;249m猫[0m[7m[38;5;251m子[0m[7m[38;5;250m猫[0m[7m[38;5;248m子[0m[7m[38;5;243m猫[0m[7m[38;5;240m子[0m[7m[38;5;246m猫[0m[7m[38;5;249m子[0m[7m[38;5;145m猫[0m[7m[38;5;248m子[0m[7m[38;5;248m猫[0m[7m[38;5;246m子[0m[7m[38;5;244m猫[0m[7m[38;5;244m子[0m[7m[38;5;243m猫[0m[7m[38;5;244m子[0m[7m[38;5;102m猫[0m[7m[38;5;243m子[0m[7m[38;5;243m猫[0m[7m[38;5;242m子[0m[7m[38;5;243m猫[0m[7m[38;5;243m子[0m[7m[38;5;243m猫[0m[7m[38;5;241m子[0m[7m[38;5;237m猫[0m[7m[38;5;236m子[0m[7m[38;5;238m猫[0m[7m[38;5;239m子[0m[7m[38;5;237m猫[0m
+[0m[7m[38;5;239m猫[0m[7m[38;5;238m子[0m[7m[38;5;238m猫[0m[7m[38;5;238m子[0m[7m[38;5;237m猫[0m[7m[38;5;238m子[0m[7m[38;5;241m猫[0m[7m[38;5;242m子[0m[7m[38;5;242m猫[0m[7m[38;5;244m子[0m[7m[38;5;242m猫[0m[7m[38;5;59m子[0m[7m[38;5;247m猫[0m[7m[38;5;251m子[0m[7m[38;5;250m猫[0m[7m[38;5;246m子[0m[7m[38;5;242m猫[0m[7m[38;5;243m子[0m[7m[38;5;102m猫[0m[7m[38;5;247m子[0m[7m[38;5;247m猫[0m[7m[38;5;247m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m[7m[38;5;242m猫[0m[7m[38;5;243m子[0m[7m[38;5;242m猫[0m[7m[38;5;243m子[0m[7m[38;5;242m猫[0m[7m[38;5;242m子[0m[7m[38;5;242m猫[0m[7m[38;5;59m子[0m[7m[38;5;240m猫[0m[7m[38;5;240m子[0m[7m[38;5;59m猫[0m[7m[38;5;238m子[0m[7m[38;5;237m猫[0m[7m[38;5;240m子[0m[7m[38;5;240m猫[0m[7m[38;5;239m子[0m
+[0m[7m[38;5;239m子[0m[7m[38;5;238m猫[0m[7m[38;5;238m子[0m[7m[38;5;240m猫[0m[7m[38;5;59m子[0m[7m[38;5;240m猫[0m[7m[38;5;241m子[0m[7m[38;5;241m猫[0m[7m[38;5;243m子[0m[7m[38;5;59m猫[0m[7m[38;5;238m子[0m[7m[38;5;237m猫[0m[7m[38;5;242m子[0m[7m[38;5;145m猫[0m[7m[38;5;251m子[0m[7m[38;5;251m猫[0m[7m[38;5;248m子[0m[7m[38;5;247m猫[0m[7m[38;5;247m子[0m[7m[38;5;248m猫[0m[7m[38;5;248m子[0m[7m[38;5;246m猫[0m[7m[38;5;246m子[0m[7m[38;5;102m猫[0m[7m[38;5;243m子[0m[7m[38;5;241m猫[0m[7m[38;5;59m子[0m[7m[38;5;242m猫[0m[7m[38;5;242m子[0m[7m[38;5;239m猫[0m[7m[38;5;59m子[0m[7m[38;5;243m猫[0m[7m[38;5;59m子[0m[7m[38;5;59m猫[0m[7m[38;5;241m子[0m[7m[38;5;235m猫[0m[7m[38;5;233m子[0m[7m[38;5;236m猫[0m[7m[38;5;238m子[0m[7m[38;5;59m猫[0m
+[0m[7m[38;5;238m猫[0m[7m[38;5;239m子[0m[7m[38;5;59m猫[0m[7m[38;5;59m子[0m[7m[38;5;240m猫[0m[7m[38;5;59m子[0m[7m[38;5;59m猫[0m[7m[38;5;241m子[0m[7m[38;5;239m猫[0m[7m[38;5;237m子[0m[7m[38;5;238m猫[0m[7m[38;5;239m子[0m[7m[38;5;238m猫[0m[7m[38;5;59m子[0m[7m[38;5;243m猫[0m[7m[38;5;251m子[0m[7m[38;5;252m猫[0m[7m[38;5;251m子[0m[7m[38;5;250m猫[0m[7m[38;5;249m子[0m[7m[38;5;145m猫[0m[7m[38;5;247m子[0m[7m[38;5;102m猫[0m[7m[38;5;241m子[0m[7m[38;5;238m猫[0m[7m[38;5;238m子[0m[7m[38;5;238m猫[0m[7m[38;5;239m子[0m[7m[38;5;59m猫[0m[7m[38;5;241m子[0m[7m[38;5;240m猫[0m[7m[38;5;242m子[0m[7m[38;5;238m猫[0m[7m[38;5;59m子[0m[7m[38;5;241m猫[0m[7m[38;5;236m子[0m[7m[38;5;234m猫[0m[7m[38;5;234m子[0m[7m[38;5;236m猫[0m[7m[38;5;239m子[0m
+[0m[7m[38;5;237m子[0m[7m[38;5;237m猫[0m[7m[38;5;237m子[0m[7m[38;5;239m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m[7m[38;5;238m子[0m[7m[38;5;238m猫[0m[7m[38;5;237m子[0m[7m[38;5;238m猫[0m[7m[38;5;238m子[0m[7m[38;5;235m猫[0m[7m[38;5;235m子[0m[7m[38;5;239m猫[0m[7m[38;5;238m子[0m[7m[38;5;242m猫[0m[7m[38;5;247m子[0m[7m[38;5;145m猫[0m[7m[38;5;248m子[0m[7m[38;5;246m猫[0m[7m[38;5;243m子[0m[7m[38;5;240m猫[0m[7m[38;5;238m子[0m[7m[38;5;238m猫[0m[7m[38;5;236m子[0m[7m[38;5;237m猫[0m[7m[38;5;237m子[0m[7m[38;5;237m猫[0m[7m[38;5;237m子[0m[7m[38;5;242m猫[0m[7m[38;5;238m子[0m[7m[38;5;59m猫[0m[7m[38;5;236m子[0m[7m[38;5;239m猫[0m[7m[38;5;239m子[0m[7m[38;5;235m猫[0m[7m[38;5;233m子[0m[7m[38;5;234m猫[0m[7m[38;5;236m子[0m[7m[38;5;238m猫[0m
+[0m[7m[38;5;235m猫[0m[7m[38;5;236m子[0m[7m[38;5;237m猫[0m[7m[38;5;238m子[0m[7m[38;5;237m猫[0m[7m[38;5;237m子[0m[7m[38;5;236m猫[0m[7m[38;5;237m子[0m[7m[38;5;237m猫[0m[7m[38;5;236m子[0m[7m[38;5;235m猫[0m[7m[38;5;234m子[0m[7m[38;5;236m猫[0m[7m[38;5;236m子[0m[7m[38;5;235m猫[0m[7m[38;5;238m子[0m[7m[38;5;239m猫[0m[7m[38;5;239m子[0m[7m[38;5;238m猫[0m[7m[38;5;237m子[0m[7m[38;5;240m猫[0m[7m[38;5;237m子[0m[7m[38;5;235m猫[0m[7m[38;5;237m子[0m[7m[38;5;237m猫[0m[7m[38;5;237m子[0m[7m[38;5;237m猫[0m[7m[38;5;235m子[0m[7m[38;5;238m猫[0m[7m[38;5;241m子[0m[7m[38;5;235m猫[0m[7m[38;5;239m子[0m[7m[38;5;235m猫[0m[7m[38;5;237m子[0m[7m[38;5;238m猫[0m[7m[38;5;234m子[0m[7m[38;5;232m猫[0m[7m[38;5;233m子[0m[7m[38;5;234m猫[0m[7m[38;5;236m子[0m
+[0m[7m[38;5;235m子[0m[7m[38;5;236m猫[0m[7m[38;5;237m子[0m[7m[38;5;238m猫[0m[7m[38;5;236m子[0m[7m[38;5;236m猫[0m[7m[38;5;236m子[0m[7m[38;5;237m猫[0m[7m[38;5;237m子[0m[7m[38;5;235m猫[0m[7m[38;5;235m子[0m[7m[38;5;234m猫[0m[7m[38;5;235m子[0m[7m[38;5;235m猫[0m[7m[38;5;234m子[0m[7m[38;5;240m猫[0m[7m[38;5;237m子[0m[7m[38;5;235m猫[0m[7m[38;5;234m子[0m[7m[38;5;235m猫[0m[7m[38;5;239m子[0m[7m[38;5;236m猫[0m[7m[38;5;236m子[0m[7m[38;5;233m猫[0m[7m[38;5;236m子[0m[7m[38;5;238m猫[0m[7m[38;5;235m子[0m[7m[38;5;235m猫[0m[7m[38;5;239m子[0m[7m[38;5;238m猫[0m[7m[38;5;235m子[0m[7m[38;5;237m猫[0m[7m[38;5;235m子[0m[7m[38;5;237m猫[0m[7m[38;5;236m子[0m[7m[38;5;235m猫[0m[7m[38;5;233m子[0m[7m[38;5;233m猫[0m[7m[38;5;234m子[0m[7m[38;5;235m猫[0m
+[0m[7m[38;5;235m猫[0m[7m[38;5;236m子[0m[7m[38;5;236m猫[0m[7m[38;5;238m子[0m[7m[38;5;235m猫[0m[7m[38;5;235m子[0m[7m[38;5;236m猫[0m[7m[38;5;237m子[0m[7m[38;5;236m猫[0m[7m[38;5;235m子[0m[7m[38;5;234m猫[0m[7m[38;5;235m子[0m[7m[38;5;235m猫[0m[7m[38;5;234m子[0m[7m[38;5;236m猫[0m[7m[38;5;239m子[0m[7m[38;5;236m猫[0m[7m[38;5;234m子[0m[7m[38;5;234m猫[0m[7m[38;5;237m子[0m[7m[38;5;238m猫[0m[7m[38;5;235m子[0m[7m[38;5;232m猫[0m[7m[38;5;234m子[0m[7m[38;5;237m猫[0m[7m[38;5;236m子[0m[7m[38;5;234m猫[0m[7m[38;5;236m子[0m[7m[38;5;239m猫[0m[7m[38;5;236m子[0m[7m[38;5;234m猫[0m[7m[38;5;236m子[0m[7m[38;5;236m猫[0m[7m[38;5;235m子[0m[7m[38;5;235m猫[0m[7m[38;5;235m子[0m[7m[38;5;233m猫[0m[7m[38;5;233m子[0m[7m[38;5;233m猫[0m[7m[38;5;235m子[0m
diff --git a/nya/tabby.cat b/nya/tabby.cat
new file mode 100644
--- /dev/null
+++ b/nya/tabby.cat
@@ -0,0 +1,40 @@
+[0m[7m[38;5;246m子[0m[7m[38;5;248m猫[0m[7m[38;5;252m子[0m[7m[38;5;188m猫[0m[7m[38;5;252m子[0m[7m[38;5;252m猫[0m[7m[38;5;251m子[0m[7m[38;5;249m猫[0m[7m[38;5;249m子[0m[7m[38;5;246m猫[0m[7m[38;5;248m子[0m[7m[38;5;248m猫[0m[7m[38;5;247m子[0m[7m[38;5;246m猫[0m[7m[38;5;102m子[0m[7m[38;5;240m猫[0m[7m[38;5;236m子[0m[7m[38;5;233m猫[0m[7m[38;5;59m子[0m[7m[38;5;235m猫[0m[7m[38;5;235m子[0m[7m[38;5;236m猫[0m[7m[38;5;235m子[0m[7m[38;5;246m猫[0m[7m[38;5;59m子[0m[7m[38;5;237m猫[0m[7m[38;5;244m子[0m[7m[38;5;244m猫[0m[7m[38;5;251m子[0m[7m[38;5;145m猫[0m[7m[38;5;188m子[0m[7m[38;5;250m猫[0m[7m[38;5;253m子[0m[7m[38;5;254m猫[0m[7m[38;5;254m子[0m[7m[38;5;253m猫[0m[7m[38;5;254m子[0m[7m[38;5;253m猫[0m[7m[38;5;252m子[0m[7m[38;5;250m猫[0m
+[0m[7m[38;5;145m猫[0m[7m[38;5;251m子[0m[7m[38;5;252m猫[0m[7m[38;5;253m子[0m[7m[38;5;188m猫[0m[7m[38;5;251m子[0m[7m[38;5;249m猫[0m[7m[38;5;249m子[0m[7m[38;5;248m猫[0m[7m[38;5;244m子[0m[7m[38;5;247m猫[0m[7m[38;5;249m子[0m[7m[38;5;249m猫[0m[7m[38;5;243m子[0m[7m[38;5;243m猫[0m[7m[38;5;243m子[0m[7m[38;5;239m猫[0m[7m[38;5;234m子[0m[7m[38;5;236m猫[0m[7m[38;5;236m子[0m[7m[38;5;233m猫[0m[7m[38;5;235m子[0m[7m[38;5;233m猫[0m[7m[38;5;244m子[0m[7m[38;5;238m猫[0m[7m[38;5;246m子[0m[7m[38;5;250m猫[0m[7m[38;5;246m子[0m[7m[38;5;247m猫[0m[7m[38;5;252m子[0m[7m[38;5;250m猫[0m[7m[38;5;250m子[0m[7m[38;5;188m猫[0m[7m[38;5;188m子[0m[7m[38;5;254m猫[0m[7m[38;5;253m子[0m[7m[38;5;254m猫[0m[7m[38;5;254m子[0m[7m[38;5;254m猫[0m[7m[38;5;188m子[0m
+[0m[7m[38;5;145m子[0m[7m[38;5;145m猫[0m[7m[38;5;251m子[0m[7m[38;5;188m猫[0m[7m[38;5;252m子[0m[7m[38;5;188m猫[0m[7m[38;5;145m子[0m[7m[38;5;246m猫[0m[7m[38;5;244m子[0m[7m[38;5;247m猫[0m[7m[38;5;145m子[0m[7m[38;5;250m猫[0m[7m[38;5;247m子[0m[7m[38;5;240m猫[0m[7m[38;5;239m子[0m[7m[38;5;247m猫[0m[7m[38;5;250m子[0m[7m[38;5;239m猫[0m[7m[38;5;238m子[0m[7m[38;5;59m猫[0m[7m[38;5;235m子[0m[7m[38;5;234m猫[0m[7m[38;5;233m子[0m[7m[38;5;243m猫[0m[7m[38;5;237m子[0m[7m[38;5;251m猫[0m[7m[38;5;188m子[0m[7m[38;5;246m猫[0m[7m[38;5;244m子[0m[7m[38;5;251m猫[0m[7m[38;5;249m子[0m[7m[38;5;249m猫[0m[7m[38;5;250m子[0m[7m[38;5;253m猫[0m[7m[38;5;253m子[0m[7m[38;5;253m猫[0m[7m[38;5;254m子[0m[7m[38;5;254m猫[0m[7m[38;5;254m子[0m[7m[38;5;253m猫[0m
+[0m[7m[38;5;252m猫[0m[7m[38;5;249m子[0m[7m[38;5;249m猫[0m[7m[38;5;250m子[0m[7m[38;5;252m猫[0m[7m[38;5;248m子[0m[7m[38;5;244m猫[0m[7m[38;5;59m子[0m[7m[38;5;242m猫[0m[7m[38;5;242m子[0m[7m[38;5;250m猫[0m[7m[38;5;251m子[0m[7m[38;5;244m猫[0m[7m[38;5;240m子[0m[7m[38;5;59m猫[0m[7m[38;5;250m子[0m[7m[38;5;252m猫[0m[7m[38;5;244m子[0m[7m[38;5;239m猫[0m[7m[38;5;239m子[0m[7m[38;5;236m猫[0m[7m[38;5;233m子[0m[7m[38;5;233m猫[0m[7m[38;5;236m子[0m[7m[38;5;235m猫[0m[7m[38;5;251m子[0m[7m[38;5;252m猫[0m[7m[38;5;242m子[0m[7m[38;5;242m猫[0m[7m[38;5;246m子[0m[7m[38;5;254m猫[0m[7m[38;5;251m子[0m[7m[38;5;248m猫[0m[7m[38;5;251m子[0m[7m[38;5;252m猫[0m[7m[38;5;255m子[0m[7m[38;5;255m猫[0m[7m[38;5;254m子[0m[7m[38;5;254m猫[0m[7m[38;5;254m子[0m
+[0m[7m[38;5;249m子[0m[7m[38;5;145m猫[0m[7m[38;5;247m子[0m[7m[38;5;247m猫[0m[7m[38;5;247m子[0m[7m[38;5;247m猫[0m[7m[38;5;145m子[0m[7m[38;5;248m猫[0m[7m[38;5;244m子[0m[7m[38;5;244m猫[0m[7m[38;5;248m子[0m[7m[38;5;251m猫[0m[7m[38;5;244m子[0m[7m[38;5;240m猫[0m[7m[38;5;246m子[0m[7m[38;5;250m猫[0m[7m[38;5;252m子[0m[7m[38;5;247m猫[0m[7m[38;5;239m子[0m[7m[38;5;235m猫[0m[7m[38;5;233m子[0m[7m[38;5;232m猫[0m[7m[38;5;234m子[0m[7m[38;5;233m猫[0m[7m[38;5;241m子[0m[7m[38;5;253m猫[0m[7m[38;5;252m子[0m[7m[38;5;242m猫[0m[7m[38;5;240m子[0m[7m[38;5;145m猫[0m[7m[38;5;254m子[0m[7m[38;5;251m猫[0m[7m[38;5;246m子[0m[7m[38;5;247m猫[0m[7m[38;5;251m子[0m[7m[38;5;254m猫[0m[7m[38;5;255m子[0m[7m[38;5;255m猫[0m[7m[38;5;255m子[0m[7m[38;5;255m猫[0m
+[0m[7m[38;5;246m猫[0m[7m[38;5;246m子[0m[7m[38;5;244m猫[0m[7m[38;5;102m子[0m[7m[38;5;248m猫[0m[7m[38;5;251m子[0m[7m[38;5;249m猫[0m[7m[38;5;249m子[0m[7m[38;5;247m猫[0m[7m[38;5;242m子[0m[7m[38;5;247m猫[0m[7m[38;5;251m子[0m[7m[38;5;244m猫[0m[7m[38;5;240m子[0m[7m[38;5;247m猫[0m[7m[38;5;252m子[0m[7m[38;5;188m猫[0m[7m[38;5;246m子[0m[7m[38;5;233m猫[0m[7m[38;5;233m子[0m[7m[38;5;232m猫[0m[7m[38;5;232m子[0m[7m[38;5;233m猫[0m[7m[38;5;234m子[0m[7m[38;5;244m猫[0m[7m[38;5;253m子[0m[7m[38;5;254m猫[0m[7m[38;5;244m子[0m[7m[38;5;241m猫[0m[7m[38;5;248m子[0m[7m[38;5;255m猫[0m[7m[38;5;249m子[0m[7m[38;5;102m猫[0m[7m[38;5;243m子[0m[7m[38;5;246m猫[0m[7m[38;5;251m子[0m[7m[38;5;253m猫[0m[7m[38;5;254m子[0m[7m[38;5;254m猫[0m[7m[38;5;253m子[0m
+[0m[7m[38;5;236m子[0m[7m[38;5;235m猫[0m[7m[38;5;237m子[0m[7m[38;5;239m猫[0m[7m[38;5;243m子[0m[7m[38;5;241m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m[7m[38;5;243m猫[0m[7m[38;5;247m子[0m[7m[38;5;250m猫[0m[7m[38;5;242m子[0m[7m[38;5;59m猫[0m[7m[38;5;247m子[0m[7m[38;5;252m猫[0m[7m[38;5;188m子[0m[7m[38;5;247m猫[0m[7m[38;5;234m子[0m[7m[38;5;235m猫[0m[7m[38;5;232m子[0m[7m[38;5;232m猫[0m[7m[38;5;233m子[0m[7m[38;5;236m猫[0m[7m[38;5;248m子[0m[7m[38;5;254m猫[0m[7m[38;5;188m子[0m[7m[38;5;244m猫[0m[7m[38;5;59m子[0m[7m[38;5;251m猫[0m[7m[38;5;253m子[0m[7m[38;5;145m猫[0m[7m[38;5;244m子[0m[7m[38;5;145m猫[0m[7m[38;5;249m子[0m[7m[38;5;250m猫[0m[7m[38;5;249m子[0m[7m[38;5;250m猫[0m[7m[38;5;188m子[0m[7m[38;5;252m猫[0m
+[0m[7m[38;5;235m猫[0m[7m[38;5;236m子[0m[7m[38;5;236m猫[0m[7m[38;5;239m子[0m[7m[38;5;238m猫[0m[7m[38;5;235m子[0m[7m[38;5;137m猫[0m[7m[38;5;240m子[0m[7m[38;5;234m猫[0m[7m[38;5;237m子[0m[7m[38;5;243m猫[0m[7m[38;5;249m子[0m[7m[38;5;247m猫[0m[7m[38;5;238m子[0m[7m[38;5;248m猫[0m[7m[38;5;250m子[0m[7m[38;5;250m猫[0m[7m[38;5;102m子[0m[7m[38;5;238m猫[0m[7m[38;5;234m子[0m[7m[38;5;232m猫[0m[7m[38;5;232m子[0m[7m[38;5;234m猫[0m[7m[38;5;235m子[0m[7m[38;5;145m猫[0m[7m[38;5;252m子[0m[7m[38;5;252m猫[0m[7m[38;5;246m子[0m[7m[38;5;242m猫[0m[7m[38;5;188m子[0m[7m[38;5;253m猫[0m[7m[38;5;249m子[0m[7m[38;5;249m猫[0m[7m[38;5;251m子[0m[7m[38;5;250m猫[0m[7m[38;5;252m子[0m[7m[38;5;252m猫[0m[7m[38;5;252m子[0m[7m[38;5;250m猫[0m[7m[38;5;253m子[0m
+[0m[7m[38;5;238m子[0m[7m[38;5;246m猫[0m[7m[38;5;102m子[0m[7m[38;5;243m猫[0m[7m[38;5;239m子[0m[7m[38;5;234m猫[0m[7m[38;5;137m子[0m[7m[38;5;101m猫[0m[7m[38;5;233m子[0m[7m[38;5;241m猫[0m[7m[38;5;244m子[0m[7m[38;5;101m猫[0m[7m[38;5;247m子[0m[7m[38;5;244m猫[0m[7m[38;5;250m子[0m[7m[38;5;249m猫[0m[7m[38;5;244m子[0m[7m[38;5;243m猫[0m[7m[38;5;240m子[0m[7m[38;5;235m猫[0m[7m[38;5;232m子[0m[7m[38;5;233m猫[0m[7m[38;5;238m子[0m[7m[38;5;59m猫[0m[7m[38;5;244m子[0m[7m[38;5;248m猫[0m[7m[38;5;251m子[0m[7m[38;5;242m猫[0m[7m[38;5;102m子[0m[7m[38;5;252m猫[0m[7m[38;5;251m子[0m[7m[38;5;247m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;248m子[0m[7m[38;5;188m猫[0m[7m[38;5;252m子[0m[7m[38;5;251m猫[0m[7m[38;5;252m子[0m[7m[38;5;254m猫[0m
+[0m[7m[38;5;59m猫[0m[7m[38;5;248m子[0m[7m[38;5;246m猫[0m[7m[38;5;244m子[0m[7m[38;5;242m猫[0m[7m[38;5;232m子[0m[7m[38;5;94m猫[0m[7m[38;5;240m子[0m[7m[38;5;234m猫[0m[7m[38;5;233m子[0m[7m[38;5;240m猫[0m[7m[38;5;137m子[0m[7m[38;5;101m猫[0m[7m[38;5;247m子[0m[7m[38;5;251m猫[0m[7m[38;5;145m子[0m[7m[38;5;240m猫[0m[7m[38;5;238m子[0m[7m[38;5;240m猫[0m[7m[38;5;240m子[0m[7m[38;5;234m猫[0m[7m[38;5;236m子[0m[7m[38;5;239m猫[0m[7m[38;5;240m子[0m[7m[38;5;242m猫[0m[7m[38;5;247m子[0m[7m[38;5;250m猫[0m[7m[38;5;145m子[0m[7m[38;5;250m猫[0m[7m[38;5;244m子[0m[7m[38;5;236m猫[0m[7m[38;5;238m子[0m[7m[38;5;107m猫[0m[7m[38;5;137m子[0m[7m[38;5;237m猫[0m[7m[38;5;235m子[0m[7m[38;5;244m猫[0m[7m[38;5;246m子[0m[7m[38;5;247m猫[0m[7m[38;5;247m子[0m
+[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;246m子[0m[7m[38;5;247m猫[0m[7m[38;5;248m子[0m[7m[38;5;233m猫[0m[7m[38;5;58m子[0m[7m[38;5;58m猫[0m[7m[38;5;235m子[0m[7m[38;5;237m猫[0m[7m[38;5;101m子[0m[7m[38;5;143m猫[0m[7m[38;5;101m子[0m[7m[38;5;238m猫[0m[7m[38;5;252m子[0m[7m[38;5;248m猫[0m[7m[38;5;59m子[0m[7m[38;5;238m猫[0m[7m[38;5;240m子[0m[7m[38;5;237m猫[0m[7m[38;5;235m子[0m[7m[38;5;236m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m[7m[38;5;240m子[0m[7m[38;5;252m猫[0m[7m[38;5;253m子[0m[7m[38;5;247m猫[0m[7m[38;5;238m子[0m[7m[38;5;235m猫[0m[7m[38;5;236m子[0m[7m[38;5;248m猫[0m[7m[38;5;188m子[0m[7m[38;5;186m猫[0m[7m[38;5;240m子[0m[7m[38;5;237m猫[0m[7m[38;5;251m子[0m[7m[38;5;246m猫[0m[7m[38;5;237m子[0m[7m[38;5;235m猫[0m
+[0m[7m[38;5;102m猫[0m[7m[38;5;247m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m[7m[38;5;248m猫[0m[7m[38;5;242m子[0m[7m[38;5;233m猫[0m[7m[38;5;236m子[0m[7m[38;5;58m猫[0m[7m[38;5;100m子[0m[7m[38;5;101m猫[0m[7m[38;5;100m子[0m[7m[38;5;236m猫[0m[7m[38;5;232m子[0m[7m[38;5;249m猫[0m[7m[38;5;250m子[0m[7m[38;5;243m猫[0m[7m[38;5;242m子[0m[7m[38;5;242m猫[0m[7m[38;5;240m子[0m[7m[38;5;237m猫[0m[7m[38;5;239m子[0m[7m[38;5;242m猫[0m[7m[38;5;102m子[0m[7m[38;5;248m猫[0m[7m[38;5;254m子[0m[7m[38;5;249m猫[0m[7m[38;5;101m子[0m[7m[38;5;101m猫[0m[7m[38;5;239m子[0m[7m[38;5;234m猫[0m[7m[38;5;238m子[0m[7m[38;5;186m猫[0m[7m[38;5;186m子[0m[7m[38;5;237m猫[0m[7m[38;5;240m子[0m[7m[38;5;254m猫[0m[7m[38;5;253m子[0m[7m[38;5;248m猫[0m[7m[38;5;236m子[0m
+[0m[7m[38;5;247m子[0m[7m[38;5;249m猫[0m[7m[38;5;243m子[0m[7m[38;5;239m猫[0m[7m[38;5;241m子[0m[7m[38;5;145m猫[0m[7m[38;5;238m子[0m[7m[38;5;232m猫[0m[7m[38;5;234m子[0m[7m[38;5;236m猫[0m[7m[38;5;58m子[0m[7m[38;5;235m猫[0m[7m[38;5;232m子[0m[7m[38;5;16m猫[0m[7m[38;5;242m子[0m[7m[38;5;249m猫[0m[7m[38;5;242m子[0m[7m[38;5;241m猫[0m[7m[38;5;241m子[0m[7m[38;5;239m猫[0m[7m[38;5;239m子[0m[7m[38;5;241m猫[0m[7m[38;5;243m子[0m[7m[38;5;240m猫[0m[7m[38;5;250m子[0m[7m[38;5;188m猫[0m[7m[38;5;238m子[0m[7m[38;5;101m猫[0m[7m[38;5;100m子[0m[7m[38;5;101m猫[0m[7m[38;5;235m子[0m[7m[38;5;107m猫[0m[7m[38;5;185m子[0m[7m[38;5;143m猫[0m[7m[38;5;233m子[0m[7m[38;5;250m猫[0m[7m[38;5;254m子[0m[7m[38;5;188m猫[0m[7m[38;5;253m子[0m[7m[38;5;102m猫[0m
+[0m[7m[38;5;244m猫[0m[7m[38;5;248m子[0m[7m[38;5;243m猫[0m[7m[38;5;240m子[0m[7m[38;5;236m猫[0m[7m[38;5;236m子[0m[7m[38;5;244m猫[0m[7m[38;5;242m子[0m[7m[38;5;234m猫[0m[7m[38;5;232m子[0m[7m[38;5;16m猫[0m[7m[38;5;16m子[0m[7m[38;5;16m猫[0m[7m[38;5;232m子[0m[7m[38;5;239m猫[0m[7m[38;5;247m子[0m[7m[38;5;243m猫[0m[7m[38;5;59m子[0m[7m[38;5;240m猫[0m[7m[38;5;242m子[0m[7m[38;5;59m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;247m子[0m[7m[38;5;188m猫[0m[7m[38;5;249m子[0m[7m[38;5;232m猫[0m[7m[38;5;235m子[0m[7m[38;5;143m猫[0m[7m[38;5;100m子[0m[7m[38;5;101m猫[0m[7m[38;5;143m子[0m[7m[38;5;101m猫[0m[7m[38;5;234m子[0m[7m[38;5;243m猫[0m[7m[38;5;255m子[0m[7m[38;5;188m猫[0m[7m[38;5;252m子[0m[7m[38;5;251m猫[0m[7m[38;5;244m子[0m
+[0m[7m[38;5;248m子[0m[7m[38;5;246m猫[0m[7m[38;5;249m子[0m[7m[38;5;59m猫[0m[7m[38;5;236m子[0m[7m[38;5;235m猫[0m[7m[38;5;234m子[0m[7m[38;5;239m猫[0m[7m[38;5;244m子[0m[7m[38;5;241m猫[0m[7m[38;5;239m子[0m[7m[38;5;236m猫[0m[7m[38;5;234m子[0m[7m[38;5;232m猫[0m[7m[38;5;236m子[0m[7m[38;5;247m猫[0m[7m[38;5;241m子[0m[7m[38;5;59m猫[0m[7m[38;5;243m子[0m[7m[38;5;242m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;244m子[0m[7m[38;5;248m猫[0m[7m[38;5;252m子[0m[7m[38;5;242m猫[0m[7m[38;5;233m子[0m[7m[38;5;232m猫[0m[7m[38;5;233m子[0m[7m[38;5;237m猫[0m[7m[38;5;58m子[0m[7m[38;5;235m猫[0m[7m[38;5;232m子[0m[7m[38;5;240m猫[0m[7m[38;5;254m子[0m[7m[38;5;250m猫[0m[7m[38;5;250m子[0m[7m[38;5;250m猫[0m[7m[38;5;250m子[0m[7m[38;5;246m猫[0m
+[0m[7m[38;5;188m猫[0m[7m[38;5;145m子[0m[7m[38;5;145m猫[0m[7m[38;5;243m子[0m[7m[38;5;240m猫[0m[7m[38;5;236m子[0m[7m[38;5;236m猫[0m[7m[38;5;236m子[0m[7m[38;5;235m猫[0m[7m[38;5;239m子[0m[7m[38;5;247m猫[0m[7m[38;5;251m子[0m[7m[38;5;244m猫[0m[7m[38;5;235m子[0m[7m[38;5;235m猫[0m[7m[38;5;242m子[0m[7m[38;5;242m猫[0m[7m[38;5;241m子[0m[7m[38;5;242m猫[0m[7m[38;5;102m子[0m[7m[38;5;244m猫[0m[7m[38;5;246m子[0m[7m[38;5;102m猫[0m[7m[38;5;249m子[0m[7m[38;5;249m猫[0m[7m[38;5;237m子[0m[7m[38;5;234m猫[0m[7m[38;5;235m子[0m[7m[38;5;233m猫[0m[7m[38;5;233m子[0m[7m[38;5;233m猫[0m[7m[38;5;236m子[0m[7m[38;5;246m猫[0m[7m[38;5;250m子[0m[7m[38;5;243m猫[0m[7m[38;5;241m子[0m[7m[38;5;247m猫[0m[7m[38;5;249m子[0m[7m[38;5;145m猫[0m[7m[38;5;250m子[0m
+[0m[7m[38;5;254m子[0m[7m[38;5;252m猫[0m[7m[38;5;246m子[0m[7m[38;5;246m猫[0m[7m[38;5;240m子[0m[7m[38;5;238m猫[0m[7m[38;5;236m子[0m[7m[38;5;235m猫[0m[7m[38;5;235m子[0m[7m[38;5;234m猫[0m[7m[38;5;236m子[0m[7m[38;5;241m猫[0m[7m[38;5;244m子[0m[7m[38;5;237m猫[0m[7m[38;5;234m子[0m[7m[38;5;239m猫[0m[7m[38;5;59m子[0m[7m[38;5;241m猫[0m[7m[38;5;244m子[0m[7m[38;5;244m猫[0m[7m[38;5;244m子[0m[7m[38;5;248m猫[0m[7m[38;5;246m子[0m[7m[38;5;247m猫[0m[7m[38;5;246m子[0m[7m[38;5;237m猫[0m[7m[38;5;239m子[0m[7m[38;5;251m猫[0m[7m[38;5;251m子[0m[7m[38;5;249m猫[0m[7m[38;5;249m子[0m[7m[38;5;246m猫[0m[7m[38;5;242m子[0m[7m[38;5;237m猫[0m[7m[38;5;238m子[0m[7m[38;5;246m猫[0m[7m[38;5;250m子[0m[7m[38;5;249m猫[0m[7m[38;5;249m子[0m[7m[38;5;252m猫[0m
+[0m[7m[38;5;251m猫[0m[7m[38;5;254m子[0m[7m[38;5;252m猫[0m[7m[38;5;244m子[0m[7m[38;5;240m猫[0m[7m[38;5;237m子[0m[7m[38;5;238m猫[0m[7m[38;5;237m子[0m[7m[38;5;236m猫[0m[7m[38;5;236m子[0m[7m[38;5;236m猫[0m[7m[38;5;238m子[0m[7m[38;5;241m猫[0m[7m[38;5;236m子[0m[7m[38;5;235m猫[0m[7m[38;5;237m子[0m[7m[38;5;240m猫[0m[7m[38;5;242m子[0m[7m[38;5;244m猫[0m[7m[38;5;244m子[0m[7m[38;5;247m猫[0m[7m[38;5;248m子[0m[7m[38;5;248m猫[0m[7m[38;5;247m子[0m[7m[38;5;243m猫[0m[7m[38;5;241m子[0m[7m[38;5;244m猫[0m[7m[38;5;253m子[0m[7m[38;5;249m猫[0m[7m[38;5;243m子[0m[7m[38;5;238m猫[0m[7m[38;5;238m子[0m[7m[38;5;237m猫[0m[7m[38;5;239m子[0m[7m[38;5;242m猫[0m[7m[38;5;246m子[0m[7m[38;5;246m猫[0m[7m[38;5;249m子[0m[7m[38;5;248m猫[0m[7m[38;5;251m子[0m
+[0m[7m[38;5;241m子[0m[7m[38;5;251m猫[0m[7m[38;5;188m子[0m[7m[38;5;249m猫[0m[7m[38;5;249m子[0m[7m[38;5;246m猫[0m[7m[38;5;239m子[0m[7m[38;5;236m猫[0m[7m[38;5;237m子[0m[7m[38;5;238m猫[0m[7m[38;5;240m子[0m[7m[38;5;243m猫[0m[7m[38;5;240m子[0m[7m[38;5;236m猫[0m[7m[38;5;235m子[0m[7m[38;5;236m猫[0m[7m[38;5;238m子[0m[7m[38;5;243m猫[0m[7m[38;5;246m子[0m[7m[38;5;244m猫[0m[7m[38;5;250m子[0m[7m[38;5;249m猫[0m[7m[38;5;247m子[0m[7m[38;5;246m猫[0m[7m[38;5;240m子[0m[7m[38;5;59m猫[0m[7m[38;5;244m子[0m[7m[38;5;248m猫[0m[7m[38;5;239m子[0m[7m[38;5;238m猫[0m[7m[38;5;240m子[0m[7m[38;5;237m猫[0m[7m[38;5;238m子[0m[7m[38;5;243m猫[0m[7m[38;5;244m子[0m[7m[38;5;102m猫[0m[7m[38;5;251m子[0m[7m[38;5;246m猫[0m[7m[38;5;249m子[0m[7m[38;5;241m猫[0m
+[0m[7m[38;5;237m猫[0m[7m[38;5;102m子[0m[7m[38;5;188m猫[0m[7m[38;5;253m子[0m[7m[38;5;251m猫[0m[7m[38;5;145m子[0m[7m[38;5;248m猫[0m[7m[38;5;243m子[0m[7m[38;5;240m猫[0m[7m[38;5;59m子[0m[7m[38;5;243m猫[0m[7m[38;5;242m子[0m[7m[38;5;240m猫[0m[7m[38;5;237m子[0m[7m[38;5;238m猫[0m[7m[38;5;237m子[0m[7m[38;5;239m猫[0m[7m[38;5;244m子[0m[7m[38;5;246m猫[0m[7m[38;5;247m子[0m[7m[38;5;252m猫[0m[7m[38;5;251m子[0m[7m[38;5;247m猫[0m[7m[38;5;246m子[0m[7m[38;5;243m猫[0m[7m[38;5;240m子[0m[7m[38;5;102m猫[0m[7m[38;5;246m子[0m[7m[38;5;240m猫[0m[7m[38;5;235m子[0m[7m[38;5;236m猫[0m[7m[38;5;238m子[0m[7m[38;5;59m猫[0m[7m[38;5;59m子[0m[7m[38;5;59m猫[0m[7m[38;5;247m子[0m[7m[38;5;248m猫[0m[7m[38;5;248m子[0m[7m[38;5;240m猫[0m[7m[38;5;238m子[0m
+[0m[7m[38;5;237m子[0m[7m[38;5;242m猫[0m[7m[38;5;248m子[0m[7m[38;5;253m猫[0m[7m[38;5;253m子[0m[7m[38;5;250m猫[0m[7m[38;5;250m子[0m[7m[38;5;248m猫[0m[7m[38;5;243m子[0m[7m[38;5;242m猫[0m[7m[38;5;243m子[0m[7m[38;5;241m猫[0m[7m[38;5;241m子[0m[7m[38;5;238m猫[0m[7m[38;5;238m子[0m[7m[38;5;236m猫[0m[7m[38;5;240m子[0m[7m[38;5;243m猫[0m[7m[38;5;102m子[0m[7m[38;5;248m猫[0m[7m[38;5;251m子[0m[7m[38;5;252m猫[0m[7m[38;5;247m子[0m[7m[38;5;246m猫[0m[7m[38;5;246m子[0m[7m[38;5;241m猫[0m[7m[38;5;241m子[0m[7m[38;5;102m猫[0m[7m[38;5;244m子[0m[7m[38;5;240m猫[0m[7m[38;5;238m子[0m[7m[38;5;237m猫[0m[7m[38;5;242m子[0m[7m[38;5;242m猫[0m[7m[38;5;241m子[0m[7m[38;5;102m猫[0m[7m[38;5;247m子[0m[7m[38;5;242m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m
+[0m[7m[38;5;237m猫[0m[7m[38;5;238m子[0m[7m[38;5;59m猫[0m[7m[38;5;249m子[0m[7m[38;5;254m猫[0m[7m[38;5;253m子[0m[7m[38;5;249m猫[0m[7m[38;5;250m子[0m[7m[38;5;247m猫[0m[7m[38;5;244m子[0m[7m[38;5;241m猫[0m[7m[38;5;243m子[0m[7m[38;5;243m猫[0m[7m[38;5;240m子[0m[7m[38;5;236m猫[0m[7m[38;5;236m子[0m[7m[38;5;238m猫[0m[7m[38;5;242m子[0m[7m[38;5;243m猫[0m[7m[38;5;247m子[0m[7m[38;5;250m猫[0m[7m[38;5;250m子[0m[7m[38;5;246m猫[0m[7m[38;5;243m子[0m[7m[38;5;242m猫[0m[7m[38;5;243m子[0m[7m[38;5;242m猫[0m[7m[38;5;247m子[0m[7m[38;5;246m猫[0m[7m[38;5;244m子[0m[7m[38;5;59m猫[0m[7m[38;5;242m子[0m[7m[38;5;247m猫[0m[7m[38;5;249m子[0m[7m[38;5;248m猫[0m[7m[38;5;246m子[0m[7m[38;5;243m猫[0m[7m[38;5;59m子[0m[7m[38;5;237m猫[0m[7m[38;5;239m子[0m
+[0m[7m[38;5;238m子[0m[7m[38;5;237m猫[0m[7m[38;5;238m子[0m[7m[38;5;240m猫[0m[7m[38;5;244m子[0m[7m[38;5;250m猫[0m[7m[38;5;250m子[0m[7m[38;5;251m猫[0m[7m[38;5;246m子[0m[7m[38;5;59m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m[7m[38;5;243m子[0m[7m[38;5;242m猫[0m[7m[38;5;59m子[0m[7m[38;5;237m猫[0m[7m[38;5;239m子[0m[7m[38;5;242m猫[0m[7m[38;5;243m子[0m[7m[38;5;246m猫[0m[7m[38;5;145m子[0m[7m[38;5;248m猫[0m[7m[38;5;246m子[0m[7m[38;5;243m猫[0m[7m[38;5;243m子[0m[7m[38;5;246m猫[0m[7m[38;5;247m子[0m[7m[38;5;247m猫[0m[7m[38;5;248m子[0m[7m[38;5;246m猫[0m[7m[38;5;247m子[0m[7m[38;5;145m猫[0m[7m[38;5;145m子[0m[7m[38;5;251m猫[0m[7m[38;5;145m子[0m[7m[38;5;246m猫[0m[7m[38;5;242m子[0m[7m[38;5;237m猫[0m[7m[38;5;239m子[0m[7m[38;5;240m猫[0m
+[0m[7m[38;5;235m猫[0m[7m[38;5;234m子[0m[7m[38;5;236m猫[0m[7m[38;5;238m子[0m[7m[38;5;242m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;244m子[0m[7m[38;5;244m猫[0m[7m[38;5;239m子[0m[7m[38;5;238m猫[0m[7m[38;5;239m子[0m[7m[38;5;243m猫[0m[7m[38;5;241m子[0m[7m[38;5;241m猫[0m[7m[38;5;238m子[0m[7m[38;5;239m猫[0m[7m[38;5;242m子[0m[7m[38;5;244m猫[0m[7m[38;5;246m子[0m[7m[38;5;244m猫[0m[7m[38;5;248m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m[7m[38;5;145m猫[0m[7m[38;5;248m子[0m[7m[38;5;250m猫[0m[7m[38;5;246m子[0m[7m[38;5;247m猫[0m[7m[38;5;248m子[0m[7m[38;5;251m猫[0m[7m[38;5;251m子[0m[7m[38;5;145m猫[0m[7m[38;5;249m子[0m[7m[38;5;251m猫[0m[7m[38;5;247m子[0m[7m[38;5;238m猫[0m[7m[38;5;239m子[0m[7m[38;5;238m猫[0m[7m[38;5;59m子[0m
+[0m[7m[38;5;236m子[0m[7m[38;5;234m猫[0m[7m[38;5;233m子[0m[7m[38;5;235m猫[0m[7m[38;5;237m子[0m[7m[38;5;239m猫[0m[7m[38;5;243m子[0m[7m[38;5;251m猫[0m[7m[38;5;250m子[0m[7m[38;5;247m猫[0m[7m[38;5;239m子[0m[7m[38;5;236m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m[7m[38;5;237m猫[0m[7m[38;5;239m子[0m[7m[38;5;242m猫[0m[7m[38;5;243m子[0m[7m[38;5;102m猫[0m[7m[38;5;247m子[0m[7m[38;5;248m猫[0m[7m[38;5;244m子[0m[7m[38;5;246m猫[0m[7m[38;5;145m子[0m[7m[38;5;247m猫[0m[7m[38;5;247m子[0m[7m[38;5;241m猫[0m[7m[38;5;241m子[0m[7m[38;5;246m猫[0m[7m[38;5;250m子[0m[7m[38;5;247m猫[0m[7m[38;5;102m子[0m[7m[38;5;250m猫[0m[7m[38;5;251m子[0m[7m[38;5;244m猫[0m[7m[38;5;236m子[0m[7m[38;5;238m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m
+[0m[7m[38;5;244m猫[0m[7m[38;5;237m子[0m[7m[38;5;234m猫[0m[7m[38;5;233m子[0m[7m[38;5;233m猫[0m[7m[38;5;234m子[0m[7m[38;5;235m猫[0m[7m[38;5;248m子[0m[7m[38;5;145m猫[0m[7m[38;5;248m子[0m[7m[38;5;248m猫[0m[7m[38;5;102m子[0m[7m[38;5;240m猫[0m[7m[38;5;246m子[0m[7m[38;5;102m猫[0m[7m[38;5;236m子[0m[7m[38;5;237m猫[0m[7m[38;5;240m子[0m[7m[38;5;243m猫[0m[7m[38;5;244m子[0m[7m[38;5;102m猫[0m[7m[38;5;102m子[0m[7m[38;5;246m猫[0m[7m[38;5;243m子[0m[7m[38;5;252m猫[0m[7m[38;5;251m子[0m[7m[38;5;246m猫[0m[7m[38;5;59m子[0m[7m[38;5;248m猫[0m[7m[38;5;248m子[0m[7m[38;5;145m猫[0m[7m[38;5;242m子[0m[7m[38;5;249m猫[0m[7m[38;5;250m子[0m[7m[38;5;244m猫[0m[7m[38;5;235m子[0m[7m[38;5;237m猫[0m[7m[38;5;240m子[0m[7m[38;5;248m猫[0m[7m[38;5;246m子[0m
+[0m[7m[38;5;247m子[0m[7m[38;5;239m猫[0m[7m[38;5;234m子[0m[7m[38;5;233m猫[0m[7m[38;5;233m子[0m[7m[38;5;232m猫[0m[7m[38;5;234m子[0m[7m[38;5;238m猫[0m[7m[38;5;249m子[0m[7m[38;5;251m猫[0m[7m[38;5;145m子[0m[7m[38;5;244m猫[0m[7m[38;5;241m子[0m[7m[38;5;248m猫[0m[7m[38;5;249m子[0m[7m[38;5;242m猫[0m[7m[38;5;234m子[0m[7m[38;5;234m猫[0m[7m[38;5;237m子[0m[7m[38;5;237m猫[0m[7m[38;5;238m子[0m[7m[38;5;237m猫[0m[7m[38;5;239m子[0m[7m[38;5;250m猫[0m[7m[38;5;254m子[0m[7m[38;5;248m猫[0m[7m[38;5;246m子[0m[7m[38;5;253m猫[0m[7m[38;5;253m子[0m[7m[38;5;254m猫[0m[7m[38;5;188m子[0m[7m[38;5;102m猫[0m[7m[38;5;246m子[0m[7m[38;5;247m猫[0m[7m[38;5;239m子[0m[7m[38;5;235m猫[0m[7m[38;5;239m子[0m[7m[38;5;244m猫[0m[7m[38;5;248m子[0m[7m[38;5;246m猫[0m
+[0m[7m[38;5;247m猫[0m[7m[38;5;242m子[0m[7m[38;5;237m猫[0m[7m[38;5;235m子[0m[7m[38;5;235m猫[0m[7m[38;5;234m子[0m[7m[38;5;235m猫[0m[7m[38;5;235m子[0m[7m[38;5;240m猫[0m[7m[38;5;250m子[0m[7m[38;5;250m猫[0m[7m[38;5;249m子[0m[7m[38;5;247m猫[0m[7m[38;5;246m子[0m[7m[38;5;251m猫[0m[7m[38;5;250m子[0m[7m[38;5;243m猫[0m[7m[38;5;234m子[0m[7m[38;5;233m猫[0m[7m[38;5;233m子[0m[7m[38;5;233m猫[0m[7m[38;5;236m子[0m[7m[38;5;248m猫[0m[7m[38;5;254m子[0m[7m[38;5;252m猫[0m[7m[38;5;248m子[0m[7m[38;5;247m猫[0m[7m[38;5;250m子[0m[7m[38;5;251m猫[0m[7m[38;5;251m子[0m[7m[38;5;251m猫[0m[7m[38;5;248m子[0m[7m[38;5;102m猫[0m[7m[38;5;241m子[0m[7m[38;5;236m猫[0m[7m[38;5;238m子[0m[7m[38;5;241m猫[0m[7m[38;5;246m子[0m[7m[38;5;243m猫[0m[7m[38;5;59m子[0m
+[0m[7m[38;5;248m子[0m[7m[38;5;247m猫[0m[7m[38;5;244m子[0m[7m[38;5;240m猫[0m[7m[38;5;237m子[0m[7m[38;5;237m猫[0m[7m[38;5;234m子[0m[7m[38;5;233m猫[0m[7m[38;5;232m子[0m[7m[38;5;235m猫[0m[7m[38;5;244m子[0m[7m[38;5;250m猫[0m[7m[38;5;251m子[0m[7m[38;5;251m猫[0m[7m[38;5;251m子[0m[7m[38;5;188m猫[0m[7m[38;5;252m子[0m[7m[38;5;239m猫[0m[7m[38;5;235m子[0m[7m[38;5;234m猫[0m[7m[38;5;236m子[0m[7m[38;5;252m猫[0m[7m[38;5;255m子[0m[7m[38;5;253m猫[0m[7m[38;5;249m子[0m[7m[38;5;246m猫[0m[7m[38;5;250m子[0m[7m[38;5;254m猫[0m[7m[38;5;251m子[0m[7m[38;5;188m猫[0m[7m[38;5;251m子[0m[7m[38;5;102m猫[0m[7m[38;5;244m子[0m[7m[38;5;239m猫[0m[7m[38;5;237m子[0m[7m[38;5;236m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;244m子[0m[7m[38;5;244m猫[0m
+[0m[7m[38;5;246m猫[0m[7m[38;5;250m子[0m[7m[38;5;250m猫[0m[7m[38;5;247m子[0m[7m[38;5;242m猫[0m[7m[38;5;59m子[0m[7m[38;5;238m猫[0m[7m[38;5;236m子[0m[7m[38;5;236m猫[0m[7m[38;5;236m子[0m[7m[38;5;236m猫[0m[7m[38;5;244m子[0m[7m[38;5;248m猫[0m[7m[38;5;251m子[0m[7m[38;5;251m猫[0m[7m[38;5;251m子[0m[7m[38;5;251m猫[0m[7m[38;5;250m子[0m[7m[38;5;238m猫[0m[7m[38;5;239m子[0m[7m[38;5;250m猫[0m[7m[38;5;254m子[0m[7m[38;5;254m猫[0m[7m[38;5;252m子[0m[7m[38;5;251m猫[0m[7m[38;5;251m子[0m[7m[38;5;251m猫[0m[7m[38;5;250m子[0m[7m[38;5;252m猫[0m[7m[38;5;244m子[0m[7m[38;5;243m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;240m子[0m[7m[38;5;241m猫[0m[7m[38;5;238m子[0m[7m[38;5;239m猫[0m[7m[38;5;239m子[0m[7m[38;5;59m猫[0m[7m[38;5;246m子[0m
+[0m[7m[38;5;145m子[0m[7m[38;5;247m猫[0m[7m[38;5;247m子[0m[7m[38;5;247m猫[0m[7m[38;5;246m子[0m[7m[38;5;247m猫[0m[7m[38;5;246m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m[7m[38;5;242m猫[0m[7m[38;5;59m子[0m[7m[38;5;238m猫[0m[7m[38;5;242m子[0m[7m[38;5;244m猫[0m[7m[38;5;250m子[0m[7m[38;5;251m猫[0m[7m[38;5;250m子[0m[7m[38;5;181m猫[0m[7m[38;5;244m子[0m[7m[38;5;247m猫[0m[7m[38;5;250m子[0m[7m[38;5;250m猫[0m[7m[38;5;250m子[0m[7m[38;5;252m猫[0m[7m[38;5;251m子[0m[7m[38;5;250m猫[0m[7m[38;5;251m子[0m[7m[38;5;248m猫[0m[7m[38;5;247m子[0m[7m[38;5;244m猫[0m[7m[38;5;59m子[0m[7m[38;5;242m猫[0m[7m[38;5;239m子[0m[7m[38;5;244m猫[0m[7m[38;5;244m子[0m[7m[38;5;241m猫[0m[7m[38;5;240m子[0m[7m[38;5;240m猫[0m[7m[38;5;244m子[0m[7m[38;5;250m猫[0m
+[0m[7m[38;5;251m猫[0m[7m[38;5;145m子[0m[7m[38;5;248m猫[0m[7m[38;5;145m子[0m[7m[38;5;248m猫[0m[7m[38;5;247m子[0m[7m[38;5;247m猫[0m[7m[38;5;246m子[0m[7m[38;5;246m猫[0m[7m[38;5;246m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m[7m[38;5;241m猫[0m[7m[38;5;241m子[0m[7m[38;5;131m猫[0m[7m[38;5;131m子[0m[7m[38;5;95m猫[0m[7m[38;5;95m子[0m[7m[38;5;95m猫[0m[7m[38;5;95m子[0m[7m[38;5;131m猫[0m[7m[38;5;138m子[0m[7m[38;5;248m猫[0m[7m[38;5;249m子[0m[7m[38;5;145m猫[0m[7m[38;5;244m子[0m[7m[38;5;246m猫[0m[7m[38;5;145m子[0m[7m[38;5;247m猫[0m[7m[38;5;248m子[0m[7m[38;5;247m猫[0m[7m[38;5;240m子[0m[7m[38;5;244m猫[0m[7m[38;5;246m子[0m[7m[38;5;242m猫[0m[7m[38;5;242m子[0m[7m[38;5;242m猫[0m[7m[38;5;244m子[0m[7m[38;5;251m猫[0m[7m[38;5;188m子[0m
+[0m[7m[38;5;252m子[0m[7m[38;5;251m猫[0m[7m[38;5;249m子[0m[7m[38;5;247m猫[0m[7m[38;5;246m子[0m[7m[38;5;246m猫[0m[7m[38;5;247m子[0m[7m[38;5;246m猫[0m[7m[38;5;246m子[0m[7m[38;5;246m猫[0m[7m[38;5;246m子[0m[7m[38;5;246m猫[0m[7m[38;5;244m子[0m[7m[38;5;131m猫[0m[7m[38;5;167m子[0m[7m[38;5;167m猫[0m[7m[38;5;131m子[0m[7m[38;5;95m猫[0m[7m[38;5;95m子[0m[7m[38;5;95m猫[0m[7m[38;5;95m子[0m[7m[38;5;95m猫[0m[7m[38;5;95m子[0m[7m[38;5;239m猫[0m[7m[38;5;131m子[0m[7m[38;5;251m猫[0m[7m[38;5;250m子[0m[7m[38;5;145m猫[0m[7m[38;5;244m子[0m[7m[38;5;242m猫[0m[7m[38;5;59m子[0m[7m[38;5;102m猫[0m[7m[38;5;244m子[0m[7m[38;5;244m猫[0m[7m[38;5;237m子[0m[7m[38;5;59m猫[0m[7m[38;5;59m子[0m[7m[38;5;246m猫[0m[7m[38;5;250m子[0m[7m[38;5;252m猫[0m
+[0m[7m[38;5;251m猫[0m[7m[38;5;251m子[0m[7m[38;5;248m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;244m子[0m[7m[38;5;247m猫[0m[7m[38;5;246m子[0m[7m[38;5;102m猫[0m[7m[38;5;242m子[0m[7m[38;5;243m猫[0m[7m[38;5;244m子[0m[7m[38;5;244m猫[0m[7m[38;5;167m子[0m[7m[38;5;167m猫[0m[7m[38;5;167m子[0m[7m[38;5;131m猫[0m[7m[38;5;131m子[0m[7m[38;5;95m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m[7m[38;5;238m子[0m[7m[38;5;237m猫[0m[7m[38;5;235m子[0m[7m[38;5;239m猫[0m[7m[38;5;248m子[0m[7m[38;5;248m猫[0m[7m[38;5;246m子[0m[7m[38;5;244m猫[0m[7m[38;5;246m子[0m[7m[38;5;249m猫[0m[7m[38;5;145m子[0m[7m[38;5;244m猫[0m[7m[38;5;237m子[0m[7m[38;5;242m猫[0m[7m[38;5;242m子[0m[7m[38;5;59m猫[0m[7m[38;5;247m子[0m[7m[38;5;249m猫[0m[7m[38;5;246m子[0m
+[0m[7m[38;5;243m子[0m[7m[38;5;243m猫[0m[7m[38;5;246m子[0m[7m[38;5;102m猫[0m[7m[38;5;242m子[0m[7m[38;5;242m猫[0m[7m[38;5;244m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m[7m[38;5;241m猫[0m[7m[38;5;241m子[0m[7m[38;5;243m猫[0m[7m[38;5;244m子[0m[7m[38;5;203m猫[0m[7m[38;5;167m子[0m[7m[38;5;167m猫[0m[7m[38;5;131m子[0m[7m[38;5;95m猫[0m[7m[38;5;236m子[0m[7m[38;5;234m猫[0m[7m[38;5;234m子[0m[7m[38;5;233m猫[0m[7m[38;5;234m子[0m[7m[38;5;238m猫[0m[7m[38;5;239m子[0m[7m[38;5;237m猫[0m[7m[38;5;240m子[0m[7m[38;5;244m猫[0m[7m[38;5;145m子[0m[7m[38;5;250m猫[0m[7m[38;5;249m子[0m[7m[38;5;246m猫[0m[7m[38;5;240m子[0m[7m[38;5;246m猫[0m[7m[38;5;102m子[0m[7m[38;5;247m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;244m子[0m[7m[38;5;242m猫[0m
+[0m[7m[38;5;243m猫[0m[7m[38;5;246m子[0m[7m[38;5;242m猫[0m[7m[38;5;243m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m[7m[38;5;240m猫[0m[7m[38;5;240m子[0m[7m[38;5;244m猫[0m[7m[38;5;246m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m[7m[38;5;138m猫[0m[7m[38;5;203m子[0m[7m[38;5;167m猫[0m[7m[38;5;131m子[0m[7m[38;5;238m猫[0m[7m[38;5;235m子[0m[7m[38;5;236m猫[0m[7m[38;5;234m子[0m[7m[38;5;233m猫[0m[7m[38;5;233m子[0m[7m[38;5;236m猫[0m[7m[38;5;243m子[0m[7m[38;5;248m猫[0m[7m[38;5;59m子[0m[7m[38;5;246m猫[0m[7m[38;5;248m子[0m[7m[38;5;102m猫[0m[7m[38;5;244m子[0m[7m[38;5;242m猫[0m[7m[38;5;59m子[0m[7m[38;5;244m猫[0m[7m[38;5;246m子[0m[7m[38;5;247m猫[0m[7m[38;5;244m子[0m[7m[38;5;248m猫[0m[7m[38;5;246m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m
+[0m[7m[38;5;248m子[0m[7m[38;5;248m猫[0m[7m[38;5;246m子[0m[7m[38;5;244m猫[0m[7m[38;5;242m子[0m[7m[38;5;243m猫[0m[7m[38;5;244m子[0m[7m[38;5;244m猫[0m[7m[38;5;102m子[0m[7m[38;5;246m猫[0m[7m[38;5;248m子[0m[7m[38;5;246m猫[0m[7m[38;5;244m子[0m[7m[38;5;238m猫[0m[7m[38;5;235m子[0m[7m[38;5;235m猫[0m[7m[38;5;237m子[0m[7m[38;5;242m猫[0m[7m[38;5;243m子[0m[7m[38;5;240m猫[0m[7m[38;5;235m子[0m[7m[38;5;235m猫[0m[7m[38;5;239m子[0m[7m[38;5;244m猫[0m[7m[38;5;244m子[0m[7m[38;5;237m猫[0m[7m[38;5;250m子[0m[7m[38;5;250m猫[0m[7m[38;5;59m子[0m[7m[38;5;239m猫[0m[7m[38;5;241m子[0m[7m[38;5;240m猫[0m[7m[38;5;241m子[0m[7m[38;5;241m猫[0m[7m[38;5;242m子[0m[7m[38;5;243m猫[0m[7m[38;5;242m子[0m[7m[38;5;241m猫[0m[7m[38;5;244m子[0m[7m[38;5;242m猫[0m
+[0m[7m[38;5;242m猫[0m[7m[38;5;241m子[0m[7m[38;5;240m猫[0m[7m[38;5;240m子[0m[7m[38;5;242m猫[0m[7m[38;5;242m子[0m[7m[38;5;242m猫[0m[7m[38;5;102m子[0m[7m[38;5;102m猫[0m[7m[38;5;244m子[0m[7m[38;5;244m猫[0m[7m[38;5;243m子[0m[7m[38;5;240m猫[0m[7m[38;5;236m子[0m[7m[38;5;238m猫[0m[7m[38;5;240m子[0m[7m[38;5;243m猫[0m[7m[38;5;243m子[0m[7m[38;5;242m猫[0m[7m[38;5;235m子[0m[7m[38;5;236m猫[0m[7m[38;5;239m子[0m[7m[38;5;243m猫[0m[7m[38;5;246m子[0m[7m[38;5;243m猫[0m[7m[38;5;243m子[0m[7m[38;5;188m猫[0m[7m[38;5;247m子[0m[7m[38;5;243m猫[0m[7m[38;5;239m子[0m[7m[38;5;242m猫[0m[7m[38;5;240m子[0m[7m[38;5;240m猫[0m[7m[38;5;241m子[0m[7m[38;5;240m猫[0m[7m[38;5;240m子[0m[7m[38;5;238m猫[0m[7m[38;5;240m子[0m[7m[38;5;240m猫[0m[7m[38;5;243m子[0m
+[0m[7m[38;5;236m子[0m[7m[38;5;235m猫[0m[7m[38;5;235m子[0m[7m[38;5;236m猫[0m[7m[38;5;238m子[0m[7m[38;5;240m猫[0m[7m[38;5;241m子[0m[7m[38;5;241m猫[0m[7m[38;5;241m子[0m[7m[38;5;242m猫[0m[7m[38;5;240m子[0m[7m[38;5;237m猫[0m[7m[38;5;237m子[0m[7m[38;5;238m猫[0m[7m[38;5;240m子[0m[7m[38;5;241m猫[0m[7m[38;5;243m子[0m[7m[38;5;240m猫[0m[7m[38;5;235m子[0m[7m[38;5;236m猫[0m[7m[38;5;239m子[0m[7m[38;5;241m猫[0m[7m[38;5;246m子[0m[7m[38;5;249m猫[0m[7m[38;5;250m子[0m[7m[38;5;251m猫[0m[7m[38;5;247m子[0m[7m[38;5;251m猫[0m[7m[38;5;254m子[0m[7m[38;5;242m猫[0m[7m[38;5;242m子[0m[7m[38;5;59m猫[0m[7m[38;5;238m子[0m[7m[38;5;241m猫[0m[7m[38;5;238m子[0m[7m[38;5;237m猫[0m[7m[38;5;239m子[0m[7m[38;5;234m猫[0m[7m[38;5;238m子[0m[7m[38;5;236m猫[0m
+[0m[7m[38;5;235m猫[0m[7m[38;5;234m子[0m[7m[38;5;234m猫[0m[7m[38;5;236m子[0m[7m[38;5;59m猫[0m[7m[38;5;244m子[0m[7m[38;5;244m猫[0m[7m[38;5;242m子[0m[7m[38;5;59m猫[0m[7m[38;5;241m子[0m[7m[38;5;238m猫[0m[7m[38;5;236m子[0m[7m[38;5;239m猫[0m[7m[38;5;237m子[0m[7m[38;5;236m猫[0m[7m[38;5;239m子[0m[7m[38;5;239m猫[0m[7m[38;5;234m子[0m[7m[38;5;235m猫[0m[7m[38;5;237m子[0m[7m[38;5;239m猫[0m[7m[38;5;241m子[0m[7m[38;5;246m猫[0m[7m[38;5;251m子[0m[7m[38;5;251m猫[0m[7m[38;5;247m子[0m[7m[38;5;241m猫[0m[7m[38;5;253m子[0m[7m[38;5;188m猫[0m[7m[38;5;244m子[0m[7m[38;5;243m猫[0m[7m[38;5;240m子[0m[7m[38;5;237m猫[0m[7m[38;5;238m子[0m[7m[38;5;237m猫[0m[7m[38;5;236m子[0m[7m[38;5;238m猫[0m[7m[38;5;238m子[0m[7m[38;5;234m猫[0m[7m[38;5;238m子[0m
diff --git a/src-unix/Koneko_utils.hs b/src-unix/Koneko_utils.hs
new file mode 100644
--- /dev/null
+++ b/src-unix/Koneko_utils.hs
@@ -0,0 +1,21 @@
+-- -- ; {{{1
+--
+-- File : src-unix/Koneko_utils.hs
+-- Maintainer : Felix C. Stegerman
+-- Date : 2019-10-15
+--
+-- Copyright : Copyright (C) 2019 Felix C. Stegerman
+-- Version : v0.0.1
+-- License : GPLv3+
+--
+-- -- ; }}}1
+
+module Koneko_utils (stdinTTY) where
+
+import System.Posix.IO (stdInput)
+import System.Posix.Terminal (queryTerminal)
+
+stdinTTY :: IO Bool
+stdinTTY = queryTerminal stdInput
+
+-- vim: set tw=70 sw=2 sts=2 et fdm=marker :
diff --git a/src-win/Koneko_utils.hs b/src-win/Koneko_utils.hs
new file mode 100644
--- /dev/null
+++ b/src-win/Koneko_utils.hs
@@ -0,0 +1,21 @@
+-- -- ; {{{1
+--
+-- File : src-win/Koneko_utils.hs
+-- Maintainer : Felix C. Stegerman
+-- Date : 2019-10-15
+--
+-- Copyright : Copyright (C) 2019 Felix C. Stegerman
+-- Version : v0.0.1
+-- License : GPLv3+
+--
+-- -- ; }}}1
+
+module Koneko_utils (stdinTTY) where
+
+import System.IO (hIsTerminalDevice, stdin)
+
+-- NB: not portable (GHC only)
+stdinTTY :: IO Bool
+stdinTTY = hIsTerminalDevice stdin
+
+-- vim: set tw=70 sw=2 sts=2 et fdm=marker :
diff --git a/src/Koneko/Bltn.hs b/src/Koneko/Bltn.hs
new file mode 100644
--- /dev/null
+++ b/src/Koneko/Bltn.hs
@@ -0,0 +1,88 @@
+-- -- ; {{{1
+--
+-- File : Koneko/Bltn.hs
+-- Maintainer : Felix C. Stegerman
+-- Date : 2022-02-12
+--
+-- Copyright : Copyright (C) 2022 Felix C. Stegerman
+-- Version : v0.0.1
+-- License : GPLv3+
+--
+-- -- ; }}}1
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Koneko.Bltn (initCtx) where
+
+import Data.Foldable (traverse_)
+import Data.Maybe (fromJust) -- careful!
+
+#if !MIN_VERSION_GLASGOW_HASKELL(8, 8, 1, 0)
+import Data.Monoid ((<>))
+#endif
+
+import qualified Data.HashMap.Strict as H
+
+import Koneko.Data
+import Koneko.Misc (pInt, pFloat, parseMaybe)
+import Koneko.Prim (swap)
+
+initCtx :: Context -> Evaluator -> IO ()
+initCtx ctxMain call = do
+ ctx <- forkContext bltnModule ctxMain
+ traverse_ (defPrim ctx) $ typePreds ++ [
+ strToInt, strToFloat,
+ dup, drop_, mkBltn "swap" (biRun swap), dip call,
+ dollar, at, percent,
+ br_pred call, br_nil call
+ ]
+
+typePreds :: [Builtin]
+typePreds = [ mkBltn (x <> "?") $ pop1push1
+ $ (== x) . typeToStr . typeOf | x <- typeNames ]
+
+strToInt, strToFloat :: Builtin
+strToInt = mkBltn "str->int" $ pop1push1 $ parseMaybe pInt
+strToFloat = mkBltn "str->float" $ pop1push1 $ parseMaybe pFloat
+
+dup, drop_ :: Builtin
+dup = mkBltn "dup" $ \_ s -> push' s . fst <$> pop_' s
+drop_ = mkBltn "drop" $ \_ s -> snd <$> pop_' s
+
+dip :: Evaluator -> Builtin
+dip call = mkBltn "dip" $ \c s -> do
+ ((x, f), s') <- pop2' s
+ flip rpush1 (x :: KValue) =<< call c (push' s' f)
+
+dollar, at, percent :: Builtin
+dollar = mkBltn "$" $ pop2push1 partial
+at = mkBltn "@" $ pop2push1 compose
+percent = mkBltn "%" $ pop2push1 $ flip compose
+
+compose, partial :: KValue -> KValue -> KValue
+compose f g = block [] [KIdent $ _ID "f", KIdent $ _ID "g"]
+ $ _sc [("f", f), ("g", g), ("name", KIdent $ _ID "@")]
+partial x f = block [] [KQuot $ _ID "_x", KIdent $ _ID "f"]
+ $ _sc [("_x", x), ("f", f), ("name", KIdent $ _ID "$")]
+
+-- UNSAFE!
+_ID :: Identifier -> Ident
+_ID = fromJust . ident
+
+_sc :: [(Identifier, KValue)] -> Maybe Scope
+_sc = Just . Scope bltnModule . H.fromList
+
+br_pred, br_nil :: Evaluator -> Builtin
+
+br_pred call = mkBltn "~?" $ \c s0 -> do
+ ((x, f, g, p), s1) <- pop4' s0
+ s2 <- call c $ foldl push' s1 [x, x, p]
+ (b, s3) <- pop' s2
+ call c $ push' s3 $ if truthy b then f else g
+
+br_nil call = mkBltn "~nil" $ \c s -> do
+ ((x, f, g), s') <- pop3' s
+ call c $ foldl push' s' $ if isNil x then [f] else [x, g]
+
+-- vim: set tw=70 sw=2 sts=2 et fdm=marker :
diff --git a/src/Koneko/Data.hs b/src/Koneko/Data.hs
new file mode 100644
--- /dev/null
+++ b/src/Koneko/Data.hs
@@ -0,0 +1,1076 @@
+-- -- ; {{{1
+--
+-- File : Koneko/Data.hs
+-- Maintainer : Felix C. Stegerman
+-- Date : 2022-02-12
+--
+-- Copyright : Copyright (C) 2022 Felix C. Stegerman
+-- Version : v0.0.1
+-- License : GPLv3+
+--
+-- -- ; }}}1
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
+
+ -- {{{1
+-- |
+--
+-- >>> :set -XOverloadedStrings
+-- >>> import Data.Maybe
+-- >>> id = fromJust . ident; q = KQuot . id
+--
+-- >>> nil
+-- nil
+-- >>> false
+-- #f
+-- >>> true
+-- #t
+-- >>> int 42
+-- 42
+-- >>> float (-1.23)
+-- -1.23
+-- >>> str "I like 猫s"
+-- "I like 猫s"
+-- >>> kwd "foo"
+-- :foo
+-- >>> pair (Kwd "answer") $ int 42
+-- :answer 42 =>
+-- >>> list [int 42, kwd "foo"]
+-- ( 42 :foo )
+-- >>> KIdent $ id "foo"
+-- foo
+-- >>> q "foo"
+-- 'foo
+-- >>> block [id "x", id "y"] [q "y", q "x"] Nothing
+-- [ x y . 'y 'x ]
+--
+-- ... TODO ...
+--
+
+ -- }}}1
+
+module Koneko.Data (
+ Identifier, Module, Evaluator, Args, KException(..), stackExpected,
+ applyMissing, expected, unexpected, exceptionInfo, Kwd(..), Ident,
+ unIdent, ident, Pair(..), List(..), Dict(..), Block(..),
+ Builtin(..), Multi(..), RecordT(..), Record, recType, recValues,
+ record, Thunk, runThunk, thunk, Scope(..), Context, ctxScope,
+ KPrim(..), KValue(..), KType(..), Stack, freeVars, Cmp(..),
+ escapeFrom, escapeTo, ToVal, toVal, FromVal, fromVal, toVals,
+ fromVals, maybeToVal, eitherToVal, toJSON, fromJSON, emptyStack,
+ push', push, rpush, rpush1, pop_, pop, pop2, pop3, pop4, pop_',
+ pop', pop2', pop3', pop4', popN', pop1push, pop2push, pop1push1,
+ pop2push1, primModule, bltnModule, prldModule, mainModule,
+ initMainContext, initMain, initModule, forkContext, forkScope,
+ defineIn, defineIn', importIn, importFromIn, lookup, lookupModule',
+ moduleKeys, moduleNames, typeNames, typeOfPrim, typeOf, typeToKwd,
+ typeToStr, typeAsStr, isNil, isBool, isInt, isFloat, isStr, isKwd,
+ isPair, isList, isDict, isIdent, isQuot, isBlock, isBuiltin,
+ isMulti, isRecordT, isRecord, isThunk, isCallable, isFunction, nil,
+ false, true, bool, int, float, str, kwd, pair, list, dict, block,
+ dictLookup, mkPrim, mkBltn, defPrim, defMulti, truthy, retOrThrow,
+ recordTypeSig, underscored, digitParams, unKwds, recordToPairs
+) where
+
+import Control.DeepSeq (deepseq, NFData(..))
+import Control.Exception (Exception, throw, throwIO)
+import Control.Monad (liftM, when)
+import Data.Bifunctor (bimap, second)
+import Data.Char (intToDigit, isPrint, ord)
+import Data.Data (Data, cast, gmapQ)
+import Data.Foldable (traverse_)
+import Data.Functor.Classes (liftCompare, liftCompare2)
+import Data.List (intercalate, sort)
+import Data.Maybe (catMaybes, isNothing)
+import Data.String (IsString)
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import Numeric (showHex)
+import Prelude hiding (lookup)
+import System.IO.Unsafe (unsafeInterleaveIO)
+
+#if !MIN_VERSION_GLASGOW_HASKELL(8, 8, 1, 0)
+import Data.List (maximum)
+import Data.Monoid ((<>))
+#endif
+
+import qualified Data.Aeson as AE
+import qualified Data.HashMap.Strict as H
+import qualified Data.HashSet as S
+import qualified Data.HashTable.IO as HT
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as E
+import qualified Data.Text.Lazy as LT
+import qualified Data.Text.Lazy.Encoding as LE
+import qualified Data.Vector as V
+import qualified Prelude as P
+
+import qualified Koneko.Misc as M
+
+-- types --
+
+type HashTable k v = HT.BasicHashTable k v
+type ModuleLookupTable = HashTable Identifier KValue
+type ScopeLookupTable = H.HashMap Identifier KValue
+type DictTable = H.HashMap Identifier KValue
+type MultiTable = HashTable [Identifier] Block
+
+type Identifier = Text
+type Module = ModuleLookupTable
+type Evaluator = Context -> Stack -> IO Stack
+type Args = [(Identifier, KValue)]
+
+-- TODO
+data KException
+ = ParseError !String
+ | EvalUnexpected !String -- ^ unexpected value during eval
+ | EvalScopelessBlock -- ^ block w/o scope during eval
+ | ModuleNameError !String
+ | ModuleLoadError !String
+ | NameError !String -- ^ ident lookup failed
+ | StackUnderflow -- ^ stack was empty
+ | Expected !EExpected
+ | MultiMatchFailed !String !String
+ | UncomparableType !String
+ | UncomparableTypes !String !String
+ | UncallableType !String
+ | UnapplicableType !String !String
+ | UnknownField !String !String
+ | EmptyList !String
+ | IndexError !String !String
+ | KeyError !String !String
+ | RangeError !String
+ | DivideByZero
+ | InvalidRx !String
+ | Fail !String
+ | NotImplemented !String
+ deriving Data
+
+instance Exception KException
+
+data EExpected
+ = StackExpected !String !String
+ | ApplyMissing !Bool
+ | OtherExpected !String
+ deriving Data
+
+stackExpected :: Either String KValue -> String -> KException
+stackExpected x = Expected . StackExpected (either id typeAsStr x)
+
+applyMissing :: Bool -> KException
+applyMissing = Expected . ApplyMissing
+
+expected, unexpected :: String -> KException
+expected = Expected . OtherExpected . ("expected " ++)
+unexpected = Expected . OtherExpected . ("unexpected " ++)
+
+exceptionInfo :: KException -> [String]
+exceptionInfo (Expected x) = [show x]
+exceptionInfo x = concat $ gmapQ (maybe [] (:[]) . cast) x
+
+-- TODO: intern?!
+newtype Kwd = Kwd { unKwd :: Identifier }
+ deriving (Eq, Ord, Generic, NFData)
+
+newtype Ident = Ident_ { unIdent :: Identifier }
+ deriving (Eq, Ord, Generic, NFData)
+
+ident :: Identifier -> Maybe Ident
+ident s = if M.isIdent s then Just $ Ident_ s else Nothing
+
+data Pair = Pair { key :: Kwd, value :: KValue }
+ deriving (Eq, Ord, Generic, NFData)
+
+newtype List = List { unList :: [KValue] }
+ deriving (Eq, Ord, Generic, NFData)
+
+newtype Dict = Dict { unDict :: DictTable }
+ deriving (Eq, Ord, Generic, NFData)
+
+data Block = Block {
+ blkParams :: [Ident],
+ blkCode :: [KValue],
+ blkScope :: Maybe Scope
+} deriving (Generic, NFData)
+
+data Builtin = Builtin {
+ biPrim :: Bool,
+ biName :: Identifier,
+ biRun :: Evaluator
+}
+
+-- TODO
+instance NFData Builtin where
+ rnf Builtin{..} = (biPrim, biName) `deepseq` ()
+
+data Multi = Multi {
+ mltArity :: Int,
+ mltName :: Identifier,
+ mltTable :: MultiTable
+}
+
+-- TODO
+instance NFData Multi where
+ rnf Multi{..} = (mltArity, mltName) `deepseq` ()
+
+data RecordT = RecordT {
+ recName :: Identifier,
+ recFields :: [Identifier]
+} deriving (Eq, Ord, Generic, NFData)
+
+data Record = Record {
+ recType :: RecordT,
+ recValues :: [KValue]
+} deriving (Eq, Ord, Generic, NFData)
+
+record :: RecordT -> [KValue] -> Either KException Record
+record recType@RecordT{..} recValues
+ | length recFields == length recValues = Right Record{..}
+ | otherwise = Left $ expected $ (show $ length recFields) ++
+ " arg(s) for record " ++ T.unpack recName
+
+data Thunk = Thunk { runThunk :: IO KValue }
+
+thunk :: IO KValue -> IO Thunk
+thunk x = return . Thunk =<< _once x
+
+_once :: IO a -> IO (IO a)
+_once = liftM return . unsafeInterleaveIO
+
+-- TODO
+instance NFData Thunk where
+ rnf _ = ()
+
+data Scope = Scope {
+ modName :: Identifier,
+ table :: ScopeLookupTable
+}
+
+-- TODO
+instance NFData Scope where
+ rnf Scope{..} = modName `deepseq` ()
+
+data Context = Context {
+ modules :: HashTable Identifier Module,
+ imports :: HashTable Identifier [Identifier],
+ ctxScope :: Scope
+}
+
+-- TODO: + Rx
+data KPrim
+ = KNil | KBool Bool | KInt Integer | KFloat Double
+ | KStr Text | KKwd Kwd
+ deriving (Eq, Ord, Generic, NFData)
+
+-- TODO
+data KValue
+ = KPrim KPrim | KPair Pair | KList List | KDict Dict
+ | KIdent Ident | KQuot Ident | KBlock Block | KBuiltin Builtin
+ | KMulti Multi | KRecordT RecordT | KRecord Record | KThunk Thunk
+ deriving (Eq, Ord, Generic, NFData)
+
+data KType
+ = TNil | TBool | TInt | TFloat | TStr | TKwd | TPair | TList
+ | TDict | TIdent | TQuot | TBlock | TBuiltin | TMulti | TRecordT
+ | TRecord | TThunk
+ deriving (Eq, Ord, Generic, NFData)
+
+type Stack = [KValue]
+
+-- TODO
+freeVars :: [KValue] -> S.HashSet Identifier
+freeVars = umap S.empty
+ where
+ f s (KList l) = umap s $ unList l
+ f s (KIdent i) = g s $ unIdent i
+ f s (KQuot i) = g s $ unIdent i
+ f s (KBlock b) = let p = S.fromList $ map unIdent $ blkParams b
+ in umap (S.union p s) $ blkCode b
+ f _ _ = S.empty
+ g s i = if S.member i s then S.empty else S.singleton i
+ umap s = S.unions . map (f s)
+
+-- instances --
+
+class Cmp a where
+ cmp :: a -> a -> Ordering
+
+instance Cmp KPrim where
+ cmp (KInt x) (KFloat y) = compare (fromInteger x) y
+ cmp (KFloat x) (KInt y) = compare x (fromInteger y)
+ cmp x y
+ | t /= u = throw $ UncomparableTypes (typeToStr t) (typeToStr u)
+ | otherwise = compare x y
+ where
+ t = typeOfPrim x; u = typeOfPrim y
+
+instance Cmp KValue where
+ cmp (KPrim x) (KPrim y) = cmp x y
+ cmp (KPair x) (KPair y)
+ = liftCompare2 compare cmp (key x, value x) (key y, value y)
+ cmp (KList x) (KList y)
+ = liftCompare cmp (unList x) (unList y)
+ cmp (KDict x) (KDict y)
+ = liftCompare2 compare cmp (unDict x) (unDict y)
+ cmp (KRecord x) (KRecord y)
+ = liftCompare2 compare cmp (recType x, recValues x)
+ (recType y, recValues y)
+ cmp x y
+ | t /= u = throw $ UncomparableTypes (typeToStr t) (typeToStr u)
+ | t `elem` [TIdent, TQuot, TRecordT] = compare x y
+ | otherwise = throw $ UncomparableType $ typeToStr t
+ where
+ t = typeOf x; u = typeOf y
+
+instance Cmp [KValue] where
+ cmp = liftCompare cmp
+
+-- TODO: find some way of comparing these?
+
+instance Eq Block where
+ _ == _ = throw $ UncomparableType "block"
+
+-- TODO
+instance Eq Builtin where
+ _ == _ = throw $ UncomparableType "builtin"
+
+instance Eq Multi where
+ _ == _ = throw $ UncomparableType "multi"
+
+instance Eq Thunk where
+ _ == _ = throw $ UncomparableType "thunk"
+
+instance Ord Block where
+ compare _ _ = throw $ UncomparableType "block"
+
+-- TODO
+instance Ord Builtin where
+ compare _ _ = throw $ UncomparableType "builtin"
+
+instance Ord Multi where
+ compare _ _ = throw $ UncomparableType "multi"
+
+instance Ord Thunk where
+ compare _ _ = throw $ UncomparableType "thunk"
+
+instance Show KException where
+ show (ParseError msg) = "parse error: " ++ msg
+ show (EvalUnexpected t) = "cannot eval " ++ t
+ show (EvalScopelessBlock) = "cannot eval scopeless block"
+ show (ModuleNameError name) = "no loaded module named " ++ name
+ show (ModuleLoadError name) = "cannot load module " ++ name
+ show (NameError name) = "name " ++ name ++ " is not defined"
+ show StackUnderflow = "stack underflow"
+ show (Expected e) = show e
+ show (MultiMatchFailed n s) = "no signature " ++ s ++ " for multi " ++ n
+ show (UncomparableType t) = "type " ++ t ++ " is not comparable"
+ show (UncomparableTypes t u) = "types " ++ t ++ " and " ++ u ++
+ " are not comparable"
+ show (UncallableType t) = "type " ++ t ++ " is not callable"
+ show (UnapplicableType t op) = "type " ++ t ++ " does not support " ++ op
+ show (UnknownField f t) = t ++ " has no field named " ++ f
+ show (EmptyList op) = op ++ ": empty list"
+ show (IndexError op i) = op ++ ": index " ++ i ++ " is out of range"
+ show (KeyError op k) = op ++ ": key " ++ k ++ " not found"
+ show (RangeError msg) = "range error: " ++ msg
+ show DivideByZero = "divide by zero"
+ show (InvalidRx msg) = "invalid regex: " ++ msg
+ show (Fail msg) = msg
+ show (NotImplemented s) = "not implemented: " ++ s
+
+instance Show EExpected where
+ show (StackExpected t u) = "expected " ++ u ++ " on stack (not " ++ t ++ ")"
+ show (ApplyMissing b)
+ = "expected block to have parameter named " ++ x ++ " for " ++ op
+ where
+ (x, op) = if b then ("&&", "apply-dict") else ("&", "apply")
+ show (OtherExpected msg) = msg
+
+instance Show Kwd where
+ show (Kwd s) = ":" ++ if M.isIdent s then T.unpack s else show s
+
+instance Show Ident where
+ show = T.unpack . unIdent
+
+instance Show Pair where
+ show (Pair k v) = show k ++ " " ++ show v ++ " =>"
+
+instance Show List where
+ show (List []) = "()"
+ show (List l) = "( " ++ intercalate " " (map show l) ++ " )"
+
+instance Show Dict where
+ show (Dict d)
+ | H.null d = "{ }"
+ | otherwise = "{ " ++ intercalate ", " kv ++ " }"
+ where
+ kv = map f $ sort $ H.toList d
+ f (k, v) = show $ Pair (Kwd k) v
+
+-- TODO
+instance Show Block where
+ show (Block _ _ (Just s)) | modName s == bltnModule
+ = intercalate " " $ map (show . snd) $ sort $ H.toList $ table s
+ show (Block p c _) = case (p, c) of
+ ([], []) -> "[ ]"
+ ([], _ ) -> "[ " ++ f c ++ " ]"
+ (_ , []) -> "[ " ++ f p ++ " . ]"
+ (_ , _ ) -> "[ " ++ f p ++ " . " ++ f c ++ " ]"
+ where
+ f :: Show a => [a] -> String
+ f = intercalate " " . map show
+
+instance Show Builtin where
+ show Builtin{..} = "#<" ++ t ++ ":" ++ T.unpack biName ++ ">"
+ where
+ t = if biPrim then "primitive" else "builtin"
+
+instance Show Multi where
+ show Multi{..}
+ = "#"
+
+instance Show RecordT where
+ show RecordT{..}
+ = "#"
+ where
+ f = intercalate "#" $ map T.unpack recFields
+
+instance Show Record where
+ show Record{..} = T.unpack (recName recType) ++ "{ " ++ flds ++ " }"
+ where
+ flds = intercalate ", " $ map f
+ $ zip (recFields recType) recValues
+ f (k, v) = show $ Pair (Kwd k) v
+
+-- TODO
+instance Show KPrim where
+ show KNil = "nil"
+ show (KBool b) = if b then "#t" else "#f"
+ show (KInt i) = show i
+ show (KFloat f) = show f
+ show (KStr s) = showStr s
+ show (KKwd k) = show k
+
+instance Show KValue where
+ show (KPrim p) = show p
+ show (KPair p) = show p
+ show (KList l) = show l
+ show (KDict d) = show d
+ show (KIdent i) = show i
+ show (KQuot i) = "'" ++ show i
+ show (KBlock b) = show b
+ show (KBuiltin b) = show b
+ show (KMulti m) = show m
+ show (KRecordT r) = show r
+ show (KRecord r) = show r
+ show (KThunk _) = "#"
+
+instance Show KType where
+ show TNil = "#<::nil>"
+ show TBool = "#<::bool>"
+ show TInt = "#<::int>"
+ show TFloat = "#<::float>"
+ show TStr = "#<::str>"
+ show TKwd = "#<::kwd>"
+ show TPair = "#<::pair>"
+ show TList = "#<::list>"
+ show TDict = "#<::dict>"
+ show TIdent = "#<::ident>"
+ show TQuot = "#<::quot>"
+ show TBlock = "#<::block>"
+ show TBuiltin = "#<::builtin>"
+ show TMulti = "#<::multi>"
+ show TRecordT = "#<::record-type>"
+ show TRecord = "#<::record>"
+ show TThunk = "#<::thunk>"
+
+showStr :: Text -> String
+showStr s = T.unpack $ T.concat ["\"", T.concatMap f s, "\""]
+ where
+ f c = maybe (g c) id $ P.lookup c bsl
+ g c = if isPrint c then T.singleton c else h (ord c)
+ h n = let (p,m) = if n <= 0xffff then ("\\u",4) else ("\\U",8)
+ in p <> T.justifyRight m '0' (T.pack $ showHex n "")
+ bsl = zip (map T.head escapeTo) escapeFrom
+
+escapeFrom, escapeTo :: [Text]
+escapeFrom = ["\\r","\\n","\\t","\\\"","\\\\"]
+escapeTo = [ "\r", "\n", "\t", "\"", "\\"]
+
+-- ToVal & FromVal --
+
+class ToVal a where
+ toVal :: a -> KValue
+
+instance ToVal () where
+ toVal () = KPrim KNil
+
+instance ToVal Bool where
+ toVal = KPrim . KBool
+
+instance ToVal Integer where
+ toVal = KPrim . KInt
+
+instance ToVal Double where
+ toVal = KPrim . KFloat
+
+instance ToVal Text where
+ toVal = KPrim . KStr
+
+instance ToVal Kwd where
+ toVal = KPrim . KKwd
+
+instance ToVal Pair where
+ toVal = KPair
+
+instance ToVal [KValue] where
+ toVal = KList . List
+
+instance ToVal [Pair] where
+ toVal = KDict . Dict . H.fromList . map f
+ where
+ f (Pair (Kwd k) v) = (k, v)
+
+instance ToVal Dict where
+ toVal = KDict
+
+instance ToVal Block where
+ toVal = KBlock
+
+instance ToVal Builtin where
+ toVal = KBuiltin
+
+instance ToVal KValue where
+ toVal = id
+
+instance ToVal a => ToVal (Maybe a) where
+ toVal = maybeToVal nil
+
+instance ToVal a => ToVal (Either e a) where
+ toVal = eitherToVal nil
+
+-- NB: no ToVal for
+-- * ident, quot (both Ident)
+-- * multi, record(-type) (no point)
+
+class FromVal a where
+ fromVal :: KValue -> Either KException a
+
+instance FromVal () where
+ fromVal (KPrim KNil) = Right ()
+ fromVal x = Left $ stackExpected (Right x) "nil"
+
+instance FromVal Bool where
+ fromVal (KPrim (KBool x)) = Right x
+ fromVal x = Left $ stackExpected (Right x) "bool"
+
+instance FromVal Integer where
+ fromVal (KPrim (KInt x)) = Right x
+ fromVal x = Left $ stackExpected (Right x) "int"
+
+instance FromVal Double where
+ fromVal (KPrim (KFloat x)) = Right x
+ fromVal x = Left $ stackExpected (Right x) "float"
+
+instance FromVal Text where
+ fromVal (KPrim (KStr x)) = Right x
+ fromVal x = Left $ stackExpected (Right x) "str"
+
+instance FromVal Kwd where
+ fromVal (KPrim (KKwd x)) = Right x
+ fromVal x = Left $ stackExpected (Right x) "kwd"
+
+instance FromVal Pair where
+ fromVal (KPair x) = Right x
+ fromVal x = Left $ stackExpected (Right x) "pair"
+
+instance FromVal [KValue] where
+ fromVal (KList (List x)) = Right x
+ fromVal x = Left $ stackExpected (Right x) "list"
+
+instance FromVal Dict where
+ fromVal (KDict x) = Right x
+ fromVal x = Left $ stackExpected (Right x) "dict"
+
+instance FromVal Block where
+ fromVal (KBlock x) = Right x
+ fromVal x = Left $ stackExpected (Right x) "block"
+
+instance FromVal Record where
+ fromVal (KRecord x) = Right x
+ fromVal x = Left $ stackExpected (Right x) "record"
+
+instance FromVal RecordT where
+ fromVal (KRecordT x) = Right x
+ fromVal x = Left $ stackExpected (Right x) "record-type"
+
+instance FromVal KValue where
+ fromVal x = Right x
+
+instance FromVal a => FromVal (Maybe a) where
+ fromVal (KPrim KNil) = Right Nothing
+ fromVal x = Just <$> fromVal x
+
+instance (FromVal a, FromVal b) => FromVal (Either a b) where
+ fromVal x = case fromVal x of
+ Right y -> Right (Left y)
+ Left e1 -> case fromVal x of
+ Right y -> Right (Right y)
+ Left e2 -> Left $ stackExpected (Right x) $ f e1 e2
+ where
+ f (Expected (StackExpected t1 _))
+ (Expected (StackExpected t2 _)) = t1 ++ " or " ++ t2
+ f _ _ = error "WTF"
+
+-- NB: no FromVal for
+-- * ident, quot (both Ident)
+-- * builtin, multi, record-type (no need?)
+
+toVals :: ToVal a => [a] -> [KValue]
+toVals = map toVal
+
+fromVals :: FromVal a => [KValue] -> Either KException [a]
+fromVals = traverse fromVal
+
+maybeToVal :: ToVal a => KValue -> Maybe a -> KValue
+maybeToVal = flip maybe toVal
+
+eitherToVal :: ToVal a => KValue -> Either e a -> KValue
+eitherToVal = flip either toVal . const
+
+-- toJSON & fromJSON --
+
+toJSON :: KValue -> Either KException Text
+toJSON = second (LT.toStrict . LE.decodeUtf8 . AE.encode) . f -- TODO
+ where
+ f (KPrim KNil) = Right AE.Null
+ f (KPrim (KBool x)) = Right $ AE.Bool x
+ f (KPrim (KInt x)) = Right $ AE.toJSON x
+ f (KPrim (KFloat x)) = Right $ AE.toJSON x
+ f (KPrim (KStr x)) = Right $ AE.toJSON x
+ f (KPrim (KKwd x)) = Right $ AE.toJSON $ unKwd x
+ f (KPair (Pair k v)) = f $ list [KPrim $ KKwd $ k, v]
+ f (KList (List x)) = second AE.toJSON $ traverse f x
+ f (KDict (Dict x)) = second AE.Object
+ $ H.traverseWithKey (\_ v -> f v) $ x
+ f (KRecord x) = f $ dict $ recordToPairs x ++
+ [Pair (Kwd "__koneko_type__")
+ (str $ recName $ recType x)]
+ f x = Left $ Fail $ "json.<-: cannot convert " ++ typeAsStr x
+
+fromJSON :: Text -> Either KException KValue
+fromJSON = bimap (Fail . ("json.<-: " ++)) f
+ . AE.eitherDecodeStrict' . E.encodeUtf8
+ where
+ f AE.Null = nil
+ f (AE.Bool x) = bool x
+ f x@(AE.Number _) = case AE.fromJSON x of
+ AE.Success y -> int y
+ AE.Error _ -> case AE.fromJSON x of
+ AE.Success y -> float y
+ AE.Error _ -> nil -- TODO
+ f (AE.String x) = str x
+ f (AE.Array x) = list $ map f $ V.toList x
+ f (AE.Object x) = KDict $ Dict $ H.map f x
+
+-- Stack functions --
+
+emptyStack :: Stack
+emptyStack = []
+
+push' :: Stack -> KValue -> Stack
+push' = flip (:)
+
+push :: ToVal a => Stack -> a -> Stack
+push s = push' s . toVal
+
+rpush :: ToVal a => Stack -> [a] -> IO Stack
+rpush s = return . foldl push s
+
+rpush1 :: ToVal a => Stack -> a -> IO Stack
+rpush1 s = return . push s
+
+pop_ :: Stack -> Either KException (KValue, Stack)
+pop_ [] = Left StackUnderflow
+pop_ (x:s) = Right (x, s)
+
+pop :: FromVal a => Stack -> Either KException (a, Stack)
+pop s = (\(x, s') -> (,s') <$> fromVal x) =<< pop_ s
+
+-- | NB: returns popped items in "reverse" order
+--
+-- >>> s = emptyStack `push` 1 `push` 2
+-- >>> fst <$> pop' s :: IO Integer
+-- 2
+-- >>> fst <$> pop2' s :: IO (Integer, Integer)
+-- (1,2)
+--
+-- stack: ... 1 2 <- top
+--
+pop2 :: (FromVal a, FromVal b)
+ => Stack -> Either KException ((a, b), Stack)
+pop2 s0 = do
+ (y, s1) <- pop s0
+ (x, s2) <- pop s1
+ return ((x, y), s2)
+
+-- | NB: returns popped items in "reverse" order
+--
+-- >>> s = emptyStack `push` 1 `push` 2 `push` 3
+-- >>> fst <$> pop3' s :: IO (Integer, Integer, Integer)
+-- (1,2,3)
+--
+-- stack: ... 1 2 3 <- top
+--
+pop3 :: (FromVal a, FromVal b, FromVal c)
+ => Stack -> Either KException ((a, b, c), Stack)
+pop3 s0 = do
+ (z, s1) <- pop s0
+ (y, s2) <- pop s1
+ (x, s3) <- pop s2
+ return ((x, y, z), s3)
+
+pop4 :: (FromVal a, FromVal b, FromVal c, FromVal d)
+ => Stack -> Either KException ((a, b, c, d), Stack)
+pop4 s0 = do
+ (z, s1) <- pop s0
+ (y, s2) <- pop s1
+ (x, s3) <- pop s2
+ (w, s4) <- pop s3
+ return ((w, x, y, z), s4)
+
+pop_' :: Stack -> IO (KValue, Stack)
+pop_' = retOrThrow . pop_
+
+pop' :: FromVal a => Stack -> IO (a, Stack)
+pop' = retOrThrow . pop
+
+pop2' :: (FromVal a, FromVal b) => Stack -> IO ((a, b), Stack)
+pop2' = retOrThrow . pop2
+
+pop3' :: (FromVal a, FromVal b, FromVal c)
+ => Stack -> IO ((a, b, c), Stack)
+pop3' = retOrThrow . pop3
+
+pop4' :: (FromVal a, FromVal b, FromVal c, FromVal d)
+ => Stack -> IO ((a, b, c, d), Stack)
+pop4' = retOrThrow . pop4
+
+popN' :: (FromVal a) => Int -> Stack -> IO ([a], Stack)
+popN' n s0 = if n < 0 then return ([], s0) else f [] n s0
+ where
+ f xs 0 s = return (xs, s)
+ f xs m s = do (x, s') <- pop' s; f (x:xs) (m-1) s'
+
+pop1push :: (FromVal a, ToVal b) => (a -> [b]) -> Evaluator
+pop1push f _ s = do (x, s') <- pop' s; rpush s' $ f x
+
+pop2push :: (FromVal a, FromVal b, ToVal c)
+ => (a -> b -> [c]) -> Evaluator
+pop2push f _ s = do ((x, y), s') <- pop2' s; rpush s' $ f x y
+
+pop1push1 :: (FromVal a, ToVal b) => (a -> b) -> Evaluator
+pop1push1 f = pop1push $ \x -> [f x]
+
+pop2push1 :: (FromVal a, FromVal b, ToVal c)
+ => (a -> b -> c) -> Evaluator
+pop2push1 f = pop2push $ \x y -> [f x y]
+
+-- Module/Scope functions --
+
+primModule, bltnModule, prldModule, mainModule :: Identifier
+primModule = "__prim__"
+bltnModule = "__bltn__"
+prldModule = "__prld__"
+mainModule = "__main__"
+
+initMainContext :: IO Context
+initMainContext = do
+ modules <- HT.new; imports <- HT.new
+ let ctxScope = _newScope mainModule; ctx = Context{..}
+ traverse_ (initModule ctx) [primModule, bltnModule, prldModule]
+ ctx <$ initMain ctx
+
+initMain :: Context -> IO ()
+initMain c = do
+ initModule c mainModule
+ let d = defineIn' c mainModule
+ d "__args__" $ KList $ List []; d "__repl__" false
+
+initModule :: Context -> Identifier -> IO ()
+initModule ctx m = HT.new >>= HT.insert (modules ctx) m
+
+forkContext :: Identifier -> Context -> IO Context
+forkContext m c = do
+ flip when mkMod =<< isNothing <$> HT.lookup (modules c) m
+ return c { ctxScope = _newScope m }
+ where
+ mkMod = HT.new >>= HT.insert (modules c) m
+
+_newScope :: Identifier -> Scope
+_newScope m = Scope m H.empty
+
+-- TODO
+forkScope :: Args -> Context -> Block -> IO Context
+forkScope l c Block{..} = do
+ s <- maybe (throwIO EvalScopelessBlock) return blkScope
+ let t0 = table s
+ t1 = H.union (H.fromList l) $ H.filterWithKey p t0
+ t2 = if null l && H.size t1 == H.size t0 then t0 else t1
+ return c { ctxScope = s { table = t2 } }
+ where
+ fv = freeVars blkCode; p k _ = S.member k fv
+
+-- TODO: error if already exists (or prim, etc.)
+-- throws ModuleNameError
+defineIn :: Context -> Identifier -> KValue -> IO ()
+defineIn c k v = defineIn' c (modName $ ctxScope c) k v
+
+-- throws ModuleNameError
+defineIn' :: Context -> Identifier -> Identifier -> KValue -> IO ()
+defineIn' c mn k v = do m <- getModule c mn; HT.insert m k v
+
+importIn :: Context -> Identifier -> IO ()
+importIn c k = HT.mutate (imports c) (modName $ ctxScope c)
+ $ (,()) . Just . maybe [k] (insert k)
+ where
+ insert x xs = if x `elem` xs then xs else x:xs -- TODO
+
+-- TODO: error if already defined?!
+-- throws ModuleNameError or NameError
+importFromIn :: Context -> Identifier -> [Identifier] -> IO ()
+importFromIn c m
+ = traverse_ $ \k -> defineIn c k =<< lookupModule' c k m
+
+-- Prim -> Scope* -> Module -> Import* -> Bltn -> Prld
+-- throws ModuleNameError
+lookup :: Context -> Identifier -> IO (Maybe KValue)
+lookup c k = do
+ imp <- maybe [] id <$> HT.lookup (imports c) m
+ let bp = map look [bltnModule, prldModule]
+ mi = [look m, lookupImp imp]
+ M.firstJust $ [look primModule, lookupScope s] ++
+ if m == prldModule then bp else mi ++ bp
+ where
+ s = ctxScope c; m = modName s; look = lookupModule c k
+ lookupScope = return . H.lookup k . table
+ lookupImp = M.firstJust . map look
+
+-- throws ModuleNameError
+lookupModule :: Context -> Identifier -> Identifier -> IO (Maybe KValue)
+lookupModule c k m = getModule c m >>= flip HT.lookup k
+
+-- throws ModuleNameError or NameError
+lookupModule' :: Context -> Identifier -> Identifier -> IO KValue
+lookupModule' c k m = maybe err return =<< lookupModule c k m
+ where
+ err = throwIO $ NameError $ T.unpack k
+
+-- throws ModuleNameError
+moduleKeys :: Context -> Identifier -> IO [Identifier]
+moduleKeys c m = getModule c m >>= (map fst <$>) <$> HT.toList
+
+-- throws ModuleNameError
+getModule :: Context -> Identifier -> IO Module
+getModule c m = HT.lookup (modules c) m >>= maybe err return
+ where
+ err = throwIO $ ModuleNameError $ T.unpack m
+
+moduleNames :: Context -> IO [Identifier]
+moduleNames = fmap (map fst) . HT.toList . modules
+
+-- type predicates --
+
+typeNames :: [Identifier]
+typeNames = [
+ "nil", "bool", "int", "float", "str", "kwd", "pair", "list",
+ "dict", "ident", "quot", "block", "builtin", "multi",
+ "record-type", "record", "thunk"
+ ]
+
+typeOfPrim :: KPrim -> KType
+typeOfPrim p = case p of
+ KNil -> TNil
+ KBool _ -> TBool
+ KInt _ -> TInt
+ KFloat _ -> TFloat
+ KStr _ -> TStr
+ KKwd _ -> TKwd
+
+typeOf :: KValue -> KType
+typeOf (KPrim p) = typeOfPrim p
+typeOf (KPair _) = TPair
+typeOf (KList _) = TList
+typeOf (KDict _) = TDict
+typeOf (KIdent _) = TIdent
+typeOf (KQuot _) = TQuot
+typeOf (KBlock _) = TBlock
+typeOf (KBuiltin _) = TBuiltin
+typeOf (KMulti _) = TMulti
+typeOf (KRecordT _) = TRecordT
+typeOf (KRecord _) = TRecord
+typeOf (KThunk _) = TThunk
+
+typeToKwd :: KType -> Kwd
+typeToKwd = Kwd . typeToStr
+
+typeToStr :: IsString a => KType -> a
+typeToStr TNil = "nil"
+typeToStr TBool = "bool"
+typeToStr TInt = "int"
+typeToStr TFloat = "float"
+typeToStr TStr = "str"
+typeToStr TKwd = "kwd"
+typeToStr TPair = "pair"
+typeToStr TList = "list"
+typeToStr TDict = "dict"
+typeToStr TIdent = "ident"
+typeToStr TQuot = "quot"
+typeToStr TBlock = "block"
+typeToStr TBuiltin = "builtin"
+typeToStr TMulti = "multi"
+typeToStr TRecordT = "record-type"
+typeToStr TRecord = "record"
+typeToStr TThunk = "thunk"
+
+typeAsStr :: IsString a => KValue -> a
+typeAsStr = typeToStr . typeOf
+
+isNil, isBool, isInt, isFloat, isStr, isKwd, isPair, isList, isDict,
+ isIdent, isQuot, isBlock, isBuiltin, isMulti, isRecordT, isRecord,
+ isThunk :: KValue -> Bool
+
+isNil = (TNil ==) . typeOf
+isBool = (TBool ==) . typeOf
+isInt = (TInt ==) . typeOf
+isFloat = (TFloat ==) . typeOf
+isStr = (TStr ==) . typeOf
+isKwd = (TKwd ==) . typeOf
+isPair = (TPair ==) . typeOf
+isList = (TList ==) . typeOf
+isDict = (TDict ==) . typeOf
+isIdent = (TIdent ==) . typeOf
+isQuot = (TQuot ==) . typeOf
+isBlock = (TBlock ==) . typeOf
+isBuiltin = (TBuiltin ==) . typeOf
+isMulti = (TMulti ==) . typeOf
+isRecordT = (TRecordT ==) . typeOf
+isRecord = (TRecord ==) . typeOf
+isThunk = (TThunk ==) . typeOf
+
+isCallable, isFunction :: KValue -> Bool
+isCallable = (`elem` callableTypes) . typeOf
+isFunction = (`elem` functionTypes) . typeOf
+
+callableTypes, functionTypes :: [KType]
+callableTypes = [TStr, TPair, TList, TDict, TRecord, TThunk] ++ functionTypes
+functionTypes = [TBlock, TBuiltin, TMulti, TRecordT]
+
+-- "constructors" --
+
+nil, false, true :: KValue
+nil = toVal ()
+false = toVal False
+true = toVal True
+
+bool :: Bool -> KValue
+bool = toVal
+
+int :: Integer -> KValue
+int = toVal
+
+float :: Double -> KValue
+float = toVal
+
+str :: Text -> KValue
+str = toVal
+
+kwd :: Text -> KValue
+kwd = toVal . Kwd
+
+pair :: ToVal a => Kwd -> a -> KValue
+pair k v = toVal $ Pair k $ toVal v
+
+list :: ToVal a => [a] -> KValue
+list = toVal . map toVal
+
+dict :: [Pair] -> KValue
+dict = toVal
+
+-- NB: no ToVal for ident, quot
+
+block :: [Ident] -> [KValue] -> Maybe Scope -> KValue
+block blkParams blkCode blkScope = KBlock Block{..}
+
+-- TODO: multi, record(-type)?
+
+-- utilities --
+
+dictLookup :: String -> Dict -> [Identifier]
+ -> Either KException [KValue]
+dictLookup op (Dict h) = traverse f
+ where
+ f k = maybe (Left $ KeyError op $ T.unpack k) Right $ H.lookup k h
+
+mkPrim, mkBltn :: Identifier -> Evaluator -> Builtin
+mkPrim = Builtin True . underscored
+mkBltn = Builtin False
+
+defPrim :: Context -> Builtin -> IO ()
+defPrim ctx f = defineIn ctx (biName f) $ KBuiltin f
+
+-- TODO: error if already exists, name not the same
+defMulti :: Context -> Identifier -> [Identifier] -> Block -> IO ()
+defMulti c mn sig b = do
+ curMod <- getModule c $ modName $ ctxScope c
+ HT.mutateIO curMod mn f
+ where
+ f Nothing = do
+ mt <- HT.new; HT.insert mt sig b
+ return (Just $ KMulti $ Multi ma mn mt, ())
+ f (Just x@(KMulti Multi{..})) = (Just x, ()) <$ do
+ when (mltArity /= ma) $ err $ "multi " ++ T.unpack mltName ++
+ " to have arity " ++ show mltArity
+ HT.insert mltTable sig b
+ f _ = err $ T.unpack mn ++ " to be a multi"
+ ma = length sig
+ err = throwIO . expected
+
+truthy :: KValue -> Bool
+truthy (KPrim KNil) = False
+truthy (KPrim (KBool False)) = False
+truthy _ = True
+
+retOrThrow :: Either KException a -> IO a
+retOrThrow = either throwIO return
+
+recordTypeSig :: RecordT -> Identifier
+recordTypeSig = T.pack . show
+
+underscored :: Text -> Text
+underscored = (<> "__") . ("__" <>)
+
+-- TODO
+digitParams :: Block -> [Ident]
+digitParams Block{..} = map (Ident_ . fst) $ take n parms -- safe!
+ where
+ n = maximum $ (0:) $ catMaybes $ map (flip P.lookup parms)
+ $ S.toList $ freeVars blkCode
+ parms = [ (underscored $ T.singleton (intToDigit i), i)
+ | i <- [1..9] ]
+
+unKwds :: [KValue] -> IO [Identifier]
+unKwds = retOrThrow . fmap (map unKwd) . fromVals
+
+recordToPairs :: Record -> [Pair]
+recordToPairs r
+ = [ Pair (Kwd k) v | (k, v) <- zip (recFields $ recType r)
+ (recValues r) ]
+
+-- vim: set tw=70 sw=2 sts=2 et fdm=marker :
diff --git a/src/Koneko/Eval.hs b/src/Koneko/Eval.hs
new file mode 100644
--- /dev/null
+++ b/src/Koneko/Eval.hs
@@ -0,0 +1,461 @@
+-- -- ; {{{1
+--
+-- File : Koneko/Eval.hs
+-- Maintainer : Felix C. Stegerman
+-- Date : 2022-02-12
+--
+-- Copyright : Copyright (C) 2022 Felix C. Stegerman
+-- Version : v0.0.1
+-- License : GPLv3+
+--
+-- -- ; }}}1
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
+
+ -- {{{1
+-- |
+--
+-- >>> :set -XOverloadedStrings
+-- >>> import Data.Maybe
+-- >>> id = fromJust . ident
+-- >>> ctx <- initContext
+-- >>> ev x = eval x ctx []
+--
+-- >>> ev [str "Hello, World!", KIdent $ id "say!"]
+-- Hello, World!
+-- []
+-- >>> ev [int 1, int 2, KIdent $ id "-"]
+-- [-1]
+--
+-- >>> ev x = evalText "" x ctx []
+--
+-- >>> ev "\"Hello, World!\" say!"
+-- Hello, World!
+-- []
+-- >>> ev "1 2 +"
+-- [3]
+--
+-- ... TODO ...
+--
+
+ -- }}}1
+
+module Koneko.Eval (
+ tryK, eval, evalText, evalStdin, evalFile, initContext
+) where
+
+import Control.DeepSeq (($!!))
+import Control.Exception (throwIO, try)
+import Control.Monad (unless, when)
+import Data.Bool (bool)
+import Data.Char (ord)
+import Data.List hiding (lookup)
+import Data.List.Split (wordsBy)
+import Data.Text (Text)
+import Prelude hiding (lookup)
+import Safe (atMay)
+import System.Directory (doesFileExist)
+import System.Environment (lookupEnv)
+import System.FilePath (())
+import System.IO (hPutStrLn, stderr)
+
+#if !MIN_VERSION_GLASGOW_HASKELL(8, 8, 1, 0)
+import Data.Monoid((<>))
+#endif
+
+import qualified Data.HashMap.Strict as H
+import qualified Data.HashTable.IO as HT
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+
+import Koneko.Data hiding (bool)
+import Koneko.Misc (firstJust)
+import Paths_koneko (getDataFileName)
+
+import qualified Koneko.Read as R
+
+import qualified Koneko.Bltn as Bltn
+import qualified Koneko.IO as K_IO
+import qualified Koneko.JSON as JSON
+import qualified Koneko.Math as Math
+import qualified Koneko.Prim as Prim
+import qualified Koneko.Prld as Prld
+
+tryK :: IO a -> IO (Either KException a)
+tryK = try
+
+-- eval --
+
+eval, evl :: [KValue] -> Evaluator
+
+eval xs c s = (return $!!) =<< evl xs c s
+
+evl [] _ s = return s
+evl (x:xt) c s0 = do
+ (s1, deferredCall) <- eval1 x c s0
+ let f = if deferredCall then call c s1 else return s1
+ if null xt then f else f >>= evl xt c -- tail call!
+
+evalText :: FilePath -> Text -> Evaluator
+evalText name code = eval $ R.read' name code
+
+evalStdin :: Context -> Stack -> IO ()
+evalStdin c s = () <$ do
+ code <- T.getContents; evalText "(stdin)" code c s
+
+evalFile :: FilePath -> Evaluator
+evalFile f c s = do code <- T.readFile f; evalText f code c s
+
+eval1, eval1_ :: KValue -> Context -> Stack -> IO (Stack, Bool)
+
+eval1 x c s = do
+ debug c $ do
+ hPutStrLn stderr $ "==> eval " ++ show x
+ hPutStrLn stderr $ "--> " ++ intercalate " " (map show $ reverse s)
+ r@(s', _) <- eval1_ x c $!! s
+ debug c $
+ hPutStrLn stderr $ "<-- " ++ intercalate " " (map show $ reverse s')
+ return $!! r
+
+eval1_ x c s = case x of
+ KPrim _ -> (,False) <$> rpush1 s x
+ KList (List l) -> (,False) <$> evalList l c s
+ KIdent i -> (,True ) <$> pushIdent (unIdent i) c s
+ KQuot i -> (,False) <$> pushIdent (unIdent i) c s
+ KBlock b -> (,False) <$> evalBlock b c s
+ _ -> throwIO $ EvalUnexpected $ typeAsStr x
+
+-- TODO
+evalList :: [KValue] -> Evaluator
+evalList xs c s = do ys <- evl xs c emptyStack; rpush1 s $ reverse ys
+
+-- TODO
+pushIdent :: Text -> Evaluator
+pushIdent i c s = lookup c i >>= maybe err (return . push s)
+ where
+ err = throwIO $ NameError $ T.unpack i
+
+evalBlock :: Block -> Evaluator
+evalBlock b c s = rpush1 s b { blkScope = Just $ ctxScope c }
+
+-- call --
+
+call :: Evaluator
+call c s = do
+ debug c $ hPutStrLn stderr "*** call ***"
+ (x, s') <- pop' s
+ case x of
+ KPrim (KStr y) -> callStr y c s'
+ KPair p -> callPair p c s'
+ KList l -> callList l c s'
+ KDict d -> callDict d c s'
+ KBlock b -> callBlock b c s'
+ KBuiltin b -> biRun b c s'
+ KMulti m -> callMulti m c s'
+ KRecordT r -> callRecordT r c s'
+ KRecord r -> callRecord r c s'
+ KThunk t -> callThunk t c s'
+ _ -> throwIO $ UncallableType $ typeAsStr x
+
+-- TODO
+callStr :: Text -> Evaluator
+callStr x _ s = do
+ (Kwd op, s') <- pop' s
+ let o = "str." <> op; p = rpush1 s'; pr = p . mkOp o
+ case op of
+ "ord" -> do unless (T.length x == 1) $ throwIO $ stackExpected
+ (Left $ "str of length " ++ show (T.length x))
+ "str of length 1"
+ p $ toInteger $ ord $ T.head x
+ "lower" -> p $ T.toLower x
+ "upper" -> p $ T.toUpper x
+ "reverse" -> p $ T.reverse x
+ "trim" -> p $ T.strip x
+ "triml" -> p $ T.stripStart x
+ "trimr" -> p $ T.stripEnd x
+ "starts-with?"
+ -> pr $ pop1push1 (`T.isPrefixOf` x)
+ "ends-with?"
+ -> pr $ pop1push1 (`T.isSuffixOf` x)
+ "->list" -> p $ list $ map T.singleton $ T.unpack x
+ "append" -> pr $ pop1push1 (<> x)
+ "slice" -> pr $ \_ s1 -> do
+ ((i, j, step), s2) <- pop3' s1; let lx = lengthT x
+ i' <- nilToDef i 0; j' <- nilToDef j lx
+ unless (step == 1) $ throwIO $ NotImplemented
+ $ T.unpack $ op <> ": step other than 1"
+ rpush1 s2 $ slice T.take T.drop i' j' step lx x
+ "empty?" -> p $ T.null x
+ "len" -> p $ lengthT x
+ "get^" -> pr $ \_ s1 -> do
+ (i, s2) <- pop' s1
+ let err = throwIO $ IndexError (T.unpack o) $ show i
+ maybe err (rpush1 s2) $ indexT x i
+ "has?" -> pr $ pop1push1 $ has lengthT x
+ "elem?" -> pr $ pop1push1 (`T.isInfixOf` x)
+ "index" -> pr $ pop1push1 (`indexOf` x)
+ _ -> throwIO $ UnknownField (T.unpack op) "str"
+
+callPair :: Pair -> Evaluator
+callPair Pair{..} _ s = do
+ (Kwd op, s') <- pop' s
+ case op of
+ "key" -> rpush1 s' key
+ "value" -> rpush1 s' value
+ _ -> throwIO $ UnknownField (T.unpack op) "pair"
+
+-- TODO
+callList :: List -> Evaluator
+callList (List l) _ s = do
+ (Kwd op, s') <- pop' s
+ let o = "list." <> op; p = rpush1 s'; pr = p . mkOp o
+ g = when (null l) $ throwIO $ EmptyList $ T.unpack o
+ case op of
+ "head^" -> g >> p (head l) -- safe!
+ "tail^" -> g >> p (tail l) -- safe!
+ "uncons^" -> g >> rpush s' [head l, list $ tail l] -- safe!
+ "cons" -> pr $ pop1push1 (:l)
+ "sort" -> p $ sort l
+ "sort'" -> p $ sortBy cmp l
+ "append" -> pr $ pop1push1 (++ l)
+ "slice" -> pr $ \_ s1 -> do
+ ((i, j, step), s2) <- pop3' s1; let ll = len l
+ i' <- nilToDef i 0; j' <- nilToDef j ll
+ unless (step == 1) $ throwIO $ NotImplemented
+ $ T.unpack $ op <> ": step other than 1"
+ rpush1 s2 $ slice take drop i' j' step ll l
+ "empty?" -> p $ null l
+ "len" -> p $ len l
+ "get^" -> pr $ \_ s1 -> do
+ (i, s2) <- pop' s1
+ let err = throwIO $ IndexError (T.unpack o) $ show i
+ maybe err (rpush1 s2) $ atMay l $ fromInteger i
+ "has?" -> pr $ pop1push1 $ has len l
+ "elem?" -> pr $ pop1push1 (`elem` l)
+ _ -> throwIO $ UnknownField (T.unpack op) "list"
+
+-- TODO
+callDict :: Dict -> Evaluator
+callDict (Dict h) _ s = do
+ (Kwd op, s') <- pop' s
+ let o = "dict." <> op; p = rpush1 s'; pr = p . mkOp o
+ case op of
+ "keys" -> p $ map kwd $ H.keys h
+ "values" -> p $ H.elems h
+ "pairs" -> p [ pair (Kwd k) v | (k, v) <- sort $ H.toList h ]
+ "merge" -> pr $ \_ s1 -> do
+ (Dict h2, s2) <- pop' s1
+ rpush1 s2 $ Dict $ H.union h h2
+ "delete" -> pr $ \_ s1 -> do
+ (Kwd k, s2) <- pop' s1
+ rpush1 s2 $ Dict $ H.delete k h
+ "empty?" -> p $ H.null h
+ "len" -> p $ toInteger $ H.size h
+ "get^" -> pr $ \_ s1 -> do
+ (Kwd k, s2) <- pop' s1
+ let err = throwIO $ KeyError (T.unpack o) (T.unpack k)
+ maybe err (rpush1 s2) $ H.lookup k h
+ "has?" -> pr $ \_ s1 -> do
+ (Kwd k, s2) <- pop' s1; rpush1 s2 $ H.member k h
+ _ -> throwIO $ UnknownField (T.unpack op) "dict"
+
+-- TODO
+callMulti :: Multi -> Evaluator
+callMulti Multi{..} c s = do
+ sig <- map toSig . fst <$> popN' mltArity s
+ let f b = callBlock b c s; look = HT.lookup mltTable
+ maybe (err sig) f =<< firstJust [look sig, look def]
+ where
+ toSig (KRecord r) = recordTypeSig $ recType r
+ toSig t = typeAsStr t
+ def = replicate mltArity "_"
+ err sig = throwIO $ MultiMatchFailed (T.unpack mltName)
+ $ show $ list $ map kwd sig
+
+callRecord :: Record -> Evaluator
+callRecord r _ s = do
+ (Kwd k, s') <- pop' s
+ let err = throwIO $ UnknownField (T.unpack k) (T.unpack recName)
+ maybe err (rpush1 s' . (recValues r !!)) $ elemIndex k recFields -- safe!
+ where
+ RecordT{..} = recType r
+
+callThunk :: Thunk -> Evaluator
+callThunk t _ s = rpush1 s =<< runThunk t
+
+-- apply --
+
+-- TODO
+apply :: Evaluator
+apply c s = do
+ debug c $ hPutStrLn stderr "*** apply ***"
+ (x, s') <- pop' s
+ case x of
+ KBlock b -> applyBlock b c s'
+ KMulti _ -> throwIO $ NotImplemented "apply multi"
+ KRecordT r -> applyRecordT r c s'
+ _ -> throwIO $ UnapplicableType (typeAsStr x) "apply"
+
+-- TODO
+apply_dict :: Evaluator
+apply_dict c s = do
+ debug c $ hPutStrLn stderr "*** apply-dict ***"
+ (x, s') <- pop' s
+ case x of
+ KBlock b -> apply_dictBlock b c s'
+ KMulti _ -> throwIO $ NotImplemented "apply-dict multi"
+ KRecordT r -> apply_dictRecordT r c s'
+ _ -> throwIO $ UnapplicableType (typeAsStr x) "apply-dict"
+
+-- call & apply: block --
+
+-- TODO
+callBlock :: Block -> Evaluator
+callBlock b@Block{..} c s0 = do
+ (s1, args) <- popArgs [] s0 $ reverse nparms'
+ sc <- forkScope (args ++ map (,nil) sparms ++ cma) c b
+ evl blkCode sc s1
+ where
+ (sparms, nparms) = partitionSpecial $ map unIdent blkParams
+ nparms' = delete cm nparms
+ cm = "__caller-module__"
+ cma = if cm `elem` nparms then
+ [(cm, kwd $ modName $ ctxScope c)] else []
+
+-- TODO
+applyBlock :: Block -> Evaluator
+applyBlock b@Block{..} c s0 = do
+ (l, s1) <- pop' s0; let ll = length l
+ when (ll < lnp) $ throwIO $ expected $ show lnp ++ " arg(s) for apply"
+ when (ll > lnp && "&" `notElem` sparms) $ throwIO $ applyMissing False
+ let (l1, l2) = splitAt lnp l
+ args = zip nparms l1 ++ map (,nil) sparms' ++ [("&", list l2)]
+ sc <- forkScope args c b
+ (++ s1) <$> evl blkCode sc emptyStack
+ where
+ (sparms, nparms) = partitionSpecial $ map unIdent blkParams
+ sparms' = delete "&" sparms
+ lnp = length nparms
+
+-- TODO
+apply_dictBlock :: Block -> Evaluator
+apply_dictBlock b@Block{..} c s0 = do
+ (d@(Dict h), s1) <- pop' s0
+ when ("&&" `notElem` sparms) $ throwIO $ applyMissing True
+ vals <- retOrThrow $ dictLookup "apply-dict" d nparms
+ let h' = H.filterWithKey (\k _ -> k `notElem` nparms) h
+ args = zip nparms vals ++ map (,nil) sparms' ++
+ [("&&", KDict $ Dict h')]
+ sc <- forkScope args c b
+ (++ s1) <$> evl blkCode sc emptyStack
+ where
+ (sparms, nparms) = partitionSpecial $ map unIdent blkParams
+ sparms' = delete "&&" sparms
+
+-- call & apply: record-type --
+
+callRecordT :: RecordT -> Evaluator
+callRecordT t@RecordT{..} _ s = do
+ (l, s') <- popN' (length recFields) s; _pushRec s' $ record t l
+
+applyRecordT :: RecordT -> Evaluator
+applyRecordT t _ s = do
+ (l, s') <- pop' s; _pushRec s' $ record t l
+
+apply_dictRecordT :: RecordT -> Evaluator
+apply_dictRecordT t@RecordT{..} _ s = do
+ (d@(Dict h), s') <- pop' s; let uf = H.keys h \\ recFields
+ unless (null uf) $ throwIO $ unexpected $
+ "key(s) " ++ (T.unpack $ T.intercalate ", " uf)
+ ++ " for record " ++ T.unpack recName
+ let l = dictLookup "record-type.apply-dict" d recFields
+ _pushRec s' $ record t =<< l
+
+_pushRec :: Stack -> Either KException Record -> IO Stack
+_pushRec s r = retOrThrow r >>= rpush1 s . KRecord
+
+-- load module from file --
+
+-- TODO
+loadMod :: Context -> Identifier -> IO ()
+loadMod ctx name = () <$ do
+ lib <- getDataFileName "lib"
+ ps <- split ':' . maybe "" id <$> lookupEnv "KONEKOPATH"
+ file <- f $ map ( fname) $ lib:ps
+ evalFile file ctx emptyStack
+ where
+ f [] = throwIO $ ModuleLoadError n
+ f (x:xt) = doesFileExist x >>= bool (f xt) (return x)
+ fname = foldl1 () (split '/' n) ++ ".knk"
+ split c = wordsBy (== c); n = T.unpack name
+
+-- initial context --
+
+initContext :: IO Context
+initContext = do
+ ctx <- initMainContext
+ let load = loadMod ctx
+ Prim.initCtx ctx load call apply apply_dict callBlock
+ Bltn.initCtx ctx call
+ Prld.initCtx ctx load
+ K_IO.initCtx ctx
+ JSON.initCtx ctx
+ Math.initCtx ctx
+ return ctx
+
+-- utilities: block call/apply --
+
+popArgs :: Args -> Stack -> [Identifier] -> IO (Stack, Args)
+popArgs r s [] = return (s, r)
+popArgs r s (k:kt) = do
+ (v, s') <- pop' s; popArgs ((k, v):r) s' kt
+
+partitionSpecial :: [Identifier] -> ([Identifier], [Identifier])
+partitionSpecial = partition (`elem` ["&", "&&"])
+
+-- utilities --
+
+mkOp :: Identifier -> Evaluator -> Builtin
+mkOp = mkPrim . (<> ")") . ("(" <>)
+
+len :: [a] -> Integer
+len = genericLength
+
+has :: (a -> Integer) -> a -> Integer -> Bool
+has l x i = 0 <= i && i < (l x)
+
+lengthT :: Text -> Integer
+lengthT = toInteger . T.length
+
+-- TODO
+indexT :: Text -> Integer -> Maybe Text
+indexT t i = if has lengthT t i then f i else Nothing
+ where
+ f = Just . T.singleton . T.index t . fromInteger
+
+-- TODO
+slice :: Num a => (a -> b -> b) -> (a -> b -> b)
+ -> Integer -> Integer -> Integer -> Integer -> b -> b
+slice tak drp i j _ ll l = tak (f j - i') $ drp i' l
+ where
+ f n = fromInteger $ if n < 0 then ll + n else n; i' = f i
+
+indexOf :: Text -> Text -> Maybe Integer
+indexOf s = f 0
+ where
+ f i t | s `T.isPrefixOf` t = Just i
+ f _ "" = Nothing
+ f i t = f (i+1) $ T.tail t
+
+nilToDef :: FromVal a => KValue -> a -> IO a
+nilToDef x d = if isNil x then return d else retOrThrow $ fromVal x
+
+debug :: Context -> IO () -> IO ()
+debug c act
+ = maybe False (== true) <$> lookup c "__debug__" >>= flip when act
+
+-- vim: set tw=70 sw=2 sts=2 et fdm=marker :
diff --git a/src/Koneko/IO.hs b/src/Koneko/IO.hs
new file mode 100644
--- /dev/null
+++ b/src/Koneko/IO.hs
@@ -0,0 +1,46 @@
+-- -- ; {{{1
+--
+-- File : Koneko/IO.hs
+-- Maintainer : Felix C. Stegerman
+-- Date : 2020-11-12
+--
+-- Copyright : Copyright (C) 2020 Felix C. Stegerman
+-- Version : v0.0.1
+-- License : GPLv3+
+--
+-- -- ; }}}1
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Koneko.IO (initCtx) where
+
+import Control.Exception (throwIO)
+import Data.Foldable (traverse_)
+import System.IO.Error (tryIOError)
+
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+
+import Koneko.Data
+
+initCtx :: Context -> IO ()
+initCtx ctxMain = do
+ ctx <- forkContext "io" ctxMain
+ traverse_ (defPrim ctx) [ioContents, ioLines]
+
+ioContents, ioLines :: Builtin
+
+ioContents = mkBltn "contents!" $ \_ s -> do
+ (x, s') <- pop' s
+ (tryIOError $ T.readFile $ T.unpack x) >>= either f (rpush1 s')
+ where
+ f = throwIO . Fail . ("io.contents!: " ++) . show
+
+ioLines = mkBltn "lines!" $ \_ s -> do
+ (x, s') <- pop' s
+ (tryIOError $ fmap (map str . T.lines) $ T.readFile $ T.unpack x)
+ >>= either f (rpush1 s')
+ where
+ f = throwIO . Fail . ("io.lines!: " ++) . show
+
+-- vim: set tw=70 sw=2 sts=2 et fdm=marker :
diff --git a/src/Koneko/JSON.hs b/src/Koneko/JSON.hs
new file mode 100644
--- /dev/null
+++ b/src/Koneko/JSON.hs
@@ -0,0 +1,33 @@
+-- -- ; {{{1
+--
+-- File : Koneko/JSON.hs
+-- Maintainer : Felix C. Stegerman
+-- Date : 2020-11-12
+--
+-- Copyright : Copyright (C) 2020 Felix C. Stegerman
+-- Version : v0.0.1
+-- License : GPLv3+
+--
+-- -- ; }}}1
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Koneko.JSON (initCtx) where
+
+import Control.Exception (throwIO)
+import Data.Foldable (traverse_)
+
+import Koneko.Data
+
+initCtx :: Context -> IO ()
+initCtx ctxMain = do
+ ctx <- forkContext "json" ctxMain
+ traverse_ (defPrim ctx) [jsonTo, jsonFrom]
+
+jsonTo, jsonFrom :: Builtin
+jsonTo = mkBltn "->" $ \_ s -> do
+ (x, s') <- pop' s; either throwIO (rpush1 s') $ fromJSON x
+jsonFrom = mkBltn "<-" $ \_ s -> do
+ (x, s') <- pop' s; either throwIO (rpush1 s') $ toJSON x
+
+-- vim: set tw=70 sw=2 sts=2 et fdm=marker :
diff --git a/src/Koneko/Math.hs b/src/Koneko/Math.hs
new file mode 100644
--- /dev/null
+++ b/src/Koneko/Math.hs
@@ -0,0 +1,49 @@
+-- -- ; {{{1
+--
+-- File : Koneko/Math.hs
+-- Maintainer : Felix C. Stegerman
+-- Date : 2020-02-02
+--
+-- Copyright : Copyright (C) 2020 Felix C. Stegerman
+-- Version : v0.0.1
+-- License : GPLv3+
+--
+-- -- ; }}}1
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Koneko.Math (initCtx) where
+
+import Control.Exception (throwIO)
+import Control.Monad (when)
+import Data.Foldable (traverse_)
+
+import Koneko.Data
+
+initCtx :: Context -> IO ()
+initCtx ctxMain = do
+ ctx <- forkContext "math" ctxMain
+ traverse_ (defPrim ctx) [
+ mkBltn "sign" $ pop1push1 $ either (int . signum) (float . signum),
+ pow, op2 "**" (**), mkBltn "pi" $ const $ flip rpush1 (pi :: Double),
+ op1 "exp" exp, op1 "log" log, op1 "sqrt" sqrt,
+ op1 "sin" sin, op1 "cos" cos, op1 "tan" tan,
+ op1 "asin" asin, op1 "acos" acos, op1 "atan" atan,
+ op1 "sinh" sinh, op1 "cosh" cosh, op1 "tanh" tanh,
+ op1 "asinh" asinh, op1 "acosh" acosh, op1 "atanh" atanh,
+ op2 "atan2" atan2
+ ]
+
+op1 :: Identifier -> (Double -> Double) -> Builtin
+op1 name op = mkBltn name $ pop1push1 op
+
+op2 :: Identifier -> (Double -> Double -> Double) -> Builtin
+op2 name op = mkBltn name $ pop2push1 op
+
+pow :: Builtin
+pow = mkBltn "^" $ \_ s -> do
+ ((x, y), s') <- pop2' s
+ when (y < 0) $ throwIO $ RangeError "negative exponent"
+ rpush1 s' $ (x :: Integer) ^ (y :: Integer)
+
+-- vim: set tw=70 sw=2 sts=2 et fdm=marker :
diff --git a/src/Koneko/Misc.hs b/src/Koneko/Misc.hs
new file mode 100644
--- /dev/null
+++ b/src/Koneko/Misc.hs
@@ -0,0 +1,160 @@
+-- -- ; {{{1
+--
+-- File : Koneko/Misc.hs
+-- Maintainer : Felix C. Stegerman
+-- Date : 2020-11-11
+--
+-- Copyright : Copyright (C) 2020 Felix C. Stegerman
+-- Version : v0.0.1
+-- License : GPLv3+
+--
+-- -- ; }}}1
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Koneko.Misc (
+ Parser, isIdent, pIdent, pIdent_, pInt, pFloat, isSpaceOrComma,
+ lexeme, symbol, speof, sp, sp1, spaceOrComment, prompt, firstJust,
+ parseMaybe
+) where
+
+import Data.Char (isSpace)
+import Data.Functor
+import Data.List ((\\))
+import Data.Maybe (isJust, maybeToList)
+import Data.Text (Text)
+import Data.Void (Void)
+import System.IO (hFlush, stdout)
+import System.IO.Error (catchIOError, isEOFError)
+import Text.Megaparsec
+import Text.Megaparsec.Char hiding (space, space1)
+
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import qualified Text.Megaparsec.Char.Lexer as L
+
+-- parser: common --
+
+type Parser = Parsec Void Text
+
+ -- {{{1
+-- | Is the string an identifier?
+--
+-- NB: only partially checks whether it is a *valid* identifier (i.e.
+-- whether it is not e.g. "nil").
+--
+-- >>> :set -XOverloadedStrings
+-- >>> isIdent "nil" -- OOPS
+-- True
+-- >>> isIdent ""
+-- False
+-- >>> isIdent "42"
+-- False
+-- >>> isIdent "foo-bar'"
+-- True
+-- >>> isIdent "[子猫]"
+-- True
+-- >>> isIdent "'foo"
+-- False
+-- >>> isIdent "@$%^&*!"
+-- True
+-- >>> isIdent "["
+-- False
+-- >>> isIdent "]"
+-- False
+-- >>> isIdent "x]"
+-- True
+-- >>> isIdent "x["
+-- False
+-- >>> isIdent "x:"
+-- False
+--
+
+ -- }}}1
+isIdent :: Text -> Bool
+isIdent s = parses pIdent s && not (parses pInt s || parses pFloat s)
+
+-- | NB: also matches float and int
+pIdent :: Parser Text
+pIdent = pIdent_ Nothing
+
+-- TODO
+pIdent_ :: Maybe Char-> Parser Text
+pIdent_ ok = T.pack <$> (try a <|> b)
+ where
+ a = (:[]) <$> okChar <* notFollowedBy miChar
+ b = (:) <$> hdChar <*> some (try b1 <|> tlChar)
+ b1 = miChar <* notFollowedBy (speof <|> (bad >> speof))
+ okChar = letterChar <|> numberChar <|> symbolChar <|> oneOf specialChar
+ hdChar = okChar <|> oneOf brackets
+ miChar = hdChar <|> oneOf badStart
+ tlChar = okChar <|> oneOf bracketsC <|> good
+ bad = oneOf $ badEnd \\ maybeToList ok
+ good = oneOf $ goodTail ++ maybeToList ok
+
+brackets, bracketsO, bracketsC, specialChar, badStart, goodTail,
+ badEnd :: [Char]
+
+brackets = bracketsO ++ bracketsC
+bracketsO = "({["
+bracketsC = ")}]"
+specialChar = "@%&*-_/?"
+badStart = goodTail ++ ":"
+goodTail = "'!"
+badEnd = bracketsO ++ ":"
+
+pInt :: Parser Integer
+pInt = hex <|> bin <|> dec
+ where
+ hex = string "0x" *> L.hexadecimal
+ bin = string "0b" *> L.binary
+ dec = signed L.decimal
+
+pFloat :: Parser Double
+pFloat = signed L.float
+
+-- parser: helpers --
+
+signed :: Num a => Parser a -> Parser a
+signed = L.signed $ return ()
+
+isSpaceOrComma :: Char -> Bool
+isSpaceOrComma c = isSpace c || c == ','
+
+parses :: Parser a -> Text -> Bool
+parses p = isJust . parseMaybe p
+
+-- parser: utilities --
+
+lexeme :: Parser a -> Parser a
+lexeme p = p <* speof
+
+symbol :: Text -> Parser Text
+symbol = lexeme . string
+
+speof, sp, sp1, spaceOrComment, space1 :: Parser ()
+
+speof = sp1 <|> eof
+sp = skipMany spaceOrComment
+sp1 = skipSome spaceOrComment
+
+spaceOrComment = space1 <|> (L.skipLineComment ";")
+
+space1 = void $ takeWhile1P (Just "white space") isSpaceOrComma
+
+-- utilities --
+
+prompt :: Maybe Text -> IO (Maybe Text)
+prompt x = (Just <$> f) `catchIOError` g
+ where
+ f = maybe (return ()) h x >> T.getLine
+ g e = if isEOFError e then return Nothing else ioError e
+ h s = do T.putStr s; hFlush stdout
+
+-- miscellaneous --
+
+firstJust :: Monad m => [m (Maybe a)] -> m (Maybe a)
+firstJust [] = return Nothing
+firstJust (x:xt) = x >>= maybe (firstJust xt) (return . Just)
+
+-- vim: set tw=70 sw=2 sts=2 et fdm=marker :
diff --git a/src/Koneko/Prim.hs b/src/Koneko/Prim.hs
new file mode 100644
--- /dev/null
+++ b/src/Koneko/Prim.hs
@@ -0,0 +1,495 @@
+-- -- ; {{{1
+--
+-- File : Koneko/Prim.hs
+-- Maintainer : Felix C. Stegerman
+-- Date : 2022-02-12
+--
+-- Copyright : Copyright (C) 2022 Felix C. Stegerman
+-- Version : v0.0.1
+-- License : GPLv3+
+--
+-- -- ; }}}1
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Koneko.Prim (initCtx, replDef, swap) where
+
+import Control.Arrow ((***))
+import Control.Concurrent (threadDelay)
+import Control.Concurrent.Async (concurrently)
+import Control.DeepSeq (($!!), force, NFData)
+import Control.Exception (catch, evaluate, throwIO, try)
+import Control.Monad (unless)
+import Data.Bits ((.|.))
+import Data.Char (chr, isDigit)
+import Data.Data (toConstr)
+import Data.Foldable (traverse_)
+import Data.List (isSuffixOf, sort)
+import Data.Text (Text)
+import Data.Version (showVersion, versionBranch)
+import Prelude hiding (lookup)
+import System.Directory (listDirectory)
+import System.FilePath (())
+import System.Random (getStdRandom, randomR)
+
+#if !MIN_VERSION_GLASGOW_HASKELL(8, 8, 1, 0)
+import Data.Monoid ((<>))
+#endif
+
+import qualified Control.Exception as E
+import qualified Data.Array as A
+import qualified Data.ByteString as BL
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as E
+import qualified Data.Text.IO as T
+import qualified System.Info as I
+import qualified Text.Regex.PCRE as RE
+import qualified Text.Regex.PCRE.ByteString as RE
+
+import Koneko.Data
+import Koneko.Misc (prompt)
+
+import qualified Paths_koneko as P
+
+-- TODO
+initCtx :: Context -> (Identifier -> IO ()) -> Evaluator -> Evaluator
+ -> Evaluator -> (Block -> Evaluator) -> IO ()
+initCtx ctxMain load call apply apply_dict callBlock = do
+ ctx <- forkContext primModule ctxMain
+ traverse_ (defPrim ctx) [
+ mkPrim "call" call, mkPrim "apply" apply,
+ mkPrim "apply-dict" apply_dict, if' call,
+ def, defmulti, defrecord call, mkPair, mkDict, swap,
+ show', puts, ask, types, type', callable, function,
+ defmodule call, modules, moduleGet, moduleDefs, moduleName,
+ import', importFrom, loadModule load,
+ comp "=" (==), comp "not=" (/=),
+ comp "<" (<) , comp "<=" (<=),
+ comp ">" (>) , comp ">=" (>=),
+ spaceship,
+ comp' "eq" (== EQ), comp' "neq" (/= EQ),
+ comp' "lt" (== LT), comp' "lte" (/= GT),
+ comp' "gt" (== GT), comp' "gte" (/= LT),
+ cmp',
+ arithI "int+" (+), arithI "int-" (-), arithI "int*" (*),
+ arithI "div" div, arithI "mod" mod,
+ arithF "float+" (+), arithF "float-" (-),
+ arithF "float*" (*), arithF "float/" (/),
+ abs', neg,
+ floatToInt "trunc" (truncate), floatToInt "round" (round),
+ floatToInt "ceil" (ceiling) , floatToInt "floor" (floor),
+ chr', intToFloat, recordToDict,
+ recordType, recordVals,
+ recordTypeName, recordTypeFields,
+ mkThunk callBlock,
+ fail', try' callBlock,
+ mkIdent, mkQuot, mkBlock, blockParams, blockCode,
+ rxMatch, rxSub callBlock,
+ par callBlock, sleep,
+ version,
+ showStack call, clearStack, nya
+ ]
+
+-- primitives: important --
+
+if', defrecord :: Evaluator -> Builtin
+def, defmulti, mkPair, mkDict, swap :: Builtin
+
+if' call = mkPrim "if" $ \c s -> do
+ ((cond, t_br, f_br), s') <- pop3' s
+ call c $ push' s' $ if truthy cond then t_br else f_br
+
+def = mkPrim "def" $ \c s -> do
+ ((Kwd k, v), s') <- pop2' s; s' <$ defineIn c k v
+
+defmulti = mkPrim "defmulti" $ \c s -> do
+ ((Kwd k, sig, b), s') <- pop3' s
+ sig' <- traverse (f c) =<< unKwds sig
+ s' <$ defMulti c k sig' b
+ where
+ f c k | k == "_" || k `elem` typeNames = return k
+ | otherwise = lookup c k >>= \case
+ Just (KRecordT t) -> return $ recordTypeSig t
+ Just _ -> throwIO $ expected $ T.unpack k ++ " to be a record-type"
+ _ -> throwIO $ NameError $ T.unpack k
+
+-- TODO
+defrecord call = mkPrim "defrecord" $ \c s -> do
+ ((Kwd recName, fs), s') <- pop2' s; recFields <- unKwds fs
+ let t = RecordT{..}; e x = err x $ T.unpack recName
+ defineIn c recName $ KRecordT t
+ defX c (recName <> "?") $ pop1push1 $ m t (const True) False
+ defX c ("^" <> recName) $ \c1 s1 -> do
+ ((x, f), s2) <- pop2' s1
+ let go r = rpush s2 $ recValues r ++ [f]
+ call c1 =<< m t go (e x) x
+ defX c ("~" <> recName) $ \c1 s1 -> do
+ ((x, f, g), s2) <- pop3' s1
+ let go r = recValues r ++ [f]
+ call c1 =<< rpush s2 (m t go [g] x)
+ return s'
+ where
+ m t f d = \case KRecord r | recType r == t -> f r; _ -> d
+ defX c k = defineIn c k . KBuiltin .
+ mkBltn (modName (ctxScope c) <> ":" <> k)
+ err x t = throwIO $ stackExpected (Left $ tp x)
+ $ "record of type " <> t
+ tp = \case KRecord r -> "record of type " ++
+ T.unpack (recName $ recType r)
+ x -> typeAsStr x
+
+mkPair = mkPrim "=>" $ pop2push1 Pair
+
+mkDict = mkPrim "dict" $ \_ s -> do
+ (l, s') <- pop' s
+ rpush1 s' =<< dict <$> (retOrThrow $ fromVals l)
+
+-- needed as primitive by read for .foo
+swap = mkPrim "swap" $ pop2push $ \x y -> [y, x] :: [KValue]
+
+-- primitives: show, I/O & types --
+
+show', puts, ask, types, type', callable, function :: Builtin
+
+show' = mkPrim "show" $ pop1push1 $ T.pack . (show :: KValue -> String)
+
+-- NB: uses stdio
+puts = mkPrim "puts!" $ \_ s -> do (x, s') <- pop' s; s' <$ T.putStr x
+
+-- NB: uses stdio
+ask = mkPrim "ask!" $ \_ s -> do
+ (x, s') <- pop' s; prompt x >>= rpush1 s'
+
+types = mkPrim "types" $ const $ flip rpush1 $ map kwd typeNames
+type' = mkPrim "type" $ pop1push1 $ typeToKwd . typeOf
+callable = mkPrim "callable?" $ pop1push1 isCallable
+function = mkPrim "function?" $ pop1push1 isFunction
+
+-- primitives: modules --
+
+defmodule :: Evaluator -> Builtin
+modules, moduleGet, moduleDefs, moduleName, import', importFrom :: Builtin
+
+defmodule call = mkPrim "defmodule" $ \c s -> do
+ ((Kwd m, b), s') <- pop2' s; c' <- forkContext m c
+ call c $ push s' $ KBlock b { blkScope = Just $ ctxScope c' }
+
+modules = mkPrim "modules" $ \c s -> do
+ sort . map kwd <$> moduleNames c >>= rpush1 s
+
+moduleGet = mkPrim "module-get" $ \c s -> do
+ ((Kwd k, Kwd m), s') <- pop2' s
+ lookupModule' c k m >>= rpush1 s'
+
+moduleDefs = mkPrim "module-defs" $ \c s -> do
+ (Kwd m, s') <- pop' s
+ sort . map kwd <$> moduleKeys c m >>= rpush1 s'
+
+moduleName = mkPrim "name" $ \c s ->
+ rpush1 s $ kwd $ modName $ ctxScope c
+
+import' = mkPrim "import" $ \c s -> do
+ (Kwd m, s') <- pop' s; s' <$ importIn c m
+
+importFrom = mkPrim "import-from" $ \c s -> do
+ ((ks, Kwd m), s') <- pop2' s; s' <$ (importFromIn c m =<< unKwds ks)
+
+loadModule :: (Identifier -> IO ()) -> Builtin
+loadModule load = mkPrim "load-module" $ \_ s -> do
+ (Kwd m, s') <- pop' s; s' <$ load m
+
+-- primitives: Eq, Ord --
+
+comp :: Identifier -> (KValue -> KValue -> Bool) -> Builtin
+comp name = mkPrim name . pop2push1
+
+comp' :: Identifier -> (Ordering -> Bool) -> Builtin
+comp' name f = mkPrim name $ pop2push1 $ \x y -> f $ _cmp' x y
+
+spaceship, cmp' :: Builtin
+spaceship = mkPrim "<=>" $ pop2push1 $ \x y -> _ordToInt $ _cmp x y
+cmp' = mkPrim "cmp" $ pop2push1 $ \x y -> _ordToInt $ _cmp' x y
+
+_cmp, _cmp' :: KValue -> KValue -> Ordering
+_cmp = compare
+_cmp' = cmp
+
+_ordToInt :: Ordering -> Integer
+_ordToInt LT = -1
+_ordToInt EQ = 0
+_ordToInt GT = 1
+
+-- primitives: arithmetic --
+
+arith :: (FromVal a, ToVal a, NFData a)
+ => Identifier -> (a -> a -> a) -> Builtin
+arith name op = mkPrim name $ \_ s -> do
+ ((x, y), s') <- pop2' s
+ rpush1 s' =<< (f $ evaluate $ force $ op x y)
+ where
+ f = flip catch $ \case E.DivideByZero -> throwIO DivideByZero
+ e -> throwIO e
+
+arithI :: Identifier -> (Integer -> Integer -> Integer) -> Builtin
+arithF :: Identifier -> (Double -> Double -> Double ) -> Builtin
+arithI = arith
+arithF = arith
+
+abs', neg :: Builtin
+
+abs' = mkPrim "abs" $ pop1push1 $ either
+ (toVal . (abs :: Integer -> Integer))
+ (toVal . (abs :: Double -> Double ))
+
+neg = mkPrim "neg" $ pop1push1 $ either
+ (toVal . (negate :: Integer -> Integer))
+ (toVal . (negate :: Double -> Double ))
+
+-- primitives: conversion --
+
+floatToInt :: Identifier -> (Double -> Integer) -> Builtin
+floatToInt name f = mkPrim name $ pop1push1 g
+ where
+ g n = if isNaN n || isInfinite n then nil else int $ f n
+
+chr', intToFloat, recordToDict :: Builtin
+
+chr' = mkPrim "chr" $ \_ s -> do
+ (i, s') <- pop' s
+ unless (0 <= i && i < 0x110000) $ throwIO $
+ stackExpected (Left $ show i) "int in range [0,0x110000)"
+ rpush1 s' $ T.singleton $ chr $ fromInteger i
+
+intToFloat
+ = mkPrim "int->float" $ pop1push1 (fromInteger :: Integer -> Double)
+
+recordToDict = mkPrim "record->dict" $ pop1push1 $ dict . recordToPairs
+
+-- primitives: record --
+
+recordType, recordVals :: Builtin
+recordType = mkPrim "record-type" $ pop1push1 $ KRecordT . recType
+recordVals = mkPrim "record-values" $ pop1push1 $ recValues
+
+-- primitives: record-type info --
+
+recordTypeName, recordTypeFields :: Builtin
+recordTypeName = mkPrim "record-type-name" $ pop1push1 $ Kwd . recName
+recordTypeFields = mkPrim "record-type-fields" $ pop1push1
+ $ map kwd . recFields
+
+-- primitives: thunk --
+
+mkThunk :: (Block -> Evaluator) -> Builtin
+mkThunk callBlock = mkPrim "thunk" $ \c s -> do
+ (b, s') <- pop' s
+ t <- thunk $ do
+ l <- callBlock b c emptyStack
+ unless (length l == 1) $ throwIO $
+ expected "thunk to produce exactly 1 value"
+ return $ head l -- safe!
+ rpush1 s' $ KThunk t
+
+-- primitives: exceptions --
+
+fail' :: Builtin
+fail' = mkPrim "fail" $ \_ s -> do
+ (msg, _) <- pop' s; throwIO $ Fail $ T.unpack msg
+
+try' :: (Block -> Evaluator) -> Builtin
+try' callBlock = mkPrim "try" $ \c s0 -> do
+ ((f, g, h), s1) <- pop3' s0
+ r <- try $ (return $!!) =<< callBlock f c emptyStack
+ (b, s3) <- pop' =<< either (cat (flip callBlock c) g)
+ (return . (`push` false)) r
+ s4 <- (++ s3 ++ s1) <$> callBlock h c emptyStack
+ unless (truthy b) $ either throwIO (const $ return ()) r
+ return s4
+ where
+ cat cb g e = maybe (return [false]) (\b -> cb b $ _errInfo e) g
+
+_errInfo :: KException -> [KValue] -- NB: reverse order
+_errInfo e = [list $ map T.pack $ exceptionInfo e,
+ str $ T.pack $ show e, kwd $ T.pack $ show $ toConstr e]
+
+-- primitives: homoiconicity --
+
+mkIdent, mkQuot, mkBlock, blockParams, blockCode :: Builtin
+
+mkIdent = _mkIQ "ident" KIdent
+mkQuot = _mkIQ "quot" KQuot
+
+-- NB: must use existing block to provide Scope
+mkBlock = mkPrim "block" $ \_ s -> do
+ ((ps, code, b), s') <- pop3' s
+ ps' <- traverse _mkId =<< unKwds ps
+ rpush1 s' $ block ps' code $ blkScope b
+
+blockParams = mkPrim "block-params" $ pop1push1 $
+ list . map (kwd . unIdent) . blkParams
+
+blockCode = mkPrim "block-code" $ pop1push1 blkCode
+
+_mkIQ :: Identifier -> (Ident -> KValue) -> Builtin
+_mkIQ n f = mkPrim n $ \_ s -> do
+ (Kwd k, s') <- pop' s; rpush1 s' =<< f <$> _mkId k
+
+_mkId :: Identifier -> IO Ident
+_mkId k = maybe err return $ ident k
+ where
+ err = throwIO $ expected $ T.unpack k ++ " to be a valid ident"
+
+-- primitives: regex --
+
+-- TODO
+rxMatch :: Builtin
+rxMatch = mkPrim "rx-match" $ \_ s -> do
+ ((x, r), s') <- pop2' s
+ rpush1 s' =<< (f . _rxGetMatches . _rxMatch x) <$> _rxCompile r
+ where
+ f = fmap $ \(_, m, _) -> list m
+
+-- TODO
+rxSub :: (Block -> Evaluator) -> Builtin
+rxSub callBlock = mkPrim "rx-sub" $ \c s -> do
+ ((x, s_b, r, glob), s') <- pop4' s; rx <-_rxCompile r
+ let strsub t m = return $ _dollar t m
+ blksub b m = do
+ l <- callBlock b c $ reverse $ map str m
+ unless (length l == 1) $ throwIO $
+ expected "rx-sub block to produce exactly 1 value"
+ fst <$> pop' l
+ sub = either strsub blksub s_b
+ sub1 (bf,m,af) = do t <- sub m; return $ bf <> t <> af
+ rpush1 s' =<< if glob
+ then maybe x id <$> _rxReplaceAll (E.encodeUtf8 x) (_rxMatchAll x rx) sub
+ else maybe (return x) sub1 (_rxGetMatches $ _rxMatch x rx)
+
+-- TODO
+_dollar :: Text -> [Text] -> Text
+_dollar _ [] = error "WTF"
+_dollar t m = T.pack $ f $ T.unpack t
+ where
+ -- NB: read & !! are safe!
+ f ('$':'$':t_) = '$' : f t_
+ f ('$':'&':t_) = g 0 ++ f t_
+ f ('$':i:j:t_) | otn i && isDigit j && ok n = g n ++ f t_
+ where n = read [i,j]
+ f ('$':i: t_) | otn i && ok n = g n ++ f t_
+ where n = read [i]
+ f (c:t_) = c : f t_
+ f [] = []
+ otn i = isDigit i && i /= '0'
+ ok n = 0 < n && n < l
+ g n = T.unpack $ m !! n
+ l = length m
+
+_rxCompile :: Text -> IO RE.Regex
+_rxCompile x = f x >>= either (throwIO . InvalidRx . show) return
+ where
+ f = RE.compile c RE.execBlank . E.encodeUtf8
+ c = RE.compBlank .|. RE.compUTF8 .|. RE.compDollarEndOnly
+
+_rxMatch
+ :: Text -> RE.Regex
+ -> Maybe (BL.ByteString, RE.MatchText BL.ByteString, BL.ByteString)
+_rxMatch s r = RE.matchOnceText r $ E.encodeUtf8 s
+
+_rxMatchAll :: Text -> RE.Regex -> [RE.MatchText BL.ByteString]
+_rxMatchAll s r = RE.matchAllText r $ E.encodeUtf8 s
+
+_rxGetMatches
+ :: Maybe (BL.ByteString, RE.MatchText BL.ByteString, BL.ByteString)
+ -> Maybe (Text, [Text], Text)
+_rxGetMatches
+ = fmap $ \(b,m,a) -> (E.decodeUtf8 b, _rxMatches m, E.decodeUtf8 a)
+
+_rxReplaceAll
+ :: BL.ByteString -> [RE.MatchText BL.ByteString]
+ -> ([Text] -> IO Text) -> IO (Maybe Text)
+_rxReplaceAll _ [] _ = return Nothing
+_rxReplaceAll src ms sub = Just . T.concat . concat <$> f 0 src ms
+ where
+ f _ s [] = return [[E.decodeUtf8 s]]
+ f i s (m:mt) = do
+ t <- sub $ _rxMatches m
+ ([E.decodeUtf8 s1, t]:) <$> f (off + len) (BL.drop len s2) mt
+ where
+ (s1, s2) = BL.splitAt (off - i) s
+ (off, len) = (toEnum *** toEnum) $ snd (m A.! 0) -- safe!
+
+_rxMatches :: RE.MatchText BL.ByteString -> [Text]
+_rxMatches = map (E.decodeUtf8 . fst) . A.elems
+
+-- primitives: concurrency --
+
+-- TODO
+par :: (Block -> Evaluator) -> Builtin
+par callBlock = mkPrim "par" $ \c s -> do
+ ((f, g), s') <- pop2' s
+ (l1, l2) <- concurrently (callBlock f c emptyStack)
+ (callBlock g c emptyStack)
+ return (l2 ++ l1 ++ s')
+
+sleep :: Builtin
+sleep = mkPrim "sleep" $ \_ s -> do
+ (n, s') <- pop' s
+ let ms = either (1000 *) (round . ((1000 :: Double) *)) n
+ s' <$ threadDelay (fromInteger $ 1000 * ms)
+
+-- primitives: miscellaneous --
+
+version :: Builtin
+version = mkPrim "version" $ const $ flip rpush1
+ $ [list $ map int _koneko_version, kwd("hs"),
+ list $ map str _platform]
+
+_koneko_version :: [Integer]
+_koneko_version = map toInteger $ versionBranch P.version
+
+_platform :: [Text]
+_platform = map T.pack [I.os ++ " " ++ I.arch, c ++ " " ++ v]
+ where
+ c = I.compilerName; v = showVersion I.compilerVersion
+
+-- repl --
+
+replDef :: Context -> IO ()
+replDef ctx = do
+ alias ["show-stack!" , "s!"] Nothing primModule
+ alias ["clear-stack!", "c!"] Nothing primModule
+ alias ["d!"] (Just "display!") prldModule
+ alias ["D!"] (Just "ddisplay!") prldModule
+ defineIn ctx "__repl__" true
+ where
+ alias new old m = do -- safe!
+ x <- lookupModule' ctx (maybe (underscored $ head new) id old) m
+ traverse_ (flip (defineIn ctx) x) new
+
+-- TODO
+showStack :: Evaluator -> Builtin
+showStack call = mkPrim "show-stack!" $ \c s -> s <$ do
+ p <- lookupModule' c "show" prldModule
+ let f x = fst <$> (pop' =<< call c [p, x]) >>= T.putStrLn
+ putStrLn "--- STACK ---"
+ traverse_ f s
+ putStrLn "--- END ---"
+
+clearStack :: Builtin
+clearStack = mkPrim "clear-stack!" $ \_ _ ->
+ emptyStack <$ T.putStrLn "*** STACK CLEARED ***"
+
+-- nya --
+
+nya :: Builtin
+nya = mkPrim "nya!" $ \_ s -> s <$ do
+ nyaD <- P.getDataFileName "nya"
+ cats <- filter (isSuffixOf ".cat") <$> listDirectory nyaD
+ unless (null cats) $ do
+ i <- getStdRandom $ randomR (0, length cats -1)
+ (T.readFile $ nyaD (cats !! i)) >>= T.putStr
+
+-- vim: set tw=70 sw=2 sts=2 et fdm=marker :
diff --git a/src/Koneko/Prld.hs b/src/Koneko/Prld.hs
new file mode 100644
--- /dev/null
+++ b/src/Koneko/Prld.hs
@@ -0,0 +1,22 @@
+-- -- ; {{{1
+--
+-- File : Koneko/Prld.hs
+-- Maintainer : Felix C. Stegerman
+-- Date : 2020-01-20
+--
+-- Copyright : Copyright (C) 2020 Felix C. Stegerman
+-- Version : v0.0.1
+-- License : GPLv3+
+--
+-- -- ; }}}1
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Koneko.Prld (initCtx) where
+
+import Koneko.Data
+
+initCtx :: Context -> (Identifier -> IO ()) -> IO ()
+initCtx _ load = load "prelude"
+
+-- vim: set tw=70 sw=2 sts=2 et fdm=marker :
diff --git a/src/Koneko/Read.hs b/src/Koneko/Read.hs
new file mode 100644
--- /dev/null
+++ b/src/Koneko/Read.hs
@@ -0,0 +1,240 @@
+-- -- ; {{{1
+--
+-- File : Koneko/Read.hs
+-- Maintainer : Felix C. Stegerman
+-- Date : 2022-02-12
+--
+-- Copyright : Copyright (C) 2022 Felix C. Stegerman
+-- Version : v0.0.1
+-- License : GPLv3+
+--
+-- -- ; }}}1
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+ -- {{{1
+-- |
+--
+-- >>> :set -XOverloadedStrings
+-- >>> x = read "nil #f 42 3.14 \"Hello, World!\" :foo foo"
+-- >>> x
+-- [nil,#f,42,3.14,"Hello, World!",:foo,foo]
+-- >>> map D.typeOf x
+-- [#<::nil>,#<::bool>,#<::int>,#<::float>,#<::str>,#<::kwd>,#<::ident>]
+--
+-- >>> x = read "( 1 2 :foo ) 'foo [ x . 'x 'x ]"
+-- >>> x
+-- [( 1 2 :foo ),'foo,[ x . 'x 'x ]]
+-- >>> map D.typeOf x
+-- [#<::list>,#<::quot>,#<::block>]
+--
+-- ... TODO ...
+--
+
+ -- }}}1
+
+module Koneko.Read (read, read') where
+
+import Control.Exception (throw)
+import Control.Monad (replicateM)
+import Data.Functor
+import Data.List (foldl')
+import Data.Maybe (fromJust) -- careful!
+import Data.Text (Text)
+import Prelude hiding (quot, read)
+import Text.Megaparsec
+import Text.Megaparsec.Char
+
+#if !MIN_VERSION_GLASGOW_HASKELL(8, 8, 1, 0)
+import Control.Monad.Fail (MonadFail)
+import Data.List (init)
+#endif
+
+import qualified Data.Char as C
+import qualified Data.Text as T
+
+import Koneko.Data (Identifier, Ident, Block(..), KValue(..))
+import Koneko.Misc (Parser, pIdent, pIdent_, pInt, pFloat, lexeme,
+ symbol, sp)
+
+import qualified Koneko.Data as D
+
+-- TODO:
+-- * parser labels
+-- * test corner cases & failures
+
+read :: Text -> [KValue]
+read = read' "(read)"
+
+read' :: FilePath -> Text -> [KValue]
+read' f code = either (throw . D.ParseError . errorBundlePretty) id
+ $ parse program f code
+
+-- parser: primitives --
+
+nil, bool, int, float, str, kwd :: Parser KValue
+
+bool = (D.false <$ string "#f") <|>
+ (D.true <$ string "#t")
+
+nil = D.nil <$ string "nil"
+int = D.int <$> pInt
+float = D.float <$> pFloat
+str = D.str <$> _str
+kwd = D.kwd <$> (char ':' *> (_str <|> pIdent))
+
+_str :: Parser Text
+_str = char '"' >> T.concat <$> manyTill (choice [
+ esc, hex "\\x" 2, hex "\\u" 4, hex "\\U" 8, chr
+ ]) (char '"')
+ where
+ esc = choice [ t <$ string f | (f,t) <- bsl ] "escape sequence"
+ chr = T.singleton <$> anySingle "character"
+ bsl = zip D.escapeFrom D.escapeTo
+ hex p n = string p >> T.singleton <$> _hex n
+
+_hex :: Int -> Parser Char
+_hex n = C.chr . foldl' (\a c -> a * 16 + C.digitToInt c) 0 <$>
+ replicateM n (satisfy C.isHexDigit "hex digit")
+
+-- TODO: rx
+
+-- parser: values --
+
+prim, list, ident, quot, block :: Parser KValue
+
+prim = choice $ map (try . lexeme) [nil, int, float] ++
+ map lexeme [bool, str, kwd]
+
+list = try $ D.list <$> (a <|> b)
+ where
+ a = [] <$ symbol "()"
+ b = symbol "(" *> manyValuesTill (symbol ")")
+
+-- | NB: also matches float and int (but they match earlier)
+ident = KIdent <$> ident_
+quot = char '\'' >> KQuot <$> ident_
+block = KBlock <$> block_
+
+-- TODO
+block_ :: Parser Block
+block_ = try $ do
+ _ <- symbol "["
+ params <- concat <$> (optional $ try $ manyTill ident_ $ symbol ".")
+ code <- manyValuesTill $ symbol "]"
+ return $ Block params code Nothing
+
+-- parser: sugar --
+
+ellipsis, modid, qmodid, qhole, dhole, qdig, ddig, qdot, qbang, dot,
+ bang, dict, key, apply, applyDict, idblk :: Parser [KValue]
+
+ellipsis = [_IDENT "ellipsis"] <$ symbol "..."
+
+modid = try $ do
+ m <- D.kwd . D.unIdent <$> identNL <* char '.'
+ i <- D.kwd . D.unIdent <$> ident_
+ return [i, m, _IDENT "module-get", _IDENT "call"]
+
+qmodid = try $ char '\'' >> init <$> modid -- safe!
+
+-- TODO
+qhole = try $ char '\'' >> _wrap <$> block_
+dhole = try $ char '.' >> ((++ [_IDENT "call"]) . _wrap) <$> block_
+
+qdig = try $ char '\'' >> _dig (KQuot . _IDENT') -- safe!
+ddig = try $ char '.' >> _dig _IDENT -- safe!
+
+qdot = string "'." >> _blk <$> _isc []
+qbang = string "'!" >> _blk <$> _isc [_IDENT "call"]
+
+dot = char '.' >> _isc []
+bang = char '!' >> _isc [_IDENT "call"]
+
+dict = try $ fmap ((:[_IDENT "dict"]) . D.list)
+ $ symbol "{" *> manyValuesTill (symbol "}")
+
+key = try $ do
+ k <- sugarIdent ':'; v <- value_
+ return $ [D.kwd k] ++ v ++ [_IDENT "=>"]
+
+apply = try $ do
+ (q, l) <- _ap '(' ")"; return [l, q, _IDENT "apply"]
+
+applyDict = try $ do
+ (q, l) <- _ap '{' "}"
+ return [l, _IDENT "dict", q, _IDENT "apply-dict"]
+
+idblk = try $ do i <- identNL; b <- block_; return [KBlock b, KIdent i]
+
+_wrap :: Block -> [KValue]
+_wrap b = [D.block (D.digitParams b) [KBlock b] Nothing]
+
+_dig :: (Text -> KValue) -> Parser [KValue]
+_dig f = fmap ((:[]) . f . T.singleton)
+ $ lexeme $ satisfy (`elem` ['1'..'9'])
+
+_blk :: [KValue] -> [KValue]
+_blk code = [D.block [] code Nothing]
+
+_isc :: [KValue] -> Parser [KValue]
+_isc vs = f <$> ident_
+ where
+ f i = [D.kwd $ D.unIdent i, _IDENT "swap", _IDENT "call"] ++ vs
+
+_ap :: Char -> Text -> Parser (KValue, KValue)
+_ap op cl = do
+ i <- sugarIdent op; vs <- manyValuesTill $ symbol cl
+ q <- KQuot <$> identOrFail i
+ return (q, D.list vs)
+
+sugar :: Parser [KValue]
+sugar = choice [
+ ellipsis, modid, qmodid, qhole, dhole, qdig, ddig, qdot, qbang,
+ dot, bang, dict, key, apply, applyDict, idblk
+ ]
+
+-- parser: multiple values & program --
+
+-- | NB: match ident last
+oneValue :: Parser KValue
+oneValue = choice [prim, list, quot, block, ident]
+
+value_, manyValues, program :: Parser [KValue]
+
+value_ = sugar <|> (:[]) <$> oneValue
+manyValues = concat <$> many value_
+program = optional shebang *> sp *> manyValues <* eof
+
+manyValuesTill :: Parser a -> Parser [KValue]
+manyValuesTill end = concat <$> manyTill value_ end
+
+shebang :: Parser ()
+shebang = void $ string "#!" >> many (satisfy (/= '\n')) >> newline
+
+-- parser: miscellaneous --
+
+ident_, identNL :: Parser Ident
+ident_ = lexeme $ identNL
+identNL = pIdent >>= identOrFail
+
+-- TODO
+sugarIdent :: Char -> Parser Identifier
+sugarIdent c = try $ do
+ i <- lexeme $ pIdent_ $ Just c
+ if T.last i /= c then fail "TODO" else return $ T.init i -- safe!
+
+-- miscellaneous --
+
+-- UNSAFE!
+_IDENT :: Text -> KValue
+_IDENT' :: Text -> Ident
+_IDENT = KIdent . _IDENT'
+_IDENT' = fromJust . D.ident . D.underscored
+
+identOrFail :: MonadFail m => Identifier -> m Ident
+identOrFail = maybe (fail "invalid ident") return . D.ident
+
+-- vim: set tw=70 sw=2 sts=2 et fdm=marker :
diff --git a/src/Koneko/Repl.hs b/src/Koneko/Repl.hs
new file mode 100644
--- /dev/null
+++ b/src/Koneko/Repl.hs
@@ -0,0 +1,62 @@
+-- -- ; {{{1
+--
+-- File : Koneko/Repl.hs
+-- Maintainer : Felix C. Stegerman
+-- Date : 2022-02-12
+--
+-- Copyright : Copyright (C) 2022 Felix C. Stegerman
+-- Version : v0.0.1
+-- License : GPLv3+
+--
+-- -- ; }}}1
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Koneko.Repl (repl, repl', promptText, errorText) where
+
+import Control.Monad (unless)
+import Data.String (IsString)
+import Data.Text (Text)
+import System.IO (hPutStrLn, stderr)
+
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+
+import Koneko.Data (Context, Stack)
+import Koneko.Eval (evalText, tryK)
+import Koneko.Misc (prompt)
+import Koneko.Prim (replDef)
+
+-- TODO: readline? or just rlwrap?
+
+repl :: Context -> Stack -> IO ()
+repl c s = () <$ repl' False promptText c s
+
+-- | NB: when an exception is caught during the evaluation of a line,
+-- the exeption is printed and the repl continues with the stack reset
+-- to what it was before that line; however, any definitions that were
+-- added to a module before the exception occurred will have taken
+-- effect.
+repl' :: Bool -> Text -> Context -> Stack -> IO Stack
+repl' breakOnError pr ctx st = replDef ctx >> loop ctx st
+ where
+ loop :: Context -> Stack -> IO Stack
+ loop c s = prompt (Just pr) >>= maybe (s <$ T.putStrLn "") f
+ where
+ f line = if T.null line then loop c s else do
+ r <- tryK $ et line c s >>= showTop c line
+ let err e = do hPutStrLn stderr $ errorText ++ show e
+ if breakOnError then return s else loop c s
+ either err (loop c) r
+ showTop c line s = s <$ unless (shouldSkip s line)
+ (() <$ et "__prld__.show __prld__.say!" c (take 1 s)) -- TODO
+ et = evalText "(repl)"
+
+shouldSkip :: Stack -> Text -> Bool
+shouldSkip s line = null s || T.head line `elem` [',',';'] -- safe!
+
+promptText, errorText :: IsString s => s
+promptText = ">>> "
+errorText = "*** ERROR: "
+
+-- vim: set tw=70 sw=2 sts=2 et fdm=marker :
diff --git a/src/Koneko/Test.hs b/src/Koneko/Test.hs
new file mode 100644
--- /dev/null
+++ b/src/Koneko/Test.hs
@@ -0,0 +1,302 @@
+-- -- ; {{{1
+--
+-- File : Koneko/Test.hs
+-- Maintainer : Felix C. Stegerman
+-- Date : 2022-02-12
+--
+-- Copyright : Copyright (C) 2022 Felix C. Stegerman
+-- Version : v0.0.1
+-- License : GPLv3+
+--
+-- -- ; }}}1
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Koneko.Test (
+ doctest, doctest', testFiles, testKoneko, testMarkdown, testKoneko_,
+ testMarkdown_, testKonekoFile, testMarkdownFile, testKonekoFile_,
+ testMarkdownFile_
+) where
+
+import GHC.IO.Handle (hDuplicate, hDuplicateTo)
+
+import Control.Exception (bracket)
+import Control.Monad (unless, when)
+import Data.Char (isSpace)
+import Data.Foldable (foldl', traverse_)
+import Data.Text (Text)
+import Prelude hiding (exp, fail)
+import System.Console.CmdArgs.Verbosity (Verbosity(..), getVerbosity)
+import System.Directory (getTemporaryDirectory, removeFile)
+import System.Exit (exitFailure)
+import System.FilePath (takeExtension)
+import System.IO (Handle)
+
+#if !MIN_VERSION_GLASGOW_HASKELL(8, 8, 1, 0)
+import Data.Monoid((<>))
+#endif
+
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import qualified System.IO as IO
+import qualified System.IO.Silently as S
+
+import Koneko.Data (Context, Stack, emptyStack, initMain)
+import Koneko.Eval (initContext)
+
+import qualified Koneko.Repl as RE
+
+data Example = Example {
+ fileName :: FilePath,
+ lineNo :: Int,
+ inputLine :: Text,
+ outputLines :: [Text]
+} deriving Show
+
+type ExampleGroup = [Example]
+type Examples = [ExampleGroup]
+
+doctest :: Verbosity -> [FilePath] -> IO Bool
+doctest v fs = do
+ ctx <- initContext
+ _testFail <$> testFiles ctx v fs
+
+doctest' :: [FilePath] -> IO ()
+doctest' fs
+ = getVerbosity >>= flip doctest fs >>= flip unless exitFailure
+
+testFiles :: Context -> Verbosity -> [FilePath] -> IO (Int, Int, Int)
+testFiles ctx verb files = do
+ r@(t,o,f) <- s <$> traverse process files
+ when (verb /= Quiet) $ do
+ putStrLn "=== Summary ==="
+ putStrLn $ "Files: " ++ show (length files) ++ "."
+ printSummary t o f
+ return r
+ where
+ process fp = do
+ let (what, func) = typAndFunc fp
+ info = fp ++ " (" ++ what ++ ")"
+ when (verb /= Quiet) $
+ putStrLn $ "=== Testing " ++ info ++ " ==="
+ func ctx verb fp <* when (verb /= Quiet) (putStrLn "")
+ typAndFunc fp = if takeExtension fp == ".md"
+ then ("markdown", testMarkdownFile)
+ else ("koneko" , testKonekoFile )
+ s = foldl' (\(t,o,f) (t',o',f') -> (t+t',o+o',f+f')) (0,0,0)
+
+testKoneko, testMarkdown
+ :: Context -> Verbosity -> FilePath -> [Text] -> IO (Int, Int, Int)
+testKoneko ctx v fp = testExamples ctx v . parseKoneko fp
+testMarkdown ctx v fp = testExamples ctx v . parseMarkdown fp
+
+testKoneko_, testMarkdown_
+ :: Context -> Verbosity -> FilePath -> [Text] -> IO Bool
+testKoneko_ = _test parseKoneko
+testMarkdown_ = _test parseMarkdown
+
+_test :: (FilePath -> [Text] -> Examples)
+ -> Context -> Verbosity -> FilePath -> [Text] -> IO Bool
+_test f ctx v fp ls = _testFail <$> testExamples ctx v (f fp ls)
+
+_testFail :: (Int, Int, Int) -> Bool
+_testFail (_, _, fail) = fail == 0
+
+testKonekoFile, testMarkdownFile
+ :: Context -> Verbosity -> FilePath -> IO (Int, Int, Int)
+testKonekoFile = _testFile testKoneko
+testMarkdownFile = _testFile testMarkdown
+
+testKonekoFile_, testMarkdownFile_
+ :: Context -> Verbosity -> FilePath -> IO Bool
+testKonekoFile_ = _testFile testKoneko_
+testMarkdownFile_ = _testFile testMarkdown_
+
+_testFile :: (Context -> Verbosity -> FilePath -> [Text] -> IO a)
+ -> Context -> Verbosity -> FilePath -> IO a
+_testFile f ctx v fp = T.readFile fp >>= f ctx v fp . T.lines
+
+-- parsing --
+
+parseKoneko, parseMarkdown :: FilePath -> [Text] -> Examples
+parseKoneko fp = examples fp . knkCommentBlocks [] . zip [1..]
+parseMarkdown fp = examples fp . mdCodeBlocks [] . zip [1..]
+
+examples :: FilePath -> [[(Int, Text)]] -> Examples
+examples fp = filter (not . null) . map (exampleGroup fp [])
+
+-- TODO
+exampleGroup :: FilePath -> ExampleGroup -> [(Int, Text)] -> ExampleGroup
+exampleGroup fileName es ls
+ = if null ls || null ls' then reverse es
+ else exampleGroup fileName (Example{..}:es) ls''
+ where
+ ls' = dropWhile (not . isPrompt' . snd) ls
+ (e, ls'') = span (isSameExample . snd) $ tail ls' -- safe!
+ e' = map (dropPrefix . snd) e
+ (c,outputLines) = span isCont e'
+ (lineNo, fl) = head ls' -- safe!
+ inputLine = T.concat $ map dropPrompt (dropPrefix fl:c)
+ isSameExample s = maybe False (\x -> not $ isPrompt x || T.null x)
+ $ T.stripPrefix prefix s
+ dropPrefix = T.drop $ T.length prefix
+ dropPrompt = T.drop $ T.length RE.promptText
+ prefix = T.takeWhile isSpace fl
+ isPrompt' = isPrompt . T.dropWhile isSpace
+ isPrompt = T.isPrefixOf RE.promptText
+ isCont = T.isPrefixOf "... " -- TODO
+
+-- TODO
+knkCommentBlocks :: [[(Int, Text)]] -> [(Int, Text)] -> [[(Int, Text)]]
+knkCommentBlocks bs ls
+ = if null ls || null ls' then reverse bs
+ else knkCommentBlocks (b':bs) ls''
+ where
+ ls' = dropWhile (not . isComment) ls
+ (b, ls'') = span isSameComment ls'
+ b' = [ (n,T.drop (T.length prefix) x) | (n,x) <- b ]
+ isComment = T.isPrefixOf ";" . T.dropWhile isSpace . snd
+ isSameComment = T.isPrefixOf prefix . snd
+ prefix = T.takeWhile isSpace (snd $ head ls') <> ";" -- safe!
+
+-- TODO
+mdCodeBlocks :: [[(Int, Text)]] -> [(Int, Text)] -> [[(Int, Text)]]
+mdCodeBlocks bs [] = reverse bs
+mdCodeBlocks bs ls = mdCodeBlocks (b:bs) $ drop 1 ls''
+ where
+ ls' = dropWhile ((/= mdCodeStart) . snd) ls
+ (b, ls'') = break ((== mdCodeEnd) . snd) $ drop 1 ls'
+
+mdCodeStart, mdCodeEnd :: Text
+mdCodeStart = "```koneko"
+mdCodeEnd = "```"
+
+-- internal --
+
+-- TODO
+testExamples :: Context -> Verbosity -> Examples -> IO (Int, Int, Int)
+testExamples ctx verb ex = do
+ r@(total, ok, fail) <- go 0 0 0 ex
+ when (verb == Loud) $ do
+ putStrLn "=== Summary ==="
+ printSummary total ok fail
+ return r
+ where
+ go total ok fail [] = return (total, ok, fail)
+ go total ok fail (g:gt) = do
+ (t, o, f) <- testExampleGroup ctx verb g
+ go (total+t) (ok+o) (fail+f) gt
+
+-- TODO
+testExampleGroup
+ :: Context -> Verbosity -> ExampleGroup -> IO (Int, Int, Int)
+testExampleGroup ctx verb g = do
+ initMain ctx -- TODO
+ let st = emptyStack; total = length g
+ (ok, fail, _) <- loop 0 0 g ctx st
+ when (verb == Loud) $ do printTTPF total ok fail; putStrLn ""
+ return (total, ok, fail)
+ where
+ loop :: Int -> Int -> ExampleGroup
+ -> Context -> Stack -> IO (Int, Int, Stack)
+ loop ok fail [] _ s = return (ok, fail, s)
+ loop ok fail (e@Example{..}:et) c s = do
+ (out, err, s') <- provide (T.unpack inputLine)
+ $ capture $ repl c s
+ let olines = asLines out; elines = asLines err
+ if compareOutput outputLines olines elines then do
+ when (verb == Loud) $ printSucc e
+ loop (ok+1) fail et c s'
+ else do
+ printFail e olines elines
+ return (ok, fail+1, s')
+ repl = RE.repl' True ""
+ asLines x = let l = T.lines $ T.pack x in
+ if not (null l) && last l == "" then init l else l
+
+-- TODO: "...", ...
+compareOutput :: [Text] -> [Text] -> [Text] -> Bool
+compareOutput exp got err
+ = if null err then exp' == got else null got &&
+ T.isPrefixOf RE.errorText (head err) && exp' == err -- safe!
+ where
+ exp' = [ if l == "" then "" else l | l <- exp ]
+
+printSummary :: Int -> Int -> Int -> IO ()
+printSummary total ok fail = do
+ printTTPF total ok fail
+ putStrLn $ "Test " ++ if fail == 0 then "passed." else "failed."
+
+printTTPF :: Int -> Int -> Int -> IO ()
+printTTPF total ok fail =
+ putStrLn $ "Total: " ++ (show total) ++
+ ", Tried: " ++ (show $ ok + fail) ++
+ ", Passed: " ++ (show ok) ++
+ ", Failed: " ++ (show fail) ++ "."
+
+-- TODO
+printSucc :: Example -> IO ()
+printSucc Example{..} = do
+ p "Trying:" ; p $ indent inputLine
+ p "Expecting:"; traverse_ (p . indent) outputLines
+ p "ok"
+ where
+ p = T.putStrLn
+
+-- TODO
+printFail :: Example -> [Text] -> [Text] -> IO ()
+printFail Example{..} out err = do
+ p $ T.pack $ "File " ++ fileName ++ ", line " ++ show lineNo
+ p "Failed example:" ; p $ indent inputLine
+ p "Expected:" ; traverse_ (p . indent) outputLines
+ p "Got:" ; traverse_ (p . indent) out
+ unless (null err) $ do
+ p "Errors:" ; traverse_ (p . indent) err
+ where
+ p = T.hPutStrLn IO.stderr
+
+indent :: Text -> Text
+indent = (" " <>)
+
+-- stdio --
+
+capture :: IO a -> IO (String, String, a)
+capture act = do
+ (err, (out, x)) <- S.hCapture [IO.stderr] $ S.capture act
+ return (out, err, x)
+
+provide :: String -> IO a -> IO a
+provide = hProvide IO.stdin
+
+hProvide :: Handle -> String -> IO a -> IO a
+hProvide h str act = withTempFile "provide" f
+ where
+ f hTmp = do
+ IO.hPutStr hTmp str; IO.hFlush hTmp
+ IO.hSeek hTmp IO.AbsoluteSeek 0
+ withRedirect h hTmp act
+
+withRedirect :: Handle -> Handle -> IO a -> IO a
+withRedirect hOrig hRepl act = do
+ buf <- IO.hGetBuffering hOrig
+ bracket redirect (restore buf) $ const act
+ where
+ redirect = do
+ hDup <- hDuplicate hOrig
+ hDuplicateTo hRepl hOrig
+ return hDup
+ restore buf hDup = do
+ hDuplicateTo hDup hOrig
+ IO.hSetBuffering hOrig buf
+ IO.hClose hDup
+
+withTempFile :: String -> (Handle -> IO a) -> IO a
+withTempFile template f = do
+ tmpDir <- getTemporaryDirectory
+ bracket (IO.openTempFile tmpDir template) cleanup (f . snd)
+ where
+ cleanup (tmpFile, h) = IO.hClose h >> removeFile tmpFile -- !!!
+
+-- vim: set tw=70 sw=2 sts=2 et fdm=marker :
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,77 @@
+-- -- ; {{{1
+--
+-- File : Main.hs
+-- Maintainer : Felix C. Stegerman
+-- Date : 2022-02-12
+--
+-- Copyright : Copyright (C) 2022 Felix C. Stegerman
+-- Version : v0.0.1
+-- License : GPLv3+
+--
+-- -- ; }}}1
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Main (main) where
+
+import Control.Monad (when)
+import Data.Version (showVersion)
+import System.Console.CmdArgs hiding (args)
+
+#if !MIN_VERSION_GLASGOW_HASKELL(8, 8, 1, 0)
+import Data.Monoid((<>))
+#endif
+
+import qualified Data.Text as T
+import qualified System.Console.CmdArgs as CA
+
+import Koneko.Data (defineIn, emptyStack, list, true)
+import Koneko.Eval (initContext, evalFile, evalStdin, evalText)
+import Koneko.Repl (repl)
+import Koneko.Test (doctest')
+import Koneko_utils (stdinTTY)
+
+import qualified Paths_koneko as P
+
+version :: String
+version = "koneko 「子猫」 " ++ showVersion P.version
+
+data KonekoCmd = KonekoCmd {
+ args :: [String],
+ eval :: Maybe String,
+ doctest :: Bool,
+ interactive :: Bool
+} deriving (Data, Eq, Show, Typeable)
+
+main :: IO ()
+main = do
+ KonekoCmd{..} <- cmdArgs cmd
+ if doctest then doctest' args
+ else do
+ isatty <- stdinTTY; ctx <- initContext
+ let st = emptyStack; int = when interactive . repl ctx
+ sa = defineIn ctx "__args__" . list . map T.pack
+ go = if isatty || interactive then repl else evalStdin
+ isLoud >>= flip when (defineIn ctx "__debug__" true)
+ case (eval, args) of
+ (Nothing, []) -> sa [] >> go ctx st
+ (Nothing, script:a) -> sa a >> evalFile script ctx st >>= int
+ (Just code, a) -> sa a >> evalString code ctx st >>= int
+ where
+ evalString = evalText "(code)" . T.pack
+ cmd = KonekoCmd {
+ args = def &= CA.args &= typ argSpec,
+ eval = def &= typ "CODE"
+ &= help "code to run (instead of a script)"
+ &= groupname "Flags",
+ doctest = def &= help "run doctest (instead of a script)",
+ interactive = def &= help "force interactive mode (REPL)"
+ } &= program "koneko" &= summary version &= verbosity
+ {- &= details ... &= help "..." -} -- TODO
+ argSpec = "SCRIPT [ARGS...] | --eval CODE [ARGS...]" <>
+ " | --doctest FILE..."
+
+-- vim: set tw=70 sw=2 sts=2 et fdm=marker :
diff --git a/test/doctests.hs b/test/doctests.hs
new file mode 100644
--- /dev/null
+++ b/test/doctests.hs
@@ -0,0 +1,5 @@
+import System.Environment (getArgs)
+import Test.DocTest (doctest)
+
+main :: IO ()
+main = do args <- getArgs; doctest $ ["-isrc", "src/"] ++ args