├── .gitignore ├── LICENSE ├── README.md ├── deps.edn ├── project.clj ├── resources ├── docs │ └── libapl.info ├── images │ └── toAPL.gif ├── keyboard.txt └── symbols.txt ├── src └── libapl_clj │ ├── api.clj │ ├── apl.clj │ ├── impl │ ├── api.clj │ ├── helpers.clj │ ├── jna.clj │ ├── ops.clj │ ├── pointer.clj │ └── protocols.clj │ ├── prototype.clj │ └── types.clj └── test └── apl_test.clj /.gitignore: -------------------------------------------------------------------------------- 1 | .nrepl-port 2 | .cpcache 3 | hs_err* -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2020-2021 James Tolton 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in all 11 | copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 19 | SOFTWARE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Clojars Project](https://img.shields.io/clojars/v/jjtolton/libapl-clj.svg)](https://clojars.org/jjtolton/libapl-clj) 2 | 3 | ![libapl-clj being awesome](resources/images/toAPL.gif) 4 | 5 | # libapl-clj 6 | 7 | Following in the footsteps of [libpython-clj](https://github.com/clj-python/libpython-clj) 8 | and [libjulia-clj](https://github.com/cnuernber/libjulia-clj), libapl-clj provides native 9 | interop from Clojure into [GNU APL](https://www.gnu.org/software/apl/). 10 | 11 | ## Status 12 | 13 | Pre-alpha: APL shared library is able to be loaded on Linux. 14 | * Arbitrary APL strings can be run, and the values can be extracted into strings. 15 | * APL<->Clojure data copy is accomplished easily 16 | * Zero-copy paradigm supported 17 | * There are system instabilities, your REPL may crash from time to time. 18 | * automatic GC not yet implemented 19 | 20 | ## Overview 21 | 22 | APL is a fantastic tensor processing language with a ton of power. It's work has been 23 | hugely inspirational to libraries like Python's [numpy](https://numpy.org/) and 24 | [dtype-next](https://cnuernber.github.io/dtype-next/). 25 | 26 | The aim of this library is to provide native interop for APL from Clojure. 27 | 28 | ## Usage 29 | 30 | Tested on Linux Mint 19. Should also work on MacOS and probably Windows if you 31 | know how to set environment variables (see below). 32 | 33 | 1. Follow the directions to [download GNU APL](https://www.gnu.org/software/apl/). 34 | 2. When installing APL, use the following options: 35 | ```bash 36 | make develop_lib 37 | sudo make install 38 | ``` 39 | 3. The default shared library installation path is `/usr/local/lib/apl`. The filename 40 | is `libapl.so`. If `libapl.so` is installed somewhere else, please set your `APL_LIBRARY_PATH` 41 | environment variable to the correct path before running `initialize!`. 42 | 43 | ## Example 44 | 45 | ```clojure 46 | (require '[libapl-clj.apl :as apl]) 47 | 48 | apl/+ 49 | ;;=> #function[libapl-clj.prototype/jvm-fn/fn--23227] 50 | (apl/+ 1 2) 51 | ;;=> 3 52 | (apl/+ [1 2 3] [4 5 6]) 53 | ;;=> 54 | #tech.v3.tensor[3] 55 | [5 7 9] 56 | 57 | (apl/display! (apl/+ [1 2 3] [4 5 6])) 58 | 59 | ┏→━━━━┓ 60 | ┃5 7 9┃ 61 | ┗━━━━━┛ 62 | 63 | (apl/× [1 2 3] [4 5 6]) 64 | ;;=> #tech.v3.tensor[3] 65 | [4 10 18] 66 | 67 | (apl/⍴ [2 3 5] (first "a")) 68 | ;;=> 69 | #tech.v3.tensor[2 3 5] 70 | [[[a a a a a] 71 | [a a a a a] 72 | [a a a a a]] 73 | [[a a a a a] 74 | [a a a a a] 75 | [a a a a a]]] 76 | 77 | (apl/display! (apl/⍴ [2 3 5] (first "a"))) 78 | ;;=> 79 | ┏→━━━━┓ 80 | ↓aaaaa┃ 81 | ┃aaaaa┃ 82 | ┃aaaaa┃ 83 | ┃ ┃ 84 | ┃aaaaa┃ 85 | ┃aaaaa┃ 86 | ┃aaaaa┃ 87 | ┗━━━━━┛ 88 | 89 | (apl/reduce apl/⌈ [[1 2 3] [3 5 6] [1 2 3]]) 90 | #tech.v3.tensor[3] 91 | [3 6 3] 92 | 93 | (apl/reduce apl/⌈ 1 [[1 2 3] [3 5 6] [1 2 3]]) 94 | #tech.v3.tensor[3] 95 | [3 6 3] 96 | 97 | ``` 98 | 99 | ## Roadmap 100 | 101 | ### Alpha-release 102 | * [x] Push to Clojars 103 | * [x] Marshall pointers to native Clojure datatypes 104 | * [x] Zero-copy pathway between APL and Clojure for monster performance 105 | * [x] Ergonomic Clojure API 106 | * [ ] Documentation 107 | * [ ] Tests 108 | 109 | ### Beta-release 110 | * [ ] User-defined APL functions 111 | * [ ] APL function combinators 112 | 113 | ### 1.0 Release 114 | * [ ] Garbage Collection 115 | * [ ] Remove reflection 116 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src" "resources"] 2 | :deps {org.clojure/clojure {:mvn/version "1.10.1"} 3 | cnuernber/dtype-next {:mvn/version "6.00-beta-20"} 4 | techascent/tech.jna {:mvn/version "4.05"} 5 | complex/complex {:mvn/version "0.1.12"}} 6 | :aliases {:test {:extra-paths ["test"]} 7 | :runner {:main-opts ["-m" "cognitect.test-runner"] 8 | :extra-deps {com.cognitect/test-runner {:git/url "https://github.com/cognitect-labs/test-runner.git" 9 | :sha "209b64504cb3bd3b99ecfec7937b358a879f55c1"}}}}} 10 | 11 | 12 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject jjtolton/libapl-clj "0.1.2-ALPHA-SNAPSHOT" 2 | :description "Clojure bindings for GNU APL" 3 | :url "http://github.com/jjtolton/libapl-clj" 4 | :plugins [[lein-tools-deps "0.4.5"]] 5 | :middleware [lein-tools-deps.plugin/resolve-dependencies-with-deps-edn] 6 | :lein-tools-deps/config {:config-files [:install :user :project]}) 7 | -------------------------------------------------------------------------------- /resources/docs/libapl.info: -------------------------------------------------------------------------------- 1 | This is libapl.info, produced by makeinfo version 5.2 from libapl.texi. 2 | 3 | INFO-DIR-SECTION GNU programming tools 4 | START-INFO-DIR-ENTRY 5 | * libAPL: (libapl). call the GNU APL interpreter. 6 | 7 | END-INFO-DIR-ENTRY 8 | 9 | 10 | File: libapl.info, Node: Top, Next: Vague details of the GNU APL implementation, Up: (dir) 11 | 12 | libAPL 13 | ****** 14 | 15 | libapl is a C library, kindly contributed to the GNU APL project by Dr. 16 | Dirk Laurie, that gives C programs access to GNU APL. 17 | 18 | Almost everything that a user can do interactively with GNU APL can also 19 | be done programmatically with libapl. You can )LOAD and )SAVE 20 | workspaces, evaluate APL expression, create Variables, and even call APL 21 | primitives directly with values originating from in your C code. 22 | 23 | The main facilities provided by libapl are listed in the following. 24 | 25 | Some functions come in two flavours: one whose argument is a 26 | (0-terminated and UTF8-encoded) C-strings (that is, a const char *) and 27 | one whose argument is a const unsigned int * to a 0-terminated array of 28 | Unicodes. 29 | 30 | ‘apl_exec(const char * line_utf8)’ 31 | ‘apl_exec_ucs(const unsigned int * line_ucs)’ 32 | pass a line to the interpreter for immediate execution as APL code. 33 | For example, 34 | 35 | apl_exec("1 2 3 + 4 5 6") 36 | 37 | should return the APL vector 5 7 9, which can then be accessed with 38 | other libapl functions such as get_rank(), get_axis(), etc. 39 | 40 | ‘apl_command(const char * line_utf8)’ 41 | ‘apl_command_ucs(const unsigned int * line_ucs)’ 42 | pass an APL command to the command processor and return its output. 43 | For example, 44 | 45 | apl_command(")CLEAR") 46 | 47 | should clear the current workspace and return "CLEAR WS". 48 | 49 | ‘APL_value’ 50 | APL_value is a convenience typedef for a pointer to an opaque 51 | structure Value, supported by over 30 functions allowing one to 52 | construct a new Value and to gain access to its rank, shape and 53 | ravel. In this document, the terms "Value" and "APL value" are not 54 | interchangeable; they refer respectively to a structure and to a 55 | pointer. 56 | 57 | ‘APL_function’ 58 | APL_function is a convenience typedef for a pointer to an opaque 59 | structure Function, which is a defined APL function or a built-in 60 | function of the interpreter. This pointer provides direct access 61 | of the eval__XXX() functions that are impemented by the function. 62 | In this document, the terms "Function" and "APL function" are not 63 | interchangeable; they refer respectively to a structure and to a 64 | pointer. Every function implements a (typically small) subset of 65 | eval__XXX() functions that differ by the arguments that the take. 66 | The XXX stands for the signature of the function, e.g. eval__fun_B 67 | for a monadic function, eval__A_fun_B for a dyafic function, and so 68 | on. The possible arguments (in that order are: A (left value), L 69 | (left function of a dyadic operator), R (right function of an 70 | operator), X (axis argument of a function or operator), and B 71 | (right value). 72 | 73 | ‘eval__fun(APL_function fun)’ 74 | ‘eval__A_fun_B(APL_function fun, APL_value B)’ 75 | ‘eval__A_fun_B(APL_value A, APL_function fun, APL_value B)’ 76 | ‘eval__A_L_oper_B(APL_value A, APL_function L, APL_function fun, APL_value B)’ 77 | ‘eval__A_fun_X_B(APL_value A, APL_function fun, APL_value X, APL_value B)’ 78 | ‘eval__A_L_oper_R_B(APL_value A, APL_function L, APL_function fun, APL_function R, APL_value B)’ 79 | ‘eval__A_L_oper_R_X_B(APL_value A, APL_function L, APL_function fun, APL_function R, APL_value X, APL_value B)’ 80 | ‘eval__fun_B(APL_function fun, APL_value B)’ 81 | ‘eval__fun_B(APL_function fun, APL_value B)’ 82 | ‘eval__L_oper_B(APL_function L, APL_function fun, APL_value B)’ 83 | ‘eval__fun_X_B(APL_function fun, APL_value X, APL_value B)’ 84 | ‘eval__L_oper_R_B(APL_value A, APL_function L, APL_function fun, APL_function R, APL_value B)’ 85 | ‘eval__L_oper_R_X_B(APL_function L, APL_function fun, APL_function R, APL_value X, APL_value B)’ 86 | These are the possible eval functions. The APL_value returned by 87 | an eval__XXX() function shall be released with release_value() by 88 | the caller. 89 | 90 | ‘get_var_value(const char * var_name_utf8, const char * loc)’ 91 | return an APL value pointing to the contents of a variable in the 92 | current workspace. 93 | 94 | ‘set_var_value(const char * var_name_utf8, const APL_value new_value, const char * loc)’ 95 | set the contents of a variable in the workspace to that of the 96 | given APL value. 97 | 98 | ‘expand_LF_to_CRLF’ 99 | this function controls whether linefeed (LF) characters shall be 100 | expanded to CR/LF on output. The default is no expansion. Please 101 | note that LF expansion may be triggered in other places, therefore 102 | expand_LF_to_CRLF(0) alone does not guarantee that no CR characters 103 | are being printed. 104 | 105 | No other GNU APL header is exposed. 106 | 107 | This document will not tell you much about APL. For more details about 108 | the language, consult an APL reference manual such as those recommended 109 | in the file ‘README-7-more-info’, which are probably installed in 110 | ‘/usr/share/doc/apl’ or ‘/usr/local/share/doc/apl’. 111 | * Menu: 112 | 113 | * Vague details of the GNU APL implementation:: 114 | * Summary of functions:: 115 | * Programming notes:: 116 | 117 | 118 | File: libapl.info, Node: Vague details of the GNU APL implementation, Next: Summary of functions, Prev: Top, Up: Top 119 | 120 | 1 Vague details of the GNU APL implementation 121 | ********************************************* 122 | 123 | Although the implementation is hidden from the API, the programmer needs 124 | to know a little about it. 125 | 126 | Only one workspace, simply known as "the workspace", is active at any 127 | time. The workspace may be cleared, named, saved and restored by calls 128 | to ‘apl_command’. 129 | 130 | The workspace contains a collection of symbols of various kinds. Apart 131 | from ‘apl_exec’ and ‘apl_command’, which behave as if entered from the 132 | keyboard in an interactive APL session, this API gives access only to 133 | APL variables, i.e. symbols associated with Values. 134 | 135 | A Value is a multidimensional array of cells. It has three visible 136 | components: rank, shape and ravel. 137 | 138 | The shape is a vector of integers, giving the number of elements along 139 | each axis of the array. The number of shape items is known as the rank. 140 | There is an upper bound to the rank, configurable when GNU APL is built, 141 | which is displayed as a message by ‘apl_exec("⎕SYL[7;]")’. 142 | 143 | The ravel is a vector of cells, accessed in APL by a multi-index but in 144 | the API by a single index starting at 0. As one progresses along the 145 | ravel, the multi-index is ordered lexicographically, e.g. in a clear 146 | workspace, the multi-index of an array of shape ‘2 3’ would successively 147 | be ‘1 1’, ‘1 2’, ‘1 3’, ‘2 1’, ‘2 2’, ‘2 3’. The index origin in APL 148 | may be changed by ‘apl_exec("⎕IO←0")’, but in the API the ravel is 149 | always indexed from 0. 150 | 151 | The number of elements in the ravel is given by the product of the shape 152 | items. An empty product is of course equal to 1, thus this calculation 153 | is also valid for a scalar, which has rank 0. 154 | 155 | A cell can hold any of several kinds of objects: 156 | 157 | 1. A scalar, i.e. either a number or a single 32-bit Unicode 158 | character. The number may be stored internally as a 64-bit 159 | integer, a ‘double’, or a ‘complex’. 160 | 2. An APL value. This allows nested arrays to be represented. 161 | 3. None of the above, i.e. information not accessible from the API. 162 | 163 | The API does not give direct access to cell objects. The user must know 164 | what is in a particular cell and retrieve it by supplying its position 165 | in the ravel, using a specialized access method for cells of that 166 | particular type. To this end, the cell type can be queried. This is an 167 | integer treated as a bit string. The bits denoting cells accessible 168 | from the API have predefined names. 169 | 170 | CCT_CHAR = 0x02 171 | CCT_POINTER = 0x04 172 | CCT_INT = 0x10 173 | CCT_FLOAT = 0x20 174 | CCT_COMPLEX = 0x40 175 | CCT_NUMERIC = CCT_INT | CCT_FLOAT | CCT_COMPLEX 176 | 177 | Attempting to retrieve the contents of a cell by the wrong access method 178 | is an error that will crash the program. 179 | * Menu: 180 | 181 | * Lifespan of Values:: 182 | 183 | 184 | File: libapl.info, Node: Lifespan of Values, Up: Vague details of the GNU APL implementation 185 | 186 | 1.1 Lifespan of Values 187 | ====================== 188 | 189 | 1. All Values are invisible to the API. Internally, they contain a 190 | reference count, and are scheduled for destruction when the 191 | reference count reaches zero. The actual destruction might not 192 | happen immediately. The fact that one succeeded in accessing a 193 | Value does not prove that it is still alive, it merely means that 194 | it has not yet been destructed. 195 | 196 | 2. All API functions that return an APL value increment the reference 197 | count. It is your responsibility to decrement the reference count 198 | using ‘release_value’ when the Value is no longer needed. Failure 199 | to do so will cause memory leaks. 200 | 201 | 3. The APL value provided in the argument list of ‘res_callback’ (see 202 | *note Interface to APL interpreter: #interface-to-apl-interpreter.) 203 | has a particularly brief lifespan. The execution of that function 204 | is your only chance of accessing it. Its reference count is not 205 | increased before the call, so you must not release it. 206 | 207 | 4. The type-specific ‘set_’ functions change one element only. Other 208 | references to the Value concerned will also reflect the change; for 209 | example, if the APL value was returned by ‘get_var_value’, a 210 | following call to ‘get_var_value’ with the same variable name will 211 | show the change. 212 | 213 | 5. ‘set_value’ and ‘set_var_value’ make a new deep copy of a 214 | non-scalar Value. The reference count of the original Value is not 215 | increased. Cloning (which is deliberately discouraged in the API 216 | by not providing a copy constructor) can be simulated with the aid 217 | of either of these. The details are left to the persevering user. 218 | 219 | 220 | File: libapl.info, Node: Summary of functions, Next: Programming notes, Prev: Vague details of the GNU APL implementation, Up: Top 221 | 222 | 2 Summary of functions 223 | ********************** 224 | 225 | This section is an aide-memoire, not a manual: consult the comments 226 | preceding each function for details. See *note Programming notes: 227 | #programming-notes. for information on the ‘loc’ parameter. 228 | 229 | The other parameter values have the following types: 230 | 231 | ‘val’ The main APL value 232 | ‘pval’ A secondary APL value 233 | ‘cval’ A 32-bit Unicode 234 | character 235 | ‘ival’ A 64-bit integer 236 | ‘xval’,‘yval’ A 64-bit double 237 | ‘sval’ A UTF-8 encoded ‘char*’ 238 | ‘i’ A 64-bit index 239 | ‘k’,‘n1’,‘n2’,‘n2’ A 32-bit index 240 | 241 | * Menu: 242 | 243 | * Constructor functions:: 244 | * Read access to Values:: 245 | * Write access to cells:: 246 | * Interface to APL interpreter:: 247 | * Destructor function:: 248 | * Print support:: 249 | 250 | 251 | File: libapl.info, Node: Constructor functions, Next: Read access to Values, Up: Summary of functions 252 | 253 | 2.1 Constructor functions 254 | ========================= 255 | 256 | Each of these functions returns an APL value and has a name descriptive 257 | of its argument list. 258 | 259 | ‘int_scalar(ival,loc)’, ‘double_scalar(xval,loc)’, 260 | ‘complex_scalar(xval,yval,loc)’ and ‘char_scalar(cval,loc)’ initialize 261 | to a given C value. 262 | 263 | ‘char_vector(sval,loc)’ initializes from a UTF-8 encoded C string to an 264 | array of rank 1 containing Unicode characters. 265 | 266 | ‘apl_scalar(loc)’, ‘apl_vector(n1)’, ‘apl_matrix(n1,n2)’ and 267 | ‘apl_cube(n1,n2,n3)’ initialize to arrays of rank 0,1,2,3; 268 | ‘apl_value(shape,loc)’ initializes to an array of arbitrary shape. All 269 | cells in these arrays are initialized to 0. 270 | 271 | 272 | File: libapl.info, Node: Read access to Values, Next: Write access to cells, Prev: Constructor functions, Up: Summary of functions 273 | 274 | 2.2 Read access to Values 275 | ========================= 276 | 277 | ‘get_rank(val)’, ‘get_axis(val,k)’ and ‘get_element_count(val)’ give 278 | information about the shape, 279 | 280 | ‘get_type(val,i)’ returns the cell type of a ravel element. The 281 | predefined names can be used in e.g. a ‘switch’ statement on the cell 282 | type. 283 | 284 | ‘is_char(val,i)’, ‘is_int(val,i)’, ‘is_double(val,i)’, 285 | ‘is_complex(val,i)’ and ‘is_value(val,i)’ are conveniently named 286 | front-ends to ‘get_type’ that do not require the user to examine the 287 | cell type. 288 | 289 | ‘is_string(val)’ tests whether the entire value is a simple character 290 | vector. If so, ‘print_value_to_string’ can be used to convert it to a 291 | UTF-8 encoded C string. 292 | 293 | ‘get_char(val,i)’, ‘get_int(val,i)’, ‘get_real(val,i)’, 294 | ‘get_imag(val,i)’ and ‘get_value(val,i)’ retrieve the actual contents of 295 | a cell of which the type is already known, if necessary by having called 296 | ‘get_type’ or one of its front-ends. For example ‘get_real’ can be used 297 | if ‘get_type(val,i) & (CCT_FLOAT | CCT_COMPLEX)’ is nonzero. 298 | 299 | 300 | File: libapl.info, Node: Write access to cells, Next: Interface to APL interpreter, Prev: Read access to Values, Up: Summary of functions 301 | 302 | 2.3 Write access to cells 303 | ========================= 304 | 305 | Cells can be accessed only via an APL value pointing to their containing 306 | Value. 307 | 308 | ‘set_char(cval,val,i)’, ‘set_int(ival,val,i)’, ‘set_real(xval,val,i)’, 309 | ‘set_imag(yval,val,i)’ and ‘set_value(pval,val,i)’ replace the contents 310 | of cell ‘i’ of ‘val’. 311 | 312 | It is not possible to change the shape of an APL value. 313 | 314 | 315 | File: libapl.info, Node: Interface to APL interpreter, Next: Destructor function, Prev: Write access to cells, Up: Summary of functions 316 | 317 | 2.4 Interface to APL interpreter 318 | ================================ 319 | 320 | ‘set_var_value(name,val,loc)’ and ‘get_var_value(name,val,loc)’ save and 321 | retrieve values to the workspace under specified names. 322 | 323 | An external function pointer ‘res_callback’ is called just before 324 | ‘apl_exec’ exits. To exploit it, assign a suitable user-written 325 | function to it, e.g. 326 | 327 | /* callback to print every value */ 328 | static int always_print(const APL_value apl,int committed) { 329 | return 1; 330 | } 331 | 332 | /* callback to save a copy in the workspace under the name "_" */ 333 | static int save_to_workspace(const APL_value apl,int committed) { 334 | set_var_value("_",apl,LOC); 335 | return !committed; 336 | } 337 | 338 | /* One-off declaration statement, must not be inside a function */ 339 | result_callback res_callback = always_print_it; 340 | ... 341 | /* A later assignment statement may be anywhere */ 342 | res_callback = save_to_workspace; 343 | ... 344 | res_callback = NULL; /* disables callback feature */ 345 | 346 | Here ‘apl’ is the anonymous value to which the APL expression evaluates. 347 | You are granted access to it just before its brief lifespan expires. 348 | ‘committed’ is a C boolean (only 0 is false) reporting whether that 349 | value was stored to a variable. Your return value is a C boolean 350 | telling whether the value should be printed by the APL interpreter. 351 | 352 | The value ‘*apl’ (which the API cannot see) will be scheduled for 353 | destruction as soon as you exit ‘res_callback’. Don’t release it 354 | yourself. 355 | 356 | 357 | File: libapl.info, Node: Destructor function, Next: Print support, Prev: Interface to APL interpreter, Up: Summary of functions 358 | 359 | 2.5 Destructor function 360 | ======================= 361 | 362 | ‘release_value(val,loc)’ decrements the reference count of ‘*val’ as 363 | explained in *note Lifespan of Values: #lifespan-of-values./ 364 | 365 | 366 | File: libapl.info, Node: Print support, Prev: Destructor function, Up: Summary of functions 367 | 368 | 2.6 Print support 369 | ================= 370 | 371 | ‘print_value(value,file)’, ‘print_value_to_string(value)’ filter an APL 372 | value through the APL formatting routines. Their behaviour depends on 373 | several system variables, such as ‘⎕FC’, ‘⎕PP’, ‘⎕PW’. 374 | 375 | ‘UTF8_to_Unicode’, ‘Unicode_to_UTF8’ are provided because ‘get_char’ and 376 | ‘set_char’ work with 32-bit Unicode, whereas many other user interfaces 377 | use UTF-8. 378 | 379 | 380 | File: libapl.info, Node: Programming notes, Prev: Summary of functions, Up: Top 381 | 382 | 3 Programming notes 383 | ******************* 384 | 385 | The typical application would start with: 386 | 387 | #include 388 | #include 389 | #include 390 | 391 | This interface can be called from C, but since GNU APL is a C++ package. 392 | the C++ library must be explicitly loaded, e.g. in Linux: 393 | 394 | cc myprog.c -lapl -lstdc++ -o myprog 395 | 396 | * Menu: 397 | 398 | * The loc parameter and LOC macro:: 399 | 400 | 401 | File: libapl.info, Node: The loc parameter and LOC macro, Up: Programming notes 402 | 403 | 3.1 The ‘loc’ parameter and ‘LOC’ macro 404 | ======================================= 405 | 406 | All the functions that return APL values, as well as ‘release_value’ and 407 | ‘set_var_value’, contain a parameter ‘const char* loc’. This parameter 408 | is used to keep track of changes to a Value and may be displayed by 409 | certain debugging services. You can put in anything you like, but most 410 | convenient is ‘LOC’, a macro that expands to the file name and line 411 | number. 412 | 413 | 414 | 415 | Tag Table: 416 | Node: Top 215 417 | Node: Vague details of the GNU APL implementation 5196 418 | Ref: #vague-details-of-the-gnu-apl-implementation 5413 419 | Node: Lifespan of Values n8069 420 | Ref: #lifespan-of-values 8214 421 | Node: Summary of functions 9885 422 | Ref: #summary-of-functions 10070 423 | Node: Constructor functions 10884 424 | Ref: #constructor-functions 11045 425 | Node: Read access to Values 11680 426 | Ref: #read-access-to-values 11871 427 | Node: Write access to cells 12901 428 | Ref: #write-access-to-cells 13099 429 | Node: Interface to APL interpreter 13431 430 | Ref: #interface-to-apl-interpreter 13641 431 | Node: Destructor function 15011 432 | Ref: #destructor-function 15195 433 | Node: Print support 15334 434 | Ref: #print-support 15469 435 | Node: Programming notes 15867 436 | Ref: #programming-notes 15994 437 | Node: The loc parameter and LOC macro 16318 438 | Ref: #the-loc-parameter-and-loc-macro 16492 439 | 440 | End Tag Table 441 | 442 | 443 | Local Variables: 444 | coding: utf-8 445 | End: 446 | -------------------------------------------------------------------------------- /resources/images/toAPL.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jjtolton/libapl-clj/01e2bf7e0d20abd9f8f36c2d9fc829dd4082d455/resources/images/toAPL.gif -------------------------------------------------------------------------------- /resources/keyboard.txt: -------------------------------------------------------------------------------- 1 | ╔════╦════╦════╦════╦════╦════╦════╦════╦════╦════╦════╦════╦════╦═════════╗ 2 | ║ ~ ║ !⌶ ║ @⍫ ║ #⍒ ║ $⍋ ║ %⌽ ║ ^⍉ ║ &⊖ ║ *⍟ ║ (⍱ ║ )⍲ ║ _! ║ +⌹ ║ ║ 3 | ║ `◊ ║ 1¨ ║ 2¯ ║ 3< ║ 4≤ ║ 5= ║ 6≥ ║ 7> ║ 8≠ ║ 9∨ ║ 0∧ ║ -× ║ =÷ ║ BACKSP ║ 4 | ╠════╩══╦═╩══╦═╩══╦═╩══╦═╩══╦═╩══╦═╩══╦═╩══╦═╩══╦═╩══╦═╩══╦═╩══╦═╩══╦══════╣ 5 | ║ ║ Q ║ W⍹ ║ E⋸ ║ R ║ T⍨ ║ Y¥ ║ U ║ I⍸ ║ O⍥ ║ P⍣ ║ {⍞ ║ }⍬ ║ |⊣ ║ 6 | ║ TAB ║ q? ║ w⍵ ║ e∈ ║ r⍴ ║ t∼ ║ y↑ ║ u↓ ║ i⍳ ║ o○ ║ p⋆ ║ [← ║ ]→ ║ \⊢ ║ 7 | ╠═══════╩═╦══╩═╦══╩═╦══╩═╦══╩═╦══╩═╦══╩═╦══╩═╦══╩═╦══╩═╦══╩═╦══╩═╦══╩══════╣ 8 | ║ (CAPS ║ A⍶ ║ S ║ D ║ F ║ G ║ H⍙ ║ J⍤ ║ K ║ L⌷ ║ :≡ ║ "≢ ║ ║ 9 | ║ LOCK) ║ a⍺ ║ s⌈ ║ d⌊ ║ f_ ║ g∇ ║ h∆ ║ j∘ ║ k' ║ l⎕ ║ ;⍎ ║ '⍕ ║ RETURN ║ 10 | ╠═════════╩═══╦╩═══╦╩═══╦╩═══╦╩═══╦╩═══╦╩═══╦╩═══╦╩═══╦╩═══╦╩═══╦╩═════════╣ 11 | ║ ║ Z ║ Xχ ║ C¢ ║ V ║ B£ ║ N ║ M ║ <⍪ ║ >⍙ ║ ?⍠ ║ ║ 12 | ║ SHIFT ║ z⊂ ║ x⊃ ║ c∩ ║ v∪ ║ b⊥ ║ n⊤ ║ m| ║ ,⍝ ║ .⍀ ║ /⌿ ║ SHIFT ║ 13 | ╚═════════════╩════╩════╩════╩════╩════╩════╩════╩════╩════╩════╩══════════╝ 14 | -------------------------------------------------------------------------------- /src/libapl_clj/api.clj: -------------------------------------------------------------------------------- 1 | (ns ^{:doc "A (more) stable API for working in APL memory space. Coercion 2 | from JVM->APL provided. This is the suggested API for library development."} 3 | libapl-clj.api 4 | (:require [libapl-clj.impl.api :as api :reload true] 5 | [libapl-clj.impl.ops :as ops :reload true] 6 | [libapl-clj.impl.helpers :as h :reload true] 7 | [libapl-clj.types :as apl-types :reload true] 8 | [tech.v3.tensor :as tensor] 9 | [tech.v3.datatype :as dtype] 10 | [libapl-clj.impl.jna :as jna]) 11 | (:import [com.sun.jna Pointer])) 12 | 13 | (def initialize! ops/initialize!) 14 | 15 | (def run-simple-string! ops/run-simple-string!) 16 | 17 | (def run-command-string! api/run-command-string!) 18 | 19 | (def ->string api/pointer->string) 20 | 21 | (def rank api/rank) 22 | 23 | (def axis api/axis) 24 | 25 | (def n-elems api/n-elems) 26 | 27 | ;; could use some macros here 28 | ;; defint, defapl, defdouble, etc 29 | ;; maybe good first issue candidate 30 | 31 | (def ref->apl api/ref->avp) 32 | 33 | (defn set-apl-value! 34 | "Assign an APL Pointer to a variable name in APL space" 35 | [var-name apl-pointer] 36 | (if (h/scalar-pointer? apl-pointer) 37 | ;; todo -- this will crash on complex numbers. 38 | ;; : can't figure out why atp->ref! crashes on scalars 39 | (let [assign-string (format "%s ← %s" var-name (str ops/jvm< apl-pointer))] 40 | (run-simple-string! assign-string)) 41 | (api/atp->ref! var-name apl-pointer))) 42 | 43 | (defn jvm-type [^Pointer avp] 44 | ;; todo -- would be good to get rid of this reflection 45 | (if (h/scalar-pointer? avp) 46 | (-> (ops/jvm< avp 0) 47 | clojure.core/type 48 | apl-types/type->key-type) 49 | ::apl-types/tensor)) 50 | 51 | (defn jvm-type-at-idx [^Pointer apl-value ^Integer idx] 52 | (-> (api/type-at-idx apl-value idx) 53 | (get apl-types/type-map))) 54 | 55 | (defn vget 56 | ([^Pointer apl-value ^Integer idx] 57 | (vget apl-value idx nil)) 58 | ([^Pointer apl-value ^Integer idx not-found] 59 | (when-not (h/scalar-pointer? apl-value) 60 | (let [e-count (n-elems apl-value)] 61 | (if (< idx e-count) 62 | (if (= ::apl-types/tensor (jvm-type-at-idx apl-value idx)) 63 | (api/atp+idx->avp apl-value idx) 64 | (ops/jvm< apl-value idx)) 65 | not-found))))) 66 | 67 | #_(defn vget-in [^Pointer apl-value path] 68 | (when-not (h/scalar-pointer? apl-value) 69 | (when-let [[coordinate & path] (not-empty path)] 70 | (let [e-count (n-elems apl-value)])))) 71 | 72 | (def set-char! api/set-char!) 73 | 74 | (def set-int! api/set-int!) 75 | 76 | (def set-value! api/set-value!) 77 | 78 | (def set-double! api/set-double!) 79 | 80 | (def set-complex! api/set-complex!) 81 | 82 | (defn ndarray [shape] 83 | (api/apl-value shape)) 84 | 85 | (defn new-scalar [] 86 | (api/apl-scalar)) 87 | 88 | (defn new-vector [length] 89 | (api/apl-vector length)) 90 | 91 | (defn new-cube [blocks rows cols] 92 | (api/apl-cube blocks rows cols)) 93 | 94 | (defn apl-string [s] 95 | (api/char-vector s)) 96 | 97 | (defn apl-int [n] 98 | (api/int-scalar n)) 99 | 100 | (defn apl-double [n] 101 | (api/double-scalar n)) 102 | 103 | (defn apl-complex [real imag] 104 | (api/complex-scalar real imag)) 105 | 106 | (defn ->apl [x] 107 | ;; need to fix reflection 108 | (if-not (h/pointer? x) 109 | (cond 110 | (h/scalar? x) (ops/->scalar-pointer x) 111 | (string? x) (api/char-vector x) 112 | (seqable? x) (-> x tensor/->tensor ops/tensor->apl) 113 | :else (throw (ex-info "Unsupported type" 114 | {:value x 115 | :type (type x)}))) 116 | x)) 117 | 118 | (defn ->jvm [avp] 119 | (if (h/pointer? avp) 120 | (case (jvm-type avp) 121 | ::apl-types/integer (api/int< avp 0) 122 | ::apl-types/double (api/real< avp 0) 123 | ::apl-types/char (api/char< avp 0) 124 | ::apl-types/complex (complex.core/complex 125 | (api/real< avp 0) 126 | (api/imag< avp 0)) 127 | ::apl-types/tensor (ops/->tensor avp)) 128 | avp)) 129 | 130 | (comment 131 | (->jvm (api/int-scalar 1))) 132 | 133 | (defn value->apl [v] 134 | {:pre [#(or (h/scalar? v) 135 | (string? v) 136 | (vector? v) 137 | (list? v) 138 | (seq? v))]} 139 | (->apl v)) 140 | 141 | 142 | 143 | (defn arg+fp+arg ^Pointer [arg1 fp arg2] 144 | (api/arg+fp+arg (value->apl arg1) fp (value->apl arg2))) 145 | 146 | (defn arg+fp+axis+arg ^Pointer [arg1 fp axis arg2] 147 | (api/arg+fp+axis+arg (value->apl arg1) 148 | fp 149 | (value->apl axis) 150 | (value->apl arg2))) 151 | 152 | (defn arg+fn+op+axis+arg ^Pointer [arg1 fp op axis arg2] 153 | (api/arg+fn+op+axis+arg (value->apl arg1) 154 | fp 155 | op 156 | (value->apl axis) 157 | (value->apl arg2))) 158 | 159 | (defn arg+fn+op+fn+axis+arg ^Pointer 160 | [arg1 fp1 op fp2 axis arg2] 161 | (api/arg+fn+op+fn+axis+arg 162 | (value->apl arg1) 163 | fp1 164 | op 165 | fp2 166 | (value->apl axis) 167 | (value->apl arg2))) 168 | 169 | (defn fp+arg ^Pointer [^Pointer fp arg] 170 | (api/fp+arg fp (value->apl arg))) 171 | 172 | (defn fp+op+arg ^Pointer [^Pointer fp ^Pointer op arg] 173 | (api/fp+op+arg fp op (value->apl arg))) 174 | 175 | (defn arg+fp+op+fp+arg ^Pointer [arg1 ^Pointer fp1 ^Pointer op ^Pointer fp2 ^Pointer arg2] 176 | (api/arg+fp+op+fp+arg (value->apl arg1) fp1 op fp2 (value->apl arg2))) 177 | 178 | (defn fp+op+axis+arg ^Pointer [^Pointer fp ^Pointer op ^Pointer axis arg] 179 | (api/fp+op+axis+arg fp op (value->apl axis) (value->apl arg))) 180 | 181 | (defn fp+axis+arg ^Pointer [^Pointer fp ^Pointer axis arg] 182 | (api/fp+axis+arg fp (value->apl axis) (value->apl arg))) 183 | 184 | (defn fp+op+axis+arg ^Pointer [^Pointer fp ^Pointer op ^Pointer axis arg] 185 | (api/fp+op+axis+arg fp op (value->apl axis) (value->apl arg))) 186 | 187 | (defn fp+op+fp+arg ^Pointer [^Pointer fp1 ^Pointer op ^Pointer fp2 arg] 188 | (api/fp+op+fp+arg fp1 op fp2 (value->apl arg))) 189 | 190 | (defn fp+op+fp+axis+arg ^Pointer [^Pointer fp1 ^Pointer op ^Pointer fp2 ^Pointer axis arg] 191 | (api/fp+op+fp+axis+arg fp1 op fp2 (value->apl axis) (value->apl arg))) 192 | 193 | (comment 194 | (require '[libapl-clj.impl.pointer :as p]) 195 | (h/drawing! (arg+fp+arg 1 p/+ 1)) ;; 1 + 1 196 | (h/drawing! (fp+arg p/⍳ 10)) ;; ⍳10 197 | (h/drawing! (arg+fp+arg [1 2 3] p/+ [1 2 3])) ;; 1 2 3 + 1 2 3 198 | (h/drawing! (arg+fp+arg [1 2 3] p/+ 10)) ;; 1 2 3 + 10 199 | (h/drawing! (arg+fp+arg 10 p/+ [1 2 3]))) ;; 10 + 1 2 3 200 | -------------------------------------------------------------------------------- /src/libapl_clj/apl.clj: -------------------------------------------------------------------------------- 1 | (ns libapl-clj.apl 2 | (:refer-clojure :exclude [+ +' - -' = *' * max min < <= > >= not= 3 | concat reduce format take drop reductions reverse 4 | range identical? find]) 5 | (:require [libapl-clj.api :as api :reload true] 6 | [libapl-clj.impl.pointer :as p :reload true] 7 | [libapl-clj.prototype :as proto :reload true] 8 | [tech.v3.tensor :as tensor] 9 | [libapl-clj.impl.helpers :as h :reload true] 10 | [libapl-clj.impl.ops :as ops :reload true])) 11 | 12 | (defn initialize! 13 | "Initialize the APL shared library. Currently only tested on Linux." 14 | [] 15 | (ops/initialize!)) 16 | 17 | (defn run-simple-string! 18 | "Run an APL command. Returns `true` if successful." 19 | [cmd] 20 | (zero? (api/run-simple-string! cmd))) 21 | 22 | (def ->apl api/->apl) 23 | 24 | (def ->jvm api/->jvm) 25 | 26 | (def ->string api/->string) 27 | 28 | (defn display! [x] 29 | (h/drawing! (->apl x))) 30 | 31 | (def +' (proto/monodyadic-fn' p/+)) 32 | (def + (proto/jvm-fn +')) 33 | 34 | (def -' (proto/monodyadic-fn' p/-)) 35 | (def - (proto/jvm-fn -')) 36 | 37 | (def ×' (proto/monodyadic-fn' p/×)) 38 | (def × (proto/jvm-fn ×')) 39 | (def mul ×) 40 | 41 | (def =' (proto/monodyadic-fn' p/=)) 42 | (def = (proto/jvm-fn =')) 43 | (def mul =) 44 | 45 | (def ÷' (proto/monodyadic-fn' p/÷)) 46 | (def ÷ (proto/jvm-fn ÷')) 47 | (def div ÷) 48 | 49 | (def *' (proto/monodyadic-fn' p/*)) 50 | (def * (proto/jvm-fn *')) 51 | (def pow *) 52 | 53 | (def ⌈' (proto/monodyadic-fn' p/⌈)) 54 | (def ⌈ (proto/jvm-fn ⌈')) 55 | (def max ⌈) 56 | 57 | (def ⌊' (proto/monodyadic-fn' p/⌊)) 58 | (def ⌊ (proto/jvm-fn ⌊')) 59 | (def min ⌊) 60 | 61 | (def |' (proto/monodyadic-fn' p/|)) 62 | (def | (proto/jvm-fn |')) 63 | (def residue |) 64 | 65 | (def <' (proto/monodyadic-fn' p/<)) 66 | (def < (proto/jvm-fn <')) 67 | 68 | (def ≤' (proto/monodyadic-fn' p/≤)) 69 | (def ≤ (proto/jvm-fn ≤')) 70 | (def <= ≤) 71 | 72 | (def =' (proto/monodyadic-fn' p/=)) 73 | (def = (proto/jvm-fn =')) 74 | 75 | (def >' (proto/monodyadic-fn' p/>)) 76 | (def > (proto/jvm-fn >')) 77 | 78 | (def ≥' (proto/monodyadic-fn' p/≥)) 79 | (def ≥ (proto/jvm-fn ≥')) 80 | (def >= ≥) 81 | 82 | 83 | (def ≠' (proto/monodyadic-fn' p/≠)) 84 | (def ≠ (proto/jvm-fn ≠')) 85 | (def not= ≠) 86 | 87 | (def ⍴' (proto/monodyadic-fn' p/⍴)) 88 | (def ⍴ (proto/jvm-fn ⍴')) 89 | 90 | (def ∊' (proto/monodyadic-fn' p/∊)) 91 | (def ∊ (proto/jvm-fn ∊')) 92 | 93 | (def ∨' (proto/monodyadic-fn' p/∨)) 94 | (def ∨ (proto/jvm-fn ∨')) 95 | (def b-or ∨) 96 | 97 | (def ∧' (proto/monodyadic-fn' p/∧)) 98 | (def ∧ (proto/jvm-fn ∧')) 99 | (def b-and ∧) 100 | 101 | (def ⍱' (proto/monodyadic-fn' p/⍱)) 102 | (def ⍱ (proto/jvm-fn ⍱')) 103 | (def b-nor ⍱) 104 | 105 | (def ⍲' (proto/monodyadic-fn' p/⍲)) 106 | (def ⍲ (proto/jvm-fn ⍲')) 107 | (def b-nand ⍲) 108 | 109 | (def ravel' (fn 110 | ([] p/...) 111 | ([arg] (api/fp+arg p/... arg)) 112 | ([axis arg] (api/fp+axis+arg p/... axis arg)))) 113 | (def ravel (proto/jvm-fn ravel')) 114 | 115 | (def concat' (fn concat' 116 | ([] p/...) 117 | ([arg1 arg2] 118 | (api/arg+fp+arg arg1 p/... arg2)) 119 | ([axis arg1 arg2] 120 | (api/arg+fp+axis+arg arg1 p/... axis arg2)) 121 | ([axis arg1 arg2 & more] 122 | (let [args (into [arg1 arg2] more)] 123 | (clojure.core/reduce 124 | (fn [a b] (concat' axis a b)) 125 | args))))) 126 | (def concat (proto/jvm-fn concat')) 127 | 128 | (def laminate' (fn 129 | ([] p/...) 130 | ([axis arg1 arg2] 131 | (api/arg+fp+axis+arg arg1 p/... axis arg2)))) 132 | (def laminate (proto/jvm-fn laminate')) 133 | 134 | (def ⍪' (proto/monodyadic-fn' p/⍪)) 135 | (def ⍪ (proto/jvm-fn ⍪')) 136 | 137 | (def compress' (proto/monodyadic-fn' p//)) 138 | (def / (proto/jvm-fn compress')) 139 | (def compress /) 140 | 141 | (def reduce' (proto/left-operator-fn' p//)) 142 | (def reduce (proto/jvm-fn reduce')) 143 | 144 | (def ⌿' (proto/left-operator-fn' p/⌿)) 145 | (def ⌿ (proto/jvm-fn ⌿')) 146 | (def reduce-last ⌿) 147 | 148 | (def ?' (proto/monodyadic-fn' p/?)) 149 | (def ? (proto/jvm-fn ?')) 150 | (def roll' (fn roll' 151 | ([] ?') 152 | ([arg] (?' arg)))) 153 | (def roll (proto/jvm-fn roll')) 154 | (def deal' roll') 155 | (def deal roll) 156 | 157 | (def ⍕' (proto/monodyadic-fn' p/⍕)) 158 | (def ⍕ (proto/jvm-fn ⍕')) 159 | (def format ⍕) 160 | 161 | (def ⍎' (proto/monodyadic-fn' p/⍎)) 162 | (def ⍎ (proto/jvm-fn ⍎')) 163 | (def execute ⍎) 164 | 165 | (def ∼' (proto/monodyadic-fn' p/∼)) 166 | (def ∼ (proto/jvm-fn ∼')) 167 | (def invert ∼) 168 | 169 | (def ↑' (proto/monodyadic-fn' p/↑)) 170 | (def ↑ (proto/jvm-fn ↑')) 171 | (def take ↑) 172 | 173 | (def ↓' (proto/monodyadic-fn' p/↓)) 174 | (def ↓ (proto/jvm-fn ↓')) 175 | 176 | (def reductions' (proto/left-operator-fn' p/backslash)) 177 | (def reductions (proto/jvm-fn reductions')) 178 | (def scan' reductions') 179 | (def scan reductions) 180 | 181 | (def ⌽' (proto/monodyadic-fn' p/⌽)) 182 | (def ⌽ (proto/jvm-fn ⌽')) 183 | (def reverse-last ⌽) 184 | 185 | 186 | (def ⊖' (proto/monodyadic-fn' p/⊖)) 187 | (def ⊖ (proto/jvm-fn ⊖')) 188 | (def reverse ⊖) 189 | 190 | (def ⍉' (proto/monodyadic-fn' p/⍉)) 191 | (def ⍉ (proto/jvm-fn ⍉')) 192 | (def transpose ⍉) 193 | 194 | (def ¯' (fn ¯' 195 | ([] p/¯) 196 | ([arg] 197 | (api/fp+arg p/- arg)))) 198 | (def ¯ (proto/jvm-fn ¯')) 199 | 200 | (def ⍬' p/⍬) 201 | (def ⍬ nil) 202 | (def zilde' ⍬') 203 | (def zilde nil) 204 | 205 | (def ⍋' (proto/monodyadic-fn' p/⍋)) 206 | (def ⍋ (proto/jvm-fn ⍋')) 207 | (def grade-up ⍋) 208 | 209 | (def ⍒' (proto/monodyadic-fn' p/⍒)) 210 | (def ⍒ (proto/jvm-fn ⍒')) 211 | (def grade-down ⍒) 212 | 213 | (def ⊥' (proto/monodyadic-fn' p/⊥)) 214 | (def ⊥ (proto/jvm-fn ⊥')) 215 | (def decode ⊥) 216 | 217 | (def ⊤' (proto/monodyadic-fn' p/⊤)) 218 | (def ⊤ (proto/jvm-fn ⊤')) 219 | (def encode ⊤) 220 | 221 | (def ⍟' (proto/monodyadic-fn' p/⍟)) 222 | (def ⍟ (proto/jvm-fn ⍟')) 223 | (def ln ⍟) 224 | 225 | (def !' (proto/monodyadic-fn' p/!)) 226 | (def ! (proto/jvm-fn !')) 227 | (def factorial !) 228 | 229 | (def ○' (proto/monodyadic-fn' p/○)) 230 | (def ○ (proto/jvm-fn ○')) 231 | (def pi* ○) 232 | 233 | (def ⌹' (proto/monodyadic-fn' p/⌹)) 234 | (def ⌹ (proto/jvm-fn ⌹')) 235 | (def matrix-invert ⌹) 236 | 237 | (def ⍳' (proto/monodyadic-fn' p/⍳)) 238 | (def ⍳ (proto/jvm-fn ⍳')) 239 | (def range ⍳) 240 | 241 | (def ≡' (proto/monodyadic-fn' p/≡)) 242 | (def ≡ (proto/jvm-fn ≡')) 243 | (def identical? ≡) 244 | 245 | (def ≢' (proto/monodyadic-fn' p/≢)) 246 | (def ≢ (proto/jvm-fn ≢')) 247 | (def not-identical? ≢) 248 | 249 | #_(;; currently broken 250 | (def ¨' (proto/left-operator-fn' p/¨)) 251 | (def ¨ (proto/jvm-fn ¨'))) 252 | 253 | (def ⍷' (proto/monodyadic-fn' p/⍷)) 254 | (def ⍷ (proto/jvm-fn ⍷')) 255 | (def find ⍷) 256 | 257 | (def ⊂' (proto/monodyadic-fn' p/⊂)) 258 | (def ⊂ (proto/jvm-fn ⊂')) 259 | 260 | (def ⊃'(proto/monodyadic-fn' p/⊃)) 261 | (def ⊃ (proto/jvm-fn ⊃')) 262 | 263 | (def inner-product' (fn inner-product' 264 | [left right arg1 arg2] 265 | (api/arg+fp+op+fp+arg 266 | arg1 (left) p/. (right) arg2))) 267 | (def inner-product (proto/jvm-fn inner-product')) 268 | 269 | 270 | (comment 271 | 272 | (->apl [1 2]) 273 | (display! (->apl [1 2])) 274 | 275 | (->apl [1 2]) 276 | (->jvm (->apl [1 2])) 277 | (display! (->apl (->jvm (->apl [1 2])))) 278 | 279 | (+ (->apl (->apl [1 2])) [1 2]) 280 | 281 | ;; (((2 - 1 2) - 3 4) - 5) 282 | (- (libapl-clj.impl.api/int-scalar 2) 283 | (tensor/->tensor [1 2]) 284 | (->apl [3 4]) 285 | 5) 286 | 287 | (display! 288 | (->apl [1 2 289 | "nested" 290 | ["data" 291 | [2 3 4 292 | ["structure" 293 | 5 6 7]]] 294 | ["is" ["here"]]])) 295 | 296 | (display! 297 | (->jvm (->apl [1 2 298 | "nested" 299 | ["data" 300 | [2 3 4 301 | ["structure" 302 | 5 6 7]]] 303 | ["is" ["here"]]]))) 304 | 305 | (display! ((comp -' +') 306 | [1 2] [3 4] [5 6])) 307 | 308 | (display! 309 | (->apl (+ [[1 2] 310 | [3 4]] 311 | 312 | [[3 4] 313 | [5 6]] 314 | 315 | [[5 6] 316 | [7 8]]))) 317 | 318 | (display! (- [[1 2] 319 | [3 4]] 320 | 321 | [[5 6] 322 | [7 8]])) 323 | 324 | (display! (⍴' [2 3 5] 325 | (+' [1 2] [3 4]))) 326 | 327 | 328 | (display! (= " " "hello there")) 329 | 330 | ;; the APL idiom for (-> x count range) 331 | (-> "why is this a word" ⍴ ⍳) 332 | 333 | ;; positions of left present in right 334 | (display! (∊ "why is this a word" "aeiou")) 335 | 336 | (display! (->apl (⍳ [3 3]))) 337 | 338 | (def t (⍳ [3 3])) 339 | (->jvm (->apl t)) 340 | (display! (->apl (->jvm (⍳ [3 3])))) 341 | 342 | 343 | ;; indicies of vowels in phrase 344 | (display! (let [phrase "why is this a word"] 345 | (/ (∊ phrase "aeiou") 346 | (-> phrase ⍴ ⍳)))) 347 | 348 | (display! 349 | (⍴ [2 3 5] 350 | (+ [1 2] [3 4]))) 351 | 352 | (⌈ 353 | [[3 2] 354 | [5 6]] 355 | 356 | [[1 2] 357 | [2 4]] 358 | 359 | [[1 5] 360 | [8 9]]) 361 | 362 | (reduce ⌈ 0 [[1 2 3 4] 363 | [1 2 3 4]]) 364 | 365 | (↑ 1 [1 2 3]) 366 | 367 | (↓ 1 [1 2 3]) 368 | 369 | (laminate [0.5] [1 2 3] \a) 370 | (laminate [-0.5] [1 2 3] \a) 371 | 372 | (display! (-> (concat 0 [[1 2]] [[4 5]] [[5 6]] "ab") 373 | (concat \c))) 374 | 375 | (display! (concat 1 [[1 2]] [[4 5]])) 376 | 377 | 378 | (initialize!) 379 | 380 | 381 | 382 | 383 | 384 | 385 | 386 | 387 | ) 388 | -------------------------------------------------------------------------------- /src/libapl_clj/impl/api.clj: -------------------------------------------------------------------------------- 1 | (ns ^{:doc "This is a low level API one level above 2 | the JNA bindings to provide a thin layer of indirection. 3 | 4 | Contributors: Please use this rather than than the JNA bindings for 5 | : manipulating APL memory space. 6 | 7 | Application developers: Please be careful hooking into this directly. 8 | : While more stable than the JNA bindings, 9 | : the API is subject to change. 10 | 11 | 12 | overview 13 | -------- 14 | No type coercion. Simply an abstraction 15 | from the underlying JNA bindings in case we want to switch 16 | to a different runtime down the road, such as Dyalog, for instance, 17 | or to potentially provide hooks. 18 | 19 | The only conveniences provided are: 20 | 21 | * the `loc` argument is omitted, as it is for debugging C code. 22 | * the API is made more idiomatic than raw JNA interop 23 | 24 | variable conventions 25 | -------------------- 26 | 27 | avp -- APL value pointer. \"Opaque\" pointer reference to an APL array or scalar, 28 | : expressed in Clojure as a JNA Pointer. 29 | 30 | atp -- APL value pointer that specifically an APL Tensor (aka NDarray, Vector, or 31 | : multi-dimensional array). 32 | 33 | asp -- APL value pointer that specifically maps to an APL Scalar. 34 | 35 | fp -- APL function pointer. \"Opaque\" pointer reference to an APL function. 36 | : the \"a\" is dropped from \"afp\" to provide a visual distinction from \"avp\". 37 | 38 | op -- APL \"operation\" pointer. We refer to APL \"operations\" as higher order functions 39 | : in Clojure. An example is `reduce`, which takes a function as an argument. 40 | : In APL, reduce (given the `/` symbol) takes a function as its left argument. 41 | 42 | 43 | s -- a string 44 | 45 | ax, axis -- an integer representing the index of a value in the shape of a Tensor 46 | : i.e., if the shape is [2 3 5], axis 0 is 2, axis 1 is 3, axis 2 is 5 47 | 48 | p -- a pointer 49 | 50 | vref -- a string, the variable name associate with an APL value 51 | 52 | idx -- index 53 | 54 | 55 | function naming conventions 56 | --------------------------- 57 | 58 | x+y -- brutalist naming convention. avp+idx->char indicates a function 59 | : that takes an avp and an idx and returns a char. 60 | : avp+fp+avp->avp represents a function that has parameters [avp fp avp] and returns 61 | : an avp. etc. 62 | 63 | 64 | "} 65 | libapl-clj.impl.api 66 | (:require [libapl-clj.impl.jna :as jna :reload true] 67 | [tech.v3.datatype :as dtype]) 68 | (:import [com.sun.jna Pointer])) 69 | 70 | (defn initialize! [] 71 | ;; todo -- add initialization options, such as library location 72 | (jna/init_libapl "main" 1)) 73 | 74 | (defn run-simple-string! ^Integer [^String s] 75 | (jna/apl_exec s)) 76 | 77 | (defn run-command-string! ^Integer [^String cmd & args] 78 | ;; todo -- important to understand GNU APL command context better 79 | ;; to make this more useful 80 | (jna/apl_command ^String (clojure.string/join (into [cmd] args)))) 81 | 82 | (defn ^:private result-callback 83 | [result committed] 84 | ;; todo -- what does this do...? 85 | (jna/result_callback result committed)) 86 | 87 | (defn pointer->string ^String [^Pointer avp] 88 | (jna/print_value_to_string avp)) 89 | 90 | (defn rank ^Integer [^Pointer avp] 91 | (jna/get_rank avp)) 92 | 93 | (defn axis ^Integer [^Pointer avp ^Integer ax] 94 | (jna/get_axis avp ax)) 95 | 96 | (defn ref->avp ^Pointer [^String vref] 97 | (jna/get_var_value vref "")) 98 | 99 | (defn atp->ref! 100 | "Warning: crash if you attempt to assign a scalar pointer" 101 | [^String ref ^Pointer atp] 102 | (jna/set_var_value ref atp "")) 103 | 104 | (defn avp->string! ^String [^Pointer avp] 105 | (jna/print_value_to_string avp)) 106 | 107 | (defn n-elems ^Integer [^Pointer avp] 108 | (jna/get_element_count avp)) 109 | 110 | (comment 111 | (n-elems (char-vector "hello")) 112 | (n-elems (int-scalar 1)) 113 | (n-elems (double-scalar 10.12)) 114 | (n-elems (complex-scalar 1 2)) 115 | 116 | ) 117 | 118 | (defn type-at-idx 119 | "Get type of value for pointer at idx. 120 | CT_NONE = 0, 121 | CT_BASE = 0x01, 122 | CT_CHAR = 0x02, 123 | CT_POINTER = 0x04, 124 | CT_CELLREF = 0x08, 125 | CT_INT = 0x10, 126 | CT_FLOAT = 0x20, 127 | CT_COMPLEX = 0x40, 128 | CT_NUMERIC = CT_INT | CT_FLOAT | CT_COMPLEX, 129 | CT_SIMPLE = CT_CHAR | CT_NUMERIC, 130 | CT_MASK = CT_CHAR | CT_NUMERIC | CT_POINTER | CT_CELLREF" 131 | ^Integer [^Pointer avp ^Integer idx] 132 | (jna/get_type avp idx)) 133 | 134 | (defn atp+idx->avp ^Pointer [^Pointer atp ^Integer idx] 135 | (jna/get_value atp idx)) 136 | 137 | (def avp< atp+idx->avp) 138 | 139 | (defn atp+idx->int ^Integer [^Pointer atp ^Integer idx] 140 | (jna/get_int atp idx)) 141 | 142 | (def int< atp+idx->int) 143 | 144 | (defn atp+idx->real ^Double [^Pointer atp ^Integer idx] 145 | (jna/get_real atp idx)) 146 | 147 | (def real< atp+idx->real) 148 | 149 | (defn atp+idx->imag ^Double [^Pointer atp ^Integer idx] 150 | (jna/get_imag atp idx)) 151 | 152 | (def imag< atp+idx->imag) 153 | 154 | (defn atp+idx->char ^Character [^Pointer atp ^Integer idx] 155 | (jna/get_char atp idx)) 156 | 157 | (def char< atp+idx->char) 158 | 159 | (defn set-char! [^Pointer atp ^Integer idx ^Character c] 160 | (jna/set_char c atp idx)) 161 | 162 | (defn set-value! [^Pointer atp ^Integer idx ^Pointer avp] 163 | (jna/set_value avp atp idx)) 164 | 165 | (defn set-int! [^Pointer atp ^Integer idx ^Integer n] 166 | (jna/set_int n atp idx)) 167 | 168 | (defn set-double! [^Pointer atp ^Integer idx ^Double n] 169 | (jna/set_double n atp idx)) 170 | 171 | (defn set-complex! [^Pointer atp ^Integer idx ^Double real ^Double imag] 172 | (jna/set_complex real imag atp idx)) 173 | 174 | ;; constructors 175 | 176 | (defn apl-value 177 | "Another exception to the 'no casting' rule. I can't see 178 | any reasion to not do the casting to a container here." 179 | ^Pointer [shape] 180 | (jna/apl_value (count shape) 181 | (dtype/make-container :native-heap :int64 shape) 182 | "")) 183 | 184 | (defn apl-scalar ^Pointer [] 185 | (jna/apl_scalar "")) 186 | 187 | (defn apl-vector ^Pointer [^Integer length] 188 | (jna/apl_vector length "")) 189 | 190 | (defn apl-cube ^Pointer [^Integer blocks ^Integer rows ^Integer cols] 191 | (jna/apl_cube blocks rows cols "")) 192 | 193 | (defn char-vector ^Pointer [^String string] 194 | (jna/char_vector string "")) 195 | 196 | (defn int-scalar ^Pointer [^Long n] 197 | (jna/int_scalar n "")) 198 | 199 | (defn double-scalar ^Pointer [^Double n] 200 | (jna/double_scalar n "")) 201 | 202 | (defn complex-scalar ^Pointer [^Pointer real ^Float imag] 203 | (jna/complex_scalar real imag "")) 204 | 205 | (defn char-scalar ^Pointer [^Character c] 206 | (jna/char_scalar c)) 207 | 208 | ;; destructors 209 | 210 | (defn release-value! [^Pointer avp] 211 | (jna/release_value avp "")) 212 | 213 | ;; auxiliary 214 | 215 | (defn owner-count [^Pointer avp] 216 | (jna/get_owner_count avp)) 217 | 218 | 219 | (defn ->string-container 220 | ([] (dtype/make-container :native-heap :uint64 [])) 221 | ([s] 222 | (if (nil? s) 223 | (->string-container) 224 | (->> s 225 | str 226 | vec 227 | first 228 | vector 229 | (dtype/make-container :native-heap :uint64))))) 230 | 231 | (defn get-function-ucs 232 | "Note: this function is an exception to the 'no-coercion' rule for this 233 | namespace because this is an esoteric technique and I can't think of a valid 234 | reason not to do it here." 235 | ([^String fstring] 236 | (get-function-ucs fstring nil nil)) 237 | ([^String s1 ^String s2] 238 | (get-function-ucs s1 s2 nil)) 239 | ([s1 s2 s3] 240 | (jna/get_function_ucs (->string-container s1) 241 | (->string-container s2) 242 | (->string-container s3)))) 243 | 244 | (comment 245 | 246 | (get-function-ucs "⍴")) 247 | 248 | (defn niladic-fp ^Pointer [^Pointer fp] 249 | (jna/eval__fun fp)) 250 | 251 | (defn arg+fp+arg 252 | "Note that order of arguments is more idiomatic to APL than Clojure" 253 | ^Pointer 254 | [arg1 ^Pointer fp arg2] 255 | (jna/eval__A_fun_B arg1 fp arg2)) 256 | 257 | (defn arg+fp+axis+arg ^Pointer [arg1 ^Pointer fp ^Pointer axis arg2] 258 | (jna/eval__A_fun_X_B arg1 fp axis arg2)) 259 | 260 | (defn arg+fn+op+axis+arg ^Pointer [arg1 ^Pointer fp ^Pointer op ^Pointer axis arg2] 261 | (jna/eval__A_L_oper_X_B arg1 fp op axis arg2)) 262 | 263 | (defn arg+fp+op+fp+arg ^Pointer [arg1 ^Pointer fp1 ^Pointer op ^Pointer fp2 ^Pointer arg2] 264 | (jna/eval__A_L_oper_R_B arg1 fp1 op fp2 arg2)) 265 | 266 | (defn arg+fn+op+fn+axis+arg ^Pointer 267 | [arg1 268 | ^Pointer fp1 269 | ^Pointer op 270 | ^Pointer fp2 271 | ^Pointer axis 272 | arg2] 273 | (jna/eval__A_L_oper_R_X_B arg1 fp1 op fp2 axis arg2)) 274 | 275 | (defn fp+arg ^Pointer [^Pointer fp arg] 276 | (jna/eval__fun_B fp arg)) 277 | 278 | (defn fp+op+arg ^Pointer [^Pointer fp ^Pointer op arg] 279 | (jna/eval__L_oper_B fp op arg)) 280 | 281 | (defn fp+op+axis+arg ^Pointer [^Pointer fp ^Pointer op ^Pointer axis arg] 282 | (jna/eval__L_oper_X_B fp op axis arg)) 283 | 284 | (defn fp+axis+arg ^Pointer [^Pointer fp ^Pointer axis arg] 285 | (jna/eval__fun_X_B fp axis arg)) 286 | 287 | (defn fp+op+fp+arg ^Pointer [^Pointer fp1 ^Pointer op ^Pointer fp2 arg] 288 | (jna/eval__L_oper_R_B fp1 op fp2 arg)) 289 | 290 | (defn fp+op+axis+arg ^Pointer [^Pointer fp ^Pointer op ^Pointer axis arg] 291 | (jna/eval__L_oper_X_B fp op axis arg)) 292 | 293 | (defn fp+op+fp+axis+arg ^Pointer [^Pointer fp1 ^Pointer op ^Pointer fp2 ^Pointer axis arg] 294 | (jna/eval__L_oper_R_X_B fp1 op fp2 axis arg)) 295 | -------------------------------------------------------------------------------- /src/libapl_clj/impl/helpers.clj: -------------------------------------------------------------------------------- 1 | (ns libapl-clj.impl.helpers 2 | (:require [libapl-clj.impl.api :as api]) 3 | (:import [java.util UUID] 4 | [libapl_clj.impl.protocols PTensor])) 5 | 6 | (defn random-var-name [] 7 | (clojure.string/replace (str "a" (UUID/randomUUID)) #"-" "")) 8 | 9 | 10 | (defn pointer? [x] 11 | (= (str (type x)) 12 | "class com.sun.jna.Pointer")) 13 | 14 | (defn scalar? [x] 15 | ;; todo -- need to get thid of this reflection 16 | ;; : this could benefit from a protocol and type extension 17 | ;; : perhaps a private method with a try/catch that defaults 18 | ;; : to false? 19 | (or (int? x) 20 | (double? x) 21 | (float? x) 22 | (char? x))) 23 | 24 | (defn scalar-pointer? [avp] 25 | (zero? (api/rank avp))) 26 | 27 | 28 | (defn drawing! 29 | "Note: use this for rendering in the REPL only. Do not 30 | pass this value around. The APL pointer is GC'd within 1 second." 31 | [avp] 32 | (let [rand-var (random-var-name) 33 | rand-val-name (random-var-name) 34 | ndimensional? (not (scalar-pointer? avp)) 35 | cmd-draw (format "%s ← 4 ⎕CR %s" rand-val-name rand-var) 36 | cmd-no-draw (format "%s ← %s" rand-val-name rand-var)] 37 | ;; TODO -- there has to be a better way to run system commands 38 | (when ndimensional? 39 | (api/atp->ref! rand-var avp) 40 | (api/run-simple-string! cmd-draw)) 41 | (try 42 | (if ndimensional? 43 | (PTensor. (api/ref->avp rand-val-name)) 44 | (PTensor. avp)) 45 | (finally 46 | ;; todo GC TB 47 | (future 48 | (when ndimensional? 49 | (Thread/sleep 1000) 50 | (api/run-command-string! "ERASE" rand-var) 51 | (api/run-command-string! "ERASE" rand-val-name))))))) 52 | 53 | 54 | 55 | 56 | 57 | -------------------------------------------------------------------------------- /src/libapl_clj/impl/jna.clj: -------------------------------------------------------------------------------- 1 | (ns libapl-clj.impl.jna 2 | (:require [tech.v3.jna :as jna] 3 | tech.v3.datatype.jna 4 | [tech.v3.datatype :as dtype]) 5 | (:import [com.sun.jna Pointer])) 6 | 7 | (def ^:private default-linux-library-path "/usr/local/lib/apl") 8 | 9 | (defonce apl-library-path* (atom (or (System/getenv "APL_LIBRARY_PATH") 10 | default-linux-library-path))) 11 | 12 | (defn APL_value ^Pointer [value] 13 | (jna/ensure-ptr value)) 14 | 15 | (defn APL_function ^Pointer [fun] 16 | (jna/ensure-ptr fun)) 17 | 18 | (defn uint64_t* ^Pointer [value] 19 | (jna/ensure-ptr value)) 20 | 21 | (defn int64_t* ^Pointer [value] 22 | (jna/ensure-ptr value)) 23 | 24 | (defonce _ (jna/add-library-path "libapl.so" :resource @apl-library-path*)) 25 | 26 | (defn apl-library-path [] 27 | (str @apl-library-path* "/libapl.so")) 28 | 29 | (defn find-apl-function [fn-name] 30 | (jna/find-function fn-name (apl-library-path))) 31 | 32 | (defn find-apl-symbol ^Pointer [sym-name] 33 | (jna/find-function sym-name (apl-library-path))) 34 | 35 | (defn find-deref-apl-symbol ^Pointer [sym-name] 36 | (-> (find-apl-symbol sym-name) 37 | (.getPointer 0))) 38 | 39 | 40 | ;; initialization 41 | 42 | (jna/def-jna-fn (apl-library-path) 43 | init_libapl 44 | "Initialize GNU APL!" 45 | nil 46 | [progname str] 47 | [logname int]) 48 | 49 | ;; execute 50 | 51 | (jna/def-jna-fn (apl-library-path) 52 | apl_exec 53 | "Run an APL string!" 54 | Integer 55 | [line str]) 56 | 57 | (jna/def-jna-fn (apl-library-path) 58 | apl_command 59 | "Run an APL command" 60 | Integer 61 | [line str]) 62 | 63 | (jna/def-jna-fn (apl-library-path) 64 | result_callback 65 | "A function called with the final value of 66 | an APL statement." 67 | Pointer 68 | [result APL_value] 69 | [committed int]) 70 | 71 | 72 | (jna/def-jna-fn (apl-library-path) 73 | print_value_to_string 74 | "Convert opaque APL value to string" 75 | String 76 | [value APL_value]) 77 | 78 | ;; selectors 79 | 80 | (jna/def-jna-fn (apl-library-path) 81 | get_var_value 82 | "Get APL variable value" 83 | Pointer 84 | [var_name str] 85 | [loc str]) 86 | 87 | (jna/def-jna-fn (apl-library-path) 88 | get_axis 89 | "Get axis of val" 90 | Long 91 | [val APL_value] 92 | [axis int]) 93 | 94 | 95 | 96 | ;; primary introspection API of APL Values 97 | 98 | (jna/def-jna-fn (apl-library-path) 99 | get_rank 100 | "Get Rank of APL tensor" 101 | Integer 102 | [value APL_value]) 103 | 104 | (jna/def-jna-fn (apl-library-path) 105 | get_element_count 106 | "Get number of elements of APL value" 107 | Integer 108 | [value APL_value]) 109 | 110 | ;; cell accessors 111 | 112 | (jna/def-jna-fn (apl-library-path) 113 | get_type 114 | "Get type of value for pointer at idx. 115 | CT_NONE = 0, 116 | CT_BASE = 0x01, 117 | CT_CHAR = 0x02, 118 | CT_POINTER = 0x04, 119 | CT_CELLREF = 0x08, 120 | CT_INT = 0x10, 121 | CT_FLOAT = 0x20, 122 | CT_COMPLEX = 0x40, 123 | CT_NUMERIC = CT_INT | CT_FLOAT | CT_COMPLEX, 124 | CT_SIMPLE = CT_CHAR | CT_NUMERIC, 125 | CT_MASK = CT_CHAR | CT_NUMERIC | CT_POINTER | CT_CELLREF" 126 | Integer 127 | [value APL_value] 128 | [idx unchecked-int]) 129 | 130 | (jna/def-jna-fn (apl-library-path) 131 | get_value 132 | "Get value at index -- used for objects or nested arrays" 133 | Pointer 134 | [value APL_value] 135 | [idx unchecked-int]) 136 | 137 | (jna/def-jna-fn (apl-library-path) 138 | get_int 139 | "Get integer for pointer at index of val" 140 | Integer 141 | [value APL_value] 142 | [idx unchecked-int]) 143 | 144 | (jna/def-jna-fn (apl-library-path) 145 | get_real 146 | "Get double value for pointer at index of val, or real part of complex number" 147 | Double 148 | [value APL_value] 149 | [idx unchecked-int]) 150 | 151 | (jna/def-jna-fn (apl-library-path) 152 | get_imag 153 | "Get imaginary part of complex number at index of val" 154 | Double 155 | [val APL_value] 156 | [idx unchecked-int]) 157 | 158 | (jna/def-jna-fn (apl-library-path) 159 | get_char 160 | "Get characater at index of val" 161 | Character 162 | [val APL_value] 163 | [idx unchecked-int] 164 | ) 165 | 166 | ;; setters 167 | (jna/def-jna-fn (apl-library-path) 168 | set_value 169 | "Set value of value at index" 170 | Pointer 171 | [new_value jna/ensure-ptr] 172 | [val APL_value] 173 | [idx unchecked-int]) 174 | 175 | (jna/def-jna-fn (apl-library-path) 176 | set_var_value 177 | "Set value to variable" 178 | Integer 179 | [var_name str] 180 | [new_value APL_value] 181 | [loc str]) 182 | 183 | (jna/def-jna-fn (apl-library-path) 184 | set_char 185 | "Set value at idx to char" 186 | nil 187 | [new_char char] 188 | [val APL_value] 189 | [idx unchecked-int]) 190 | 191 | (jna/def-jna-fn (apl-library-path) 192 | set_int 193 | "Set value at idx to int" 194 | nil 195 | [new_int long] 196 | [val APL_value] 197 | [idx unchecked-int]) 198 | 199 | (jna/def-jna-fn (apl-library-path) 200 | set_double 201 | "Set value at idx to double" 202 | nil 203 | [new_double double] 204 | [val APL_value] 205 | [idx unchecked-int]) 206 | 207 | (jna/def-jna-fn (apl-library-path) 208 | set_complex 209 | "Set value at idx to complex" 210 | nil 211 | [new_real double] 212 | [new_imag double] 213 | [val APL_value] 214 | [idx unchecked-int]) 215 | 216 | 217 | ;; constructors 218 | (jna/def-jna-fn (apl-library-path) 219 | apl_value 220 | "Create new APL vector" 221 | Pointer 222 | [rank int] 223 | [shape jna/ensure-ptr] 224 | [loc str]) 225 | 226 | (jna/def-jna-fn (apl-library-path) 227 | apl_scalar 228 | "Create new APL scalar" 229 | Pointer 230 | [loc str]) 231 | 232 | (jna/def-jna-fn (apl-library-path) 233 | apl_vector 234 | "A new vector with a ravel of length len 235 | and ravel elements initialized to zero" 236 | Pointer 237 | [len long] 238 | [loc str]) 239 | 240 | 241 | (jna/def-jna-fn (apl-library-path) 242 | apl_matrix 243 | "a new matrix. all ravel elements are initialized to integer 0" 244 | Pointer 245 | [rows long] 246 | [cols long] 247 | [loc str]) 248 | 249 | (jna/def-jna-fn (apl-library-path) 250 | apl_cube 251 | "a new 3-dimensional value. all ravel elements are initialized to integer 0" 252 | Pointer 253 | [blocks long] 254 | [rows long] 255 | [cols long] 256 | [loc str]) 257 | 258 | (jna/def-jna-fn (apl-library-path) 259 | char_vector 260 | "Create a new character vector" 261 | Pointer 262 | [string str] 263 | [loc str]) 264 | 265 | (jna/def-jna-fn (apl-library-path) 266 | int_scalar 267 | "A new integer scalar" 268 | Pointer 269 | [val long] 270 | [loc str]) 271 | 272 | (jna/def-jna-fn (apl-library-path) 273 | double_scalar 274 | "A new floating point scalar" 275 | Pointer 276 | [val double] 277 | [loc str]) 278 | 279 | (jna/def-jna-fn (apl-library-path) 280 | complex_scalar 281 | "A new complex scalar" 282 | Pointer 283 | [real float] 284 | [imag float] 285 | [loc str]) 286 | 287 | (jna/def-jna-fn (apl-library-path) 288 | char_scalar 289 | "A new character scalar" 290 | Pointer 291 | [unicode char] 292 | [loc str]) 293 | 294 | 295 | ;; destructor 296 | 297 | (jna/def-jna-fn (apl-library-path) 298 | release_value 299 | "APL value destructor function. All non-0 APL_values must be released 300 | at some point in time (even const ones). release_value(0) is not needed 301 | but accepted." 302 | nil 303 | [val APL_value] 304 | [loc str]) 305 | 306 | (jna/def-jna-fn (apl-library-path) 307 | get_owner_count 308 | "return the number of owners of value val. An owner count of 1 means that 309 | the next release_value(val) will delete the value val. If the APL 310 | command )CHECK reports \"stale values\" then they might be caused by 311 | missing calls of release_value(); in this case get_owner_count() can 312 | be used to trouble-shoot the cause for stale values." 313 | Pointer 314 | [val APL_value]) 315 | 316 | (jna/def-jna-fn (apl-library-path) 317 | get_function_ucs 318 | "Get reference to an APL function. 319 | 320 | Example: 321 | (require '[tech.v3.jna :as jna] 322 | 'tech.v3.datatype.jna) 323 | (def ⍴ (jna/get_function_ucs (dtype/make-container :native-heap :uint64 [\\⍴]) 324 | (dtype/make-container :native-heap :uint64 []) 325 | (dtype/make-container :native-heap :uint64 []))) 326 | 327 | Note that the '\\⍴' is a char, and is double-escaped in the docstring 328 | " 329 | Pointer 330 | [name jna/ensure-ptr] 331 | [L jna/ensure-ptr] 332 | [R jna/ensure-ptr]) 333 | 334 | (jna/def-jna-fn (apl-library-path) 335 | eval__fun 336 | "evaluate niladic function f" 337 | Pointer 338 | [fun APL_function]) 339 | 340 | (jna/def-jna-fn (apl-library-path) 341 | eval__A_fun_B 342 | "dyadic function fun with arguments A and B 343 | 344 | (let [A (-> [3 3] tensor/->tensor ->apl) 345 | B (jna/char_vector \"hello\" \"\")] 346 | (drawing (jna/eval__A_fun_B A ⍴ B))) 347 | 348 | ┏→━━┓ 349 | ↓hel┃ 350 | ┃loh┃ 351 | ┃ell┃ 352 | ┗━━━┛ 353 | 354 | " 355 | Pointer 356 | [A APL_value] 357 | [fun APL_function] 358 | [B APL_value]) 359 | 360 | (jna/def-jna-fn (apl-library-path) 361 | eval__A_L_oper_B 362 | "monadic operator oper with function L arguments A and B" 363 | Pointer 364 | [A APL_value] 365 | [L APL_function] 366 | [fun APL_function] 367 | [B APL_value]) 368 | 369 | (jna/def-jna-fn (apl-library-path) 370 | eval__A_fun_X_B 371 | "dyadic function fun with axis X and arguments A and B" 372 | Pointer 373 | [A APL_value] 374 | [fun APL_function] 375 | [X APL_value] 376 | [B APL_value]) 377 | 378 | (jna/def-jna-fn (apl-library-path) 379 | eval__A_L_oper_R_B 380 | "dyadic operator oper with functions L and R and arguments A and B" 381 | Pointer 382 | [A APL_value] 383 | [L APL_function] 384 | [fun APL_function] 385 | [R APL_function] 386 | [B APL_value]) 387 | 388 | (jna/def-jna-fn (apl-library-path) 389 | eval__A_L_oper_X_B 390 | "monadic operator oper with functions L, axis X, and arguments A and B" 391 | Pointer 392 | [A APL_value] 393 | [L APL_function] 394 | [fun APL_function] 395 | [X APL_value] 396 | [B APL_value]) 397 | 398 | (jna/def-jna-fn (apl-library-path) 399 | eval__A_L_oper_R_X_B 400 | "dyadic operator oper with functions L and R, axis X, and arguments A and B" 401 | Pointer 402 | [A APL_value] 403 | [L APL_function] 404 | [fun APL_function] 405 | [X APL_value] 406 | [B APL_value]) 407 | 408 | 409 | (jna/def-jna-fn (apl-library-path) 410 | eval__fun_B 411 | "monadic function fun with argument B" 412 | Pointer 413 | [fun APL_function] 414 | [B APL_value]) 415 | 416 | (jna/def-jna-fn (apl-library-path) 417 | eval__L_oper_B 418 | "monadic operator oper with function L argument B" 419 | Pointer 420 | [L APL_function] 421 | [fun APL_function] 422 | [B APL_function]) 423 | 424 | (jna/def-jna-fn (apl-library-path) 425 | eval__fun_X_B 426 | "monadic function fun with axis X and argument B" 427 | Pointer 428 | [fun APL_function] 429 | [X APL_value] 430 | [B APL_value]) 431 | 432 | (jna/def-jna-fn (apl-library-path) 433 | eval__L_oper_R_B 434 | "dyadic operator oper with functions L and R and argument B" 435 | Pointer 436 | [L APL_function] 437 | [fun APL_function] 438 | [X APL_function] 439 | [B APL_value]) 440 | 441 | (jna/def-jna-fn (apl-library-path) 442 | eval__L_oper_X_B 443 | "monadic operator oper with function L, axis X, and argument B" 444 | Pointer 445 | [L APL_function] 446 | [fun APL_function] 447 | [X APL_value] 448 | [B APL_value]) 449 | 450 | (jna/def-jna-fn (apl-library-path) 451 | eval__L_oper_R_X_B 452 | "dyadic operator oper with functions L and R, axis X, and argument B" 453 | Pointer 454 | [L APL_function] 455 | [fun APL_function] 456 | [R APL_function] 457 | [X APL_value] 458 | [B APL_value]) 459 | -------------------------------------------------------------------------------- /src/libapl_clj/impl/ops.clj: -------------------------------------------------------------------------------- 1 | (ns libapl-clj.impl.ops 2 | (:require tech.v3.datatype.jna 3 | [tech.v3.datatype :as dtype] 4 | [tech.v3.tensor :as tensor] 5 | [libapl-clj.impl.jna :as jna :reload true] 6 | [libapl-clj.impl.api :as api] 7 | [libapl-clj.impl.pointer :as p] 8 | libapl-clj.impl.protocols 9 | [complex.core :refer [complex]] 10 | [libapl-clj.impl.helpers :as h :reload true]) 11 | (:import [java.util UUID])) 12 | 13 | 14 | (defn run-simple-string! 15 | "Run an APL command. Returns `true` if successful." 16 | [cmd] 17 | (zero? (api/run-simple-string! cmd))) 18 | 19 | (let [initialized? (atom false)] 20 | (defn initialize! [] 21 | (when-not @initialized? 22 | (api/initialize!) 23 | (api/run-simple-string! "⎕io ← 0") 24 | (reset! initialized? :ok)) 25 | @initialized?)) 26 | 27 | 28 | (defonce _ (initialize!)) 29 | 30 | 31 | (defn ->scalar-pointer [x] 32 | ;; todo -- reflection, gross. This could benefit from 33 | ;; a protocol and type extension 34 | (cond 35 | (int? x) (jna/int_scalar x "") 36 | (or (float? x) (double? x)) (jna/double_scalar (double x) "") 37 | (char? x) (jna/char_scalar x "") 38 | (string? x) (jna/char_vector x "") 39 | :else (throw (ex-info "Invalid type" 40 | {:type (type x)})))) 41 | 42 | (defn ->shape [p-or-t] 43 | ;; needs to have reflection removed 44 | (if-let [t (and (tensor/tensor? p-or-t) 45 | p-or-t)] 46 | (dtype/shape t) 47 | (let [p p-or-t 48 | rank (jna/get_rank p)] 49 | (->> (range rank) 50 | (mapv #(jna/get_axis p %)) 51 | (tensor/->tensor))))) 52 | 53 | 54 | (comment 55 | (PTensor. (api/char-vector "hello"))) 56 | 57 | (declare ->tensor) ;; ->tensor is mutually recursive with jvm< 58 | 59 | (defn jvm< [apl-value idx] 60 | (case (api/type-at-idx apl-value idx) 61 | 0 nil 62 | 63 | ;; char 64 | 0x02 (api/char< apl-value idx) 65 | 66 | ;; pointer, probably a vector or char-vector 67 | 0x04 (->> idx 68 | (api/avp< apl-value) 69 | ->tensor) 70 | 71 | ;; todo CELLREF -- never encountered this, not sure what it is 72 | 0x08 (->> idx 73 | (api/avp< apl-value) 74 | ->tensor) 75 | 76 | ;; int 77 | 0x10 (api/int< apl-value idx) 78 | 79 | ;; float, double, or real part of complex number 80 | 0x20 (api/real< apl-value idx) 81 | 82 | ;; complex number 83 | 0x40 (complex (api/real< apl-value idx) 84 | (api/imag< apl-value idx)))) 85 | 86 | (defn ->tensor [apl-value] 87 | (let [rank (api/rank apl-value) 88 | n (api/n-elems apl-value) 89 | shape' (->shape apl-value) 90 | random-name (h/random-var-name)] 91 | (-> (dtype/make-reader :object n (jvm< apl-value idx)) 92 | (tensor/construct-tensor 93 | (tech.v3.tensor.dimensions/dimensions 94 | (dtype/->reader shape')))))) 95 | 96 | (defn set-scalar! [atp idx elt] 97 | ;; todo -- remove reflection 98 | (cond 99 | (int? elt) (api/set-int! atp idx elt) 100 | (or (double? elt) 101 | (float? elt)) (api/set-double! atp idx elt) 102 | (char? elt) (api/set-char! atp idx elt))) 103 | 104 | (declare tensor->apl) ;; set-compound! is mutually recursive with tensor->apl 105 | 106 | (defn set-compound! [atp idx elt] 107 | ;; todo -- remove reflection 108 | (let [val (if (string? elt) 109 | (api/char-vector elt) 110 | (-> elt 111 | seq 112 | dtype/ensure-reader 113 | tensor/ensure-tensor 114 | tensor->apl))] 115 | (api/set-value! atp idx val))) 116 | 117 | (defn tensor->apl [tensor] 118 | ;; todo -- gc 119 | (def tensor tensor) 120 | (let [elems (dtype/->reader tensor) 121 | shape (dtype/shape tensor) 122 | atp (api/apl-value (-> shape dtype/->reader vec)) 123 | items (->> elems 124 | (interleave (range)) 125 | (partition 2))] 126 | (tap> {:tensor->apl/items items}) 127 | (doseq [[idx elt] items] 128 | (tap> {:tensor->apl/atp atp}) 129 | (tap> {:tensor->apl/idx idx}) 130 | (tap> {:tensor->apl/elt elt}) 131 | ;; todo -- still a lot of reflection that needs to be removed 132 | (if (h/scalar? elt) 133 | (set-scalar! atp idx elt) 134 | (set-compound! atp idx elt))) 135 | atp)) 136 | 137 | (comment 138 | (set-compound! atp' idx' elt') 139 | (set-scalar! atp' idx' elt') 140 | (add-tap (fn [x] 141 | (when-let [elt (and (map? x) 142 | (:tensor->apl/elt x))] 143 | (def elt' elt)))) 144 | (add-tap (fn [x] 145 | (when-let [idx (and (map? x) 146 | (:tensor->apl/idx x))] 147 | (def idx' idx)))) 148 | (add-tap (fn [x] 149 | (when-let [atp (and (map? x) 150 | (:tensor->apl/atp x))] 151 | (def atp' atp)))) 152 | (add-tap (fn [x] 153 | (when-let [items (and (map? x) 154 | (:tensor->apl/items x))] 155 | (def items' items))))) 156 | 157 | (comment 158 | (def tensor (tensor/->tensor (range 3))) 159 | (-> (tensor/->tensor (range 3)) 160 | tensor->apl 161 | drawing!) 162 | (-> (tensor/->tensor [\d]) tensor->apl drawing!) 163 | (-> (tensor/->tensor [1 2 3 "hello" [1.12 (double 2.4) (long 3.15) [2 3 4 5]] 164 | (tensor/->tensor [1 2 3])]) 165 | tensor->apl 166 | ->tensor 167 | tensor->apl 168 | drawing!) 169 | 170 | (drawing! (api/apl-value [5 2 3]))) 171 | 172 | 173 | 174 | -------------------------------------------------------------------------------- /src/libapl_clj/impl/pointer.clj: -------------------------------------------------------------------------------- 1 | (ns libapl-clj.impl.pointer 2 | (:refer-clojure :exclude [- = * > < / + -]) 3 | (:require [libapl-clj.impl.jna :as jna] 4 | tech.v3.datatype.jna ;; <-- this is criticial 5 | [tech.v3.datatype :as dtype] 6 | [libapl-clj.impl.api :as api]) 7 | (:import [com.sun.jna Pointer])) 8 | 9 | 10 | (defn ^:private getfn 11 | "Import an APL function into Clojure as a pointer" 12 | ^Pointer [^String fstring] 13 | (api/get-function-ucs fstring)) 14 | 15 | (def + (getfn '+)) 16 | (def - (getfn '-)) 17 | (def × (getfn '×)) 18 | (def = (getfn '=)) 19 | (def ÷ (getfn '÷)) 20 | (def * (getfn '*)) 21 | (def ⌈ (getfn '⌈)) 22 | (def ⌊ (getfn '⌊)) 23 | (def | (getfn '|)) 24 | (def < (getfn '<)) 25 | (def ≤ (getfn '≤)) 26 | (def = (getfn '=)) 27 | (def > (getfn '>)) 28 | (def ≥ (getfn '≥)) 29 | (def ≠ (getfn '≠)) 30 | (def ⍴ (getfn '⍴)) 31 | (def ∊ (getfn '∊)) 32 | (def ∨ (getfn '∨)) 33 | (def ∧ (getfn '∧)) 34 | (def ⍱ (getfn '⍱)) 35 | (def ⍲ (getfn '⍲)) 36 | (def ... (getfn ",")) 37 | (def ⍪ (getfn '⍪)) 38 | (def / (getfn '/)) 39 | (def ⌿ (getfn '⌿)) 40 | (def ⍳ (getfn '⍳)) 41 | (def ⌷ (getfn '⌷)) 42 | (def ⍕ (getfn '⍕)) 43 | (def ⍎ (getfn '⍎)) 44 | (def ∼ (getfn '∼)) 45 | (def ↑ (getfn '↑)) 46 | (def ↓ (getfn '↓)) 47 | (def backslash (getfn "\\")) 48 | (def ⌽ (getfn '⌽)) 49 | (def ⍉ (getfn '⍉)) 50 | (def ⊖ (getfn '⊖)) 51 | (def ¯ (getfn '¯)) 52 | (def ⍬ (getfn '⍬)) 53 | (def ← (getfn '←)) 54 | (def → (getfn '→)) 55 | ;; (def ⍞ (getfn "⍞")) 56 | (def hashtag (getfn "#")) 57 | ;; (def ⎕ (getfn "⎕")) 58 | (def ⍋ (getfn '⍋)) 59 | (def ⍒ (getfn '⍒)) 60 | (def ⊥ (getfn '⊥)) 61 | (def ⊤ (getfn '⊤)) 62 | (def ? (getfn '?)) 63 | (def ⍟ (getfn '⍟)) 64 | (def ! (getfn '!)) 65 | (def ○ (getfn '○)) 66 | (def ⌹ (getfn '⌹)) 67 | (def ∩ (getfn '∩)) 68 | (def ∪ (getfn '∪)) 69 | (def ≡ (getfn '≡)) 70 | (def ≢ (getfn '≢)) 71 | (def ¨ (getfn '¨)) 72 | (def ∘. (getfn '∘.)) ;; ⍝ not sure if this will work 73 | (def ⍤ (getfn '⍤)) 74 | (def . (getfn '.)) 75 | (def ⍳ (getfn '⍳)) 76 | (def ⍷ (getfn '⍷)) 77 | (def ⊣ (getfn '⊣)) 78 | (def ⊢ (getfn '⊢)) 79 | (def ⊂ (getfn '⊂)) 80 | (def ⊃ (getfn '⊃)) 81 | -------------------------------------------------------------------------------- /src/libapl_clj/impl/protocols.clj: -------------------------------------------------------------------------------- 1 | (ns libapl-clj.impl.protocols 2 | (:require [libapl-clj.impl.api :as api] 3 | tech.v3.datatype.pprint)) 4 | 5 | (deftype PTensor [t] 6 | Object 7 | (toString [_] 8 | (str "\n" (api/avp->string! t)))) 9 | 10 | (tech.v3.datatype.pprint/implement-tostring-print PTensor) 11 | -------------------------------------------------------------------------------- /src/libapl_clj/prototype.clj: -------------------------------------------------------------------------------- 1 | (ns libapl-clj.prototype 2 | (:require [libapl-clj.api :as api] 3 | [libapl-clj.impl.ops :as ops] 4 | [libapl-clj.impl.pointer :as p] 5 | [libapl-clj.impl.helpers :as h])) 6 | 7 | (defn jvm-fn [f] 8 | (fn 9 | ([] (f)) 10 | ([arg & args] 11 | (let [args (into [arg]args)] 12 | (-> f 13 | (apply args) 14 | api/->jvm))))) 15 | 16 | (defn monodyadic-fn' 17 | [fp] 18 | (fn 19 | ([] fp) 20 | ([arg] (api/fp+arg fp arg)) 21 | ([arg1 arg2] (api/arg+fp+arg arg1 fp arg2)) 22 | ([arg1 arg2 & more] 23 | (reduce #(api/arg+fp+arg (api/value->apl %1) fp (api/value->apl %2)) 24 | (into [arg1 arg2] more))))) 25 | 26 | (def monodyadic-fn (jvm-fn monodyadic-fn)) 27 | 28 | (defn left-operator-fn' 29 | [op] 30 | (fn 31 | ([] op) 32 | ([fp arg] 33 | (api/fp+op+arg (fp) op arg)) 34 | ([fp axis arg] 35 | (api/fp+op+axis+arg (fp) op axis arg)))) 36 | 37 | (def left-operator-fn (jvm-fn left-operator-fn')) 38 | 39 | (defn dyadic-operator-fn' 40 | [op] 41 | (fn 42 | ([] op) 43 | ([fp1 fp2 arg] 44 | (api/fp+op+fp+arg (fp1) op (fp2) arg)) 45 | ([fp1 fp2 axis arg] 46 | (api/fp+op+fp+axis+arg (fp1) op (fp2) axis)))) 47 | 48 | (def dyadic-operator-fn (jvm-fn dyadic-operator-fn)) 49 | 50 | 51 | #_(defn monadic-operator-fn 52 | [fp] 53 | (fn 54 | ([] fp) 55 | ([arg] 56 | (api/fp+arg fp arg)) 57 | ([]))) 58 | -------------------------------------------------------------------------------- /src/libapl_clj/types.clj: -------------------------------------------------------------------------------- 1 | (ns libapl-clj.types 2 | (:require [complex.core :refer [complex]])) 3 | 4 | org.apache.commons.math3.complex.Complex 5 | 6 | (def type-map {0 nil 7 | 0x02 ::char 8 | 0x04 ::tensor 9 | 0x08 ::tensor 10 | 0x10 ::integer 11 | 0x20 ::double 12 | 0x40 ::complex}) 13 | 14 | (def type->key-type {nil nil 15 | Character ::char 16 | tech.v3.tensor.Tensor ::tensor 17 | Integer ::integer 18 | Double ::double 19 | org.apache.commons.math3.complex.Complex ::complex}) 20 | -------------------------------------------------------------------------------- /test/apl_test.clj: -------------------------------------------------------------------------------- 1 | (ns apl-test 2 | (:require [clojure.test :as t :refer [deftest testing is]] 3 | [libapl-clj.apl :as apl] 4 | [tech.v3.datatype :as dtype] 5 | [tech.v3.tensor :as tensor])) 6 | 7 | (deftest test->apl 8 | (testing "testing ->apl" 9 | (let [p (apl/->apl [1 2])] 10 | (is (= [1 2] (-> p apl/->jvm dtype/->reader vec))) 11 | (is (= [1 2] (-> p 12 | apl/->apl 13 | apl/->jvm 14 | apl/->apl 15 | apl/->jvm 16 | dtype/->reader 17 | vec))))) 18 | (testing "nested ->apl" 19 | (let [structure [1 2 20 | "nested" 21 | ["data" 22 | [2 3 4 23 | ["structure" 24 | 5 6 7]]] 25 | ["is" ["here"]]] 26 | p (apl/->apl structure) 27 | ravel (-> p 28 | apl/->jvm 29 | dtype/->reader 30 | vec 31 | flatten)] 32 | (is (= ravel 33 | [1 2 34 | \n \e \s \t \e \d 35 | \d \a \t \a 36 | 2 3 4 37 | \s \t \r \u \c \t \u \r \e 38 | 5 6 7 39 | \i \s 40 | \h \e \r \e]))))) 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | --------------------------------------------------------------------------------