├── .github └── workflows │ └── tests.yml ├── .gitignore ├── API.md ├── LICENSE ├── README.md ├── elm.json ├── examples ├── Docs.elm └── elm.json ├── package-lock.json ├── package.json ├── src ├── Enclojure.elm └── Enclojure │ ├── Callable.elm │ ├── Common.elm │ ├── Extra │ └── Maybe.elm │ ├── Json.elm │ ├── Lib.elm │ ├── Lib │ └── String.elm │ ├── Located.elm │ ├── Reader.elm │ ├── Reader │ ├── DoubleQuotedString.elm │ └── Macros.elm │ ├── Runtime.elm │ ├── Value.elm │ ├── ValueKeyMap.elm │ ├── ValueMap.elm │ └── ValueSet.elm └── tests └── Suite.elm /.github/workflows/tests.yml: -------------------------------------------------------------------------------- 1 | # Based on https://github.com/mdgriffith/elm-ui/blob/master/.github/workflows/tests.yml 2 | # Thank you Matthew Griffith! 3 | 4 | name: Test Suite 5 | 6 | on: [push] 7 | 8 | jobs: 9 | testing: 10 | runs-on: ubuntu-latest 11 | 12 | steps: 13 | - uses: actions/checkout@v2 14 | 15 | - name: Setup node 16 | uses: actions/setup-node@v1 17 | with: 18 | node-version: 10 19 | 20 | - uses: actions/cache@v1 21 | with: 22 | path: ~/.npm 23 | key: ${{ runner.os }}-node-${{ hashFiles('**/package-lock.json') }} 24 | restore-keys: | 25 | ${{ runner.os }}-node- 26 | - name: Install 27 | run: npm ci 28 | 29 | - name: Elm test suite 30 | run: npm run test 31 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /elm-stuff 2 | /examples/elm-stuff 3 | /node_modules 4 | 5 | -------------------------------------------------------------------------------- /API.md: -------------------------------------------------------------------------------- 1 | # Enclojure API 2 | 3 | ## * 4 | 5 | `(function)` 6 | 7 | Usage: 8 | 9 | ``` 10 | (*) 11 | (* x) 12 | (* x y & more) 13 | ``` 14 | 15 | Returns the product of nums. (*) returns 1. 16 | 17 | ## + 18 | 19 | `(function)` 20 | 21 | Usage: 22 | 23 | ``` 24 | (+) 25 | (+ x) 26 | (+ x y & more) 27 | ``` 28 | 29 | Returns the sum of nums. (+) returns 0. 30 | 31 | ## - 32 | 33 | `(function)` 34 | 35 | Usage: 36 | 37 | ``` 38 | (- x) 39 | (- x y & more) 40 | ``` 41 | 42 | If no ys are supplied, returns the negation of x, else subtracts the ys from x and returns the result. 43 | 44 | ## -> 45 | 46 | `(macro)` 47 | 48 | Usage: 49 | 50 | ``` 51 | (-> x & forms) 52 | ``` 53 | 54 | Threads the expr through the forms. Inserts x as the 55 | second item in the first form, making a list of it if it is not a 56 | list already. If there are more forms, inserts the first form as the 57 | second item in second form, etc. 58 | 59 | ## ->> 60 | 61 | `(macro)` 62 | 63 | Usage: 64 | 65 | ``` 66 | (->> x & forms) 67 | ``` 68 | 69 | Threads the expr through the forms. Inserts x as the 70 | last item in the first form, making a list of it if it is not a 71 | list already. If there are more forms, inserts the first form as the 72 | last item in second form, etc. 73 | 74 | ## / 75 | 76 | `(function)` 77 | 78 | Usage: 79 | 80 | ``` 81 | (/ x) 82 | (/ x y & more) 83 | ``` 84 | 85 | If no denominators are supplied, returns 1/numerator, else returns numerator divided by all of the denominators. 86 | 87 | ## < 88 | 89 | `(function)` 90 | 91 | Usage: 92 | 93 | ``` 94 | (< x) 95 | (< x y & more) 96 | ``` 97 | 98 | Returns non-nil if nums or strings are in monotonically increasing order, otherwise false. 99 | 100 | ## <= 101 | 102 | `(function)` 103 | 104 | Usage: 105 | 106 | ``` 107 | (<= x) 108 | (<= x y & more) 109 | ``` 110 | 111 | Returns non-nil if nums or strings are in monotonically non-decreasing order, otherwise false. 112 | 113 | ## > 114 | 115 | `(function)` 116 | 117 | Usage: 118 | 119 | ``` 120 | (> x) 121 | (> x y & more) 122 | ``` 123 | 124 | Returns non-nil if nums are in monotonically decreasing order, otherwise false. 125 | 126 | ## >= 127 | 128 | `(function)` 129 | 130 | Usage: 131 | 132 | ``` 133 | (>= x) 134 | (>= x y & more) 135 | ``` 136 | 137 | Returns non-nil if nums are in monotonically non-increasing order, otherwise false. 138 | 139 | ## __lambda 140 | 141 | `(macro)` 142 | 143 | Usage: 144 | 145 | ``` 146 | 147 | ``` 148 | 149 | Inserted by the reader in place of #(). 150 | 151 | ## abs 152 | 153 | `(function)` 154 | 155 | Usage: 156 | 157 | ``` 158 | (abs x) 159 | ``` 160 | 161 | Returns the absolute value of a. 162 | If a is a double and zero => +0.0 163 | If a is a double and ##Inf or ##-Inf => ##Inf 164 | If a is a double and ##NaN => ##NaN 165 | 166 | ## and 167 | 168 | `(macro)` 169 | 170 | Usage: 171 | 172 | ``` 173 | (and x) 174 | (and x & next) 175 | ``` 176 | 177 | Evaluates exprs one at a time, from left to right. If a form 178 | returns logical false (nil or false), and returns that value and 179 | doesn't evaluate any of the other expressions, otherwise it returns 180 | the value of the last expr. (and) returns true. 181 | 182 | ## atom 183 | 184 | `(function)` 185 | 186 | Usage: 187 | 188 | ``` 189 | (atom x) 190 | ``` 191 | 192 | Creates and returns an Atom with an initial value of x. 193 | 194 | ## case 195 | 196 | `(macro)` 197 | 198 | Usage: 199 | 200 | ``` 201 | (case e & clauses) 202 | ``` 203 | 204 | Takes an expression and a set of test/expr pairs. Each clause can take the form of either: 205 | test-constant result-expr 206 | (test-constant1 ... test-constantN) result-expr 207 | 208 | The test-constants are not evaluated. They must be compile-time 209 | literals, and need not be quoted. If the expression is equal to a 210 | test-constant, the corresponding result-expr is returned. A single 211 | default expression can follow the clauses, and its value will be 212 | returned if no clause matches. If no default expression is provided 213 | and no clause matches, an exception is thrown. 214 | 215 | Unlike Clojure, the clauses are considered sequentially. 216 | The current implementation doesn't throw on redundant test expressions. 217 | All manner of constant 218 | expressions are acceptable in case, including numbers, strings, 219 | symbols, keywords, and (Clojure) composites thereof. Note that since 220 | lists are used to group multiple constants that map to the same 221 | expression, a vector can be used to match a list if needed. The 222 | test-constants need not be all of the same type. 223 | 224 | 225 | ## comp 226 | 227 | `(function)` 228 | 229 | Usage: 230 | 231 | ``` 232 | (comp & fns) 233 | ``` 234 | 235 | Takes a set of functions and returns a fn that is the composition 236 | of those fns. The returned fn takes a variable number of args, 237 | applies the rightmost of fns to the args, the next 238 | fn (right-to-left) to the result, etc. 239 | 240 | ## complement 241 | 242 | `(function)` 243 | 244 | Usage: 245 | 246 | ``` 247 | (complement f) 248 | ``` 249 | 250 | Takes a fn f and returns a fn that takes the same arguments as f, has the same effects, 251 | if any, and returns the opposite truth value. 252 | 253 | ## concat 254 | 255 | `(function)` 256 | 257 | Usage: 258 | 259 | ``` 260 | (concat & colls) 261 | ``` 262 | 263 | Returns a seq representing the concatenation of the elements in the supplied colls. 264 | 265 | ## cond 266 | 267 | `(macro)` 268 | 269 | Usage: 270 | 271 | ``` 272 | (cond & clauses) 273 | ``` 274 | 275 | Takes a set of test/expr pairs. It evaluates each test one at a 276 | time. If a test returns logical true, cond evaluates and returns 277 | the value of the corresponding expr and doesn't evaluate any of the 278 | other tests or exprs. (cond) returns nil. 279 | 280 | If the test is a :let keyword, the next test/expr pair will be wrapped in a let expression with the values supplied 281 | as the expr for the :let. 282 | 283 | 284 | ## conj 285 | 286 | `(function)` 287 | 288 | Usage: 289 | 290 | ``` 291 | (conj coll x & xs) 292 | ``` 293 | 294 | conj[oin]. Returns a new collection with the xs 295 | 'added'. (conj nil item) returns (item). 296 | (conj coll) returns coll. (conj) returns []. 297 | The 'addition' may happen at different 'places' depending 298 | on the concrete type. 299 | 300 | ## cons 301 | 302 | `(function)` 303 | 304 | Usage: 305 | 306 | ``` 307 | (cons x seq) 308 | ``` 309 | 310 | Returns a new seq where x is the first element and seq is the rest. 311 | 312 | ## constantly 313 | 314 | `(function)` 315 | 316 | Usage: 317 | 318 | ``` 319 | (constantly x) 320 | ``` 321 | 322 | Returns a function that takes any number of arguments and returns x. 323 | 324 | ## contains? 325 | 326 | `(function)` 327 | 328 | Usage: 329 | 330 | ``` 331 | (contains? coll key) 332 | ``` 333 | 334 | Returns true if key is present in the given collection, otherwise 335 | returns false. Note that for numerically indexed collections like 336 | vectors, this tests if the numeric key is within the 337 | range of indexes. 'contains?' operates constant or logarithmic time; 338 | it will not perform a linear search for a value. See also 'some'. 339 | 340 | ## count 341 | 342 | `(function)` 343 | 344 | Usage: 345 | 346 | ``` 347 | (count coll) 348 | ``` 349 | 350 | Returns the number of items in coll. (count nil) returns 0. Also works on strings. 351 | 352 | ## dec 353 | 354 | `(function)` 355 | 356 | Usage: 357 | 358 | ``` 359 | (dec x) 360 | ``` 361 | 362 | Returns a number one less than num. 363 | 364 | ## dedupe 365 | 366 | `(function)` 367 | 368 | Usage: 369 | 370 | ``` 371 | (dedupe coll) 372 | ``` 373 | 374 | Returns a list removing consecutive duplicates in coll. 375 | 376 | ## def 377 | 378 | `(special form)` 379 | 380 | Usage: 381 | 382 | ``` 383 | (def symbol init) 384 | ``` 385 | 386 | Creates and interns a global var with the name 387 | of symbol or locates such a var if it already exists. Then init is evaluated, and the 388 | root binding of the var is set to the resulting value. 389 | 390 | ## defn 391 | 392 | `(macro)` 393 | 394 | Usage: 395 | 396 | ``` 397 | (defn name doc-string? [params*] body) 398 | (defn name doc-string? & bodies) 399 | ``` 400 | 401 | Same as (def name "doc" (fn [params* ] exprs*)) or (def 402 | name (fn "doc" ([params* ] exprs*)+)). 403 | 404 | ## deref 405 | 406 | `(function)` 407 | 408 | Usage: 409 | 410 | ``` 411 | (deref ref) 412 | ``` 413 | 414 | Also reader macro: @var/@atom. When applied to a var or atom, returns its current state. 415 | 416 | ## distinct 417 | 418 | `(function)` 419 | 420 | Usage: 421 | 422 | ``` 423 | (distinct coll) 424 | ``` 425 | 426 | Returns a list of the elements of coll with duplicates removed. 427 | 428 | ## distinct? 429 | 430 | `(function)` 431 | 432 | Usage: 433 | 434 | ``` 435 | (distinct? x & args) 436 | ``` 437 | 438 | Returns true if no two of the arguments are = 439 | 440 | ## do 441 | 442 | `(special form)` 443 | 444 | Usage: 445 | 446 | ``` 447 | (do & exprs) 448 | ``` 449 | 450 | Evaluates the expressions in order and returns the value of 451 | the last. If no expressions are supplied, returns nil. 452 | 453 | ## doseq 454 | 455 | `(macro)` 456 | 457 | Usage: 458 | 459 | ``` 460 | (doseq seq-exprs & body) 461 | ``` 462 | 463 | Repeatedly executes body (presumably for side-effects) with 464 | bindings and filtering as provided by "for". Does not retain 465 | the head of the sequence. Returns nil. 466 | 467 | ## dotimes 468 | 469 | `(macro)` 470 | 471 | Usage: 472 | 473 | ``` 474 | (dotimes bindings & body) 475 | ``` 476 | 477 | bindings => name n 478 | 479 | Repeatedly executes body (presumably for side-effects) with name 480 | bound to integers from 0 through n-1. 481 | 482 | ## drop 483 | 484 | `(function)` 485 | 486 | Usage: 487 | 488 | ``` 489 | (drop n coll) 490 | ``` 491 | 492 | Returns a list of all but the first n items in coll. 493 | 494 | ## drop-while 495 | 496 | `(function)` 497 | 498 | Usage: 499 | 500 | ``` 501 | (drop-while pred coll) 502 | ``` 503 | 504 | Returns a list of the items in coll starting from the first item for which (pred item) returns logical false. 505 | 506 | ## empty 507 | 508 | `(function)` 509 | 510 | Usage: 511 | 512 | ``` 513 | (empty coll) 514 | ``` 515 | 516 | Returns an empty collection of the same type as coll, or nil. 517 | 518 | ## empty? 519 | 520 | `(function)` 521 | 522 | Usage: 523 | 524 | ``` 525 | (empty? coll) 526 | ``` 527 | 528 | Returns true if coll has no items - same as (not (seq coll)). 529 | Please use the idiom (seq x) rather than (not (empty? x)) 530 | 531 | ## even? 532 | 533 | `(function)` 534 | 535 | Usage: 536 | 537 | ``` 538 | (even? n) 539 | ``` 540 | 541 | Returns true if n is even, throws an exception if n is not an integer. 542 | 543 | ## every? 544 | 545 | `(function)` 546 | 547 | Usage: 548 | 549 | ``` 550 | (every? pred coll) 551 | ``` 552 | 553 | Returns true if (pred x) is logical true for every x in coll, else false. 554 | 555 | ## false? 556 | 557 | `(function)` 558 | 559 | Usage: 560 | 561 | ``` 562 | (false? x) 563 | ``` 564 | 565 | Returns true if x is false, false otherwise. 566 | 567 | ## filter 568 | 569 | `(function)` 570 | 571 | Usage: 572 | 573 | ``` 574 | (filter pred coll) 575 | ``` 576 | 577 | Returns a list of the items in coll for which (pred item) returns logical true. 578 | 579 | ## fn 580 | 581 | `(special form)` 582 | 583 | Usage: 584 | 585 | ``` 586 | (fn name? docstring? [params*] exprs*) 587 | (fn name? ([params*] exprs*) +) 588 | ``` 589 | 590 | params => positional-params*, or positional-params* & rest-param 591 | positional-param => binding-form 592 | rest-param => binding-form 593 | binding-form => name, or destructuring-form 594 | 595 | Defines a function. 596 | 597 | ## fnil 598 | 599 | `(function)` 600 | 601 | Usage: 602 | 603 | ``` 604 | (fnil f default) 605 | ``` 606 | 607 | Takes a function f, and returns a function that calls f, replacing 608 | a nil first argument to f with the supplied value x. Higher arity 609 | versions can replace arguments in the second and third 610 | positions (y, z). Note that the function f can take any number of 611 | arguments, not just the one(s) being nil-patched. 612 | 613 | ## for 614 | 615 | `(macro)` 616 | 617 | Usage: 618 | 619 | ``` 620 | (for seq-exprs body-expr) 621 | ``` 622 | 623 | List comprehension. Takes a vector of one or more 624 | binding-form/collection-expr pairs, each followed by zero or more 625 | modifiers, and yields a list of evaluations of expr. 626 | Collections are iterated in a nested fashion, rightmost fastest, 627 | and nested coll-exprs can refer to bindings created in prior 628 | binding-forms. Supported modifiers are: :let [binding-form expr ...], 629 | :when test. 630 | 631 | (take 100 (for [x (range 100000000) y (range 1000000) :when (< y x)] [x y])) 632 | 633 | ## identity 634 | 635 | `(function)` 636 | 637 | Usage: 638 | 639 | ``` 640 | (identity a) 641 | ``` 642 | 643 | Returns its argument. 644 | 645 | ## if 646 | 647 | `(special form)` 648 | 649 | Usage: 650 | 651 | ``` 652 | (if test then else?) 653 | ``` 654 | 655 | Evaluates test. If not the singular values nil or false, 656 | evaluates and yields then, otherwise, evaluates and yields else. If 657 | else is not supplied it defaults to nil. 658 | 659 | ## if-let 660 | 661 | `(macro)` 662 | 663 | Usage: 664 | 665 | ``` 666 | (if-let bindings then) 667 | (if-let bindings then else & oldform) 668 | ``` 669 | 670 | bindings => binding-form test 671 | 672 | If test is true, evaluates then with binding-form bound to the value of 673 | test, if not, yields else 674 | 675 | ## inc 676 | 677 | `(function)` 678 | 679 | Usage: 680 | 681 | ``` 682 | (inc x) 683 | ``` 684 | 685 | Returns a number one greater than num. 686 | 687 | ## into 688 | 689 | `(function)` 690 | 691 | Usage: 692 | 693 | ``` 694 | (into to from) 695 | ``` 696 | 697 | Returns a new coll consisting of to-coll with all of the items of from-coll conjoined. 698 | 699 | ## json/decode 700 | 701 | `(function)` 702 | 703 | Usage: 704 | 705 | ``` 706 | (json/decode s) 707 | ``` 708 | 709 | Attempt to decode a JSON string s as an Enclojure value. 710 | 711 | ## json/encode 712 | 713 | `(function)` 714 | 715 | Usage: 716 | 717 | ``` 718 | (json/encode x) 719 | ``` 720 | 721 | Encode x as a JSON string. 722 | 723 | ## keep 724 | 725 | `(function)` 726 | 727 | Usage: 728 | 729 | ``` 730 | (keep f coll) 731 | ``` 732 | 733 | Returns a list of the non-nil results of (f item). Note, this means false return values will be included. 734 | 735 | ## keep-indexed 736 | 737 | `(function)` 738 | 739 | Usage: 740 | 741 | ``` 742 | (keep-indexed f coll) 743 | ``` 744 | 745 | Returns a list of the non-nil results of (f index item). Note, this means false return values will be included. 746 | 747 | ## keys 748 | 749 | `(function)` 750 | 751 | Usage: 752 | 753 | ``` 754 | (keys map) 755 | ``` 756 | 757 | Returns a list of the map's keys, in the same order as (seq map). 758 | 759 | ## keyword? 760 | 761 | `(function)` 762 | 763 | Usage: 764 | 765 | ``` 766 | (keyword? x) 767 | ``` 768 | 769 | Return true if x is a Keyword 770 | 771 | ## last 772 | 773 | `(function)` 774 | 775 | Usage: 776 | 777 | ``` 778 | (last coll) 779 | ``` 780 | 781 | Return the last item in coll, in linear time. 782 | 783 | ## let 784 | 785 | `(special form)` 786 | 787 | Usage: 788 | 789 | ``` 790 | (let [bindings*] exprs*) 791 | ``` 792 | 793 | binding => binding-form init-expr 794 | binding-form => name, or destructuring-form 795 | destructuring-form => map-destructure-form, or seq-destructure-form 796 | 797 | Evaluates the exprs in a lexical context in which the symbols in 798 | the binding-forms are bound to their respective init-exprs or parts 799 | therein. 800 | 801 | ## list 802 | 803 | `(function)` 804 | 805 | Usage: 806 | 807 | ``` 808 | (list) 809 | ``` 810 | 811 | Creates a new list containing the items. 812 | 813 | ## list? 814 | 815 | `(function)` 816 | 817 | Usage: 818 | 819 | ``` 820 | (list? x) 821 | ``` 822 | 823 | Return true if x is a List 824 | 825 | ## loop 826 | 827 | `(macro)` 828 | 829 | Usage: 830 | 831 | ``` 832 | (loop [bindings*] exprs*) 833 | ``` 834 | 835 | Evaluates the exprs in a lexical context in which the symbols in 836 | the binding-forms are bound to their respective init-exprs or parts 837 | therein. Acts as a recur target. 838 | 839 | ## map 840 | 841 | `(function)` 842 | 843 | Usage: 844 | 845 | ``` 846 | (map f coll) 847 | ``` 848 | 849 | Returns a list consisting of the result of applying f to 850 | first item of coll, followed by applying f to the 851 | second item in coll, until coll 852 | exhausted. 853 | 854 | ## map-entry? 855 | 856 | `(function)` 857 | 858 | Usage: 859 | 860 | ``` 861 | (map-entry? x) 862 | ``` 863 | 864 | Return true if x is a MapEntry 865 | 866 | ## map-indexed 867 | 868 | `(function)` 869 | 870 | Usage: 871 | 872 | ``` 873 | (map-indexed f coll) 874 | ``` 875 | 876 | Returns a list consisting of the result of applying f to 0 877 | and the first item of coll, followed by applying f to 1 and the second 878 | item in coll, etc, until coll is exhausted. Thus function f should 879 | accept 2 arguments, index and item. 880 | 881 | ## map? 882 | 883 | `(function)` 884 | 885 | Usage: 886 | 887 | ``` 888 | (map? x) 889 | ``` 890 | 891 | Return true if x is a Map 892 | 893 | ## mapcat 894 | 895 | `(function)` 896 | 897 | Usage: 898 | 899 | ``` 900 | (mapcat f coll) 901 | ``` 902 | 903 | Returns the result of applying concat to the result of applying map 904 | to f and coll. Thus function f should return a collection. 905 | 906 | ## max 907 | 908 | `(function)` 909 | 910 | Usage: 911 | 912 | ``` 913 | (max x & rst) 914 | ``` 915 | 916 | Returns the greatest of the nums. 917 | 918 | ## min 919 | 920 | `(function)` 921 | 922 | Usage: 923 | 924 | ``` 925 | (min x & rst) 926 | ``` 927 | 928 | Returns the least of the nums. 929 | 930 | ## mod 931 | 932 | `(function)` 933 | 934 | Usage: 935 | 936 | ``` 937 | (mod num div) 938 | ``` 939 | 940 | Modulus of num and div. Truncates toward negative infinity. 941 | 942 | ## neg? 943 | 944 | `(function)` 945 | 946 | Usage: 947 | 948 | ``` 949 | (neg? x) 950 | ``` 951 | 952 | Returns true if x is less than zero, else false. 953 | 954 | ## next 955 | 956 | `(function)` 957 | 958 | Usage: 959 | 960 | ``` 961 | (next coll) 962 | ``` 963 | 964 | Returns a seq of the items after the first. Calls seq on its argument. If there are no more items, returns nil. 965 | 966 | ## nil? 967 | 968 | `(function)` 969 | 970 | Usage: 971 | 972 | ``` 973 | (nil? x) 974 | ``` 975 | 976 | Returns true if x is nil, false otherwise. 977 | 978 | ## not 979 | 980 | `(function)` 981 | 982 | Usage: 983 | 984 | ``` 985 | (not x) 986 | ``` 987 | 988 | Returns true if x is logical false, false otherwise. 989 | 990 | ## not-any? 991 | 992 | `(function)` 993 | 994 | Usage: 995 | 996 | ``` 997 | (not-any? pred coll) 998 | ``` 999 | 1000 | Returns false if (pred x) is logical true for any x in coll, else true. 1001 | 1002 | ## not-empty 1003 | 1004 | `(function)` 1005 | 1006 | Usage: 1007 | 1008 | ``` 1009 | (not-empty coll) 1010 | ``` 1011 | 1012 | If coll is empty, returns nil, else coll, 1013 | 1014 | ## not-every? 1015 | 1016 | `(function)` 1017 | 1018 | Usage: 1019 | 1020 | ``` 1021 | (not-every? pred coll) 1022 | ``` 1023 | 1024 | Returns false if (pred x) is logical true for every x in coll, else true. 1025 | 1026 | ## not= 1027 | 1028 | `(function)` 1029 | 1030 | Usage: 1031 | 1032 | ``` 1033 | (not= x) 1034 | (not= x y & more) 1035 | ``` 1036 | 1037 | Same as (not (= x y)) 1038 | 1039 | ## nth 1040 | 1041 | `(function)` 1042 | 1043 | Usage: 1044 | 1045 | ``` 1046 | (nth coll index) 1047 | (nth coll index not-found) 1048 | ``` 1049 | 1050 | Returns the value at the index. get returns nil if index out of 1051 | bounds, nth throws an exception unless not-found is supplied. nth also works for strings. 1052 | 1053 | ## odd? 1054 | 1055 | `(function)` 1056 | 1057 | Usage: 1058 | 1059 | ``` 1060 | (odd? n) 1061 | ``` 1062 | 1063 | Returns true if n is odd, throws an exception if n is not an integer. 1064 | 1065 | ## or 1066 | 1067 | `(macro)` 1068 | 1069 | Usage: 1070 | 1071 | ``` 1072 | (or) 1073 | (or x) 1074 | (or x & next) 1075 | ``` 1076 | 1077 | Evaluates exprs one at a time, from left to right. If a form 1078 | returns a logical true value, or returns that value and doesn't 1079 | evaluate any of the other expressions, otherwise it returns the 1080 | value of the last expression. (or) returns nil. 1081 | 1082 | ## pos? 1083 | 1084 | `(function)` 1085 | 1086 | Usage: 1087 | 1088 | ``` 1089 | (pos? x) 1090 | ``` 1091 | 1092 | Returns true if x is greater than zero, else false. 1093 | 1094 | ## pr-str 1095 | 1096 | `(function)` 1097 | 1098 | Usage: 1099 | 1100 | ``` 1101 | (pr-str) 1102 | ``` 1103 | 1104 | Prints the object(s) to a string. Prints the object(s), separated by spaces if there is more than one. Prints in a way that objects can be read by the reader 1105 | 1106 | ## quote 1107 | 1108 | `(special form)` 1109 | 1110 | Usage: 1111 | 1112 | ``` 1113 | (quote form) 1114 | ``` 1115 | 1116 | Yields the unevaluated form. 1117 | 1118 | ## rem 1119 | 1120 | `(function)` 1121 | 1122 | Usage: 1123 | 1124 | ``` 1125 | (rem x b) 1126 | ``` 1127 | 1128 | Returns remainder of dividing numerator by denominator. 1129 | 1130 | ## remove 1131 | 1132 | `(function)` 1133 | 1134 | Usage: 1135 | 1136 | ``` 1137 | (remove pred coll) 1138 | ``` 1139 | 1140 | Returns a list of the items in coll for which (pred item) returns logical false. 1141 | 1142 | ## repeat 1143 | 1144 | `(function)` 1145 | 1146 | Usage: 1147 | 1148 | ``` 1149 | (repeat n x) 1150 | ``` 1151 | 1152 | Returns a list of length n of xs. 1153 | 1154 | ## repeatedly 1155 | 1156 | `(function)` 1157 | 1158 | Usage: 1159 | 1160 | ``` 1161 | (repeatedly n f) 1162 | ``` 1163 | 1164 | Takes a function of no args, presumably with side effects, and 1165 | returns an list of n results of calling f. 1166 | 1167 | ## reset! 1168 | 1169 | `(function)` 1170 | 1171 | Usage: 1172 | 1173 | ``` 1174 | (reset! atom newval) 1175 | ``` 1176 | 1177 | Sets the value of atom to newval without regard for the current value. Returns newval. 1178 | 1179 | ## reverse 1180 | 1181 | `(function)` 1182 | 1183 | Usage: 1184 | 1185 | ``` 1186 | (reverse coll) 1187 | ``` 1188 | 1189 | Returns a seq of the items in coll in reverse order. 1190 | 1191 | ## seq 1192 | 1193 | `(function)` 1194 | 1195 | Usage: 1196 | 1197 | ``` 1198 | (seq coll) 1199 | ``` 1200 | 1201 | Returns a seq (list) on the collection. If the collection is empty, returns nil. 1202 | (seq nil) returns nil. 1203 | seq also works on strings. 1204 | 1205 | ## set 1206 | 1207 | `(function)` 1208 | 1209 | Usage: 1210 | 1211 | ``` 1212 | (set coll) 1213 | ``` 1214 | 1215 | Returns a set of the distinct elements of coll. 1216 | 1217 | ## set? 1218 | 1219 | `(function)` 1220 | 1221 | Usage: 1222 | 1223 | ``` 1224 | (set? x) 1225 | ``` 1226 | 1227 | Return true if x is a Set 1228 | 1229 | ## some 1230 | 1231 | `(function)` 1232 | 1233 | Usage: 1234 | 1235 | ``` 1236 | (some pred coll) 1237 | ``` 1238 | 1239 | Returns the first logical true value of (pred x) for any x in coll, 1240 | else nil. One common idiom is to use a set as pred, for example 1241 | this will return :fred if :fred is in the sequence, otherwise nil: 1242 | (some #{:fred} coll) 1243 | 1244 | ## some-> 1245 | 1246 | `(macro)` 1247 | 1248 | Usage: 1249 | 1250 | ``` 1251 | (some-> expr & forms) 1252 | ``` 1253 | 1254 | When expr is not nil, threads it into the first form (via ->), 1255 | and when that result is not nil, through the next etc 1256 | 1257 | ## some->> 1258 | 1259 | `(macro)` 1260 | 1261 | Usage: 1262 | 1263 | ``` 1264 | (some->> expr & forms) 1265 | ``` 1266 | 1267 | When expr is not nil, threads it into the first form (via ->>), 1268 | and when that result is not nil, through the next etc 1269 | 1270 | ## some? 1271 | 1272 | `(function)` 1273 | 1274 | Usage: 1275 | 1276 | ``` 1277 | (some? x) 1278 | ``` 1279 | 1280 | Returns true if x is not nil, false otherwise. 1281 | 1282 | ## str 1283 | 1284 | `(function)` 1285 | 1286 | Usage: 1287 | 1288 | ``` 1289 | (str) 1290 | ``` 1291 | 1292 | With no args, returns the empty string. With one arg x, returns a string representation of x. 1293 | (str nil) returns the empty string. 1294 | With more than one arg, returns the concatenation of the str values of the args. 1295 | 1296 | ## swap! 1297 | 1298 | `(function)` 1299 | 1300 | Usage: 1301 | 1302 | ``` 1303 | (swap! atom f & args) 1304 | ``` 1305 | 1306 | Atomically swaps the value of atom to be: (apply f current-value-of-atom args). 1307 | Returns the value that was swapped in. 1308 | 1309 | ## symbol? 1310 | 1311 | `(function)` 1312 | 1313 | Usage: 1314 | 1315 | ``` 1316 | (symbol? x) 1317 | ``` 1318 | 1319 | Return true if x is a Symbol 1320 | 1321 | ## take 1322 | 1323 | `(function)` 1324 | 1325 | Usage: 1326 | 1327 | ``` 1328 | (take n coll) 1329 | ``` 1330 | 1331 | Returns a list of the first n items in coll, or all items if there are fewer than n. 1332 | 1333 | ## take-while 1334 | 1335 | `(function)` 1336 | 1337 | Usage: 1338 | 1339 | ``` 1340 | (take-while pred coll) 1341 | ``` 1342 | 1343 | Returns a list of successive items from coll while (pred item) returns logical true. 1344 | 1345 | ## true? 1346 | 1347 | `(function)` 1348 | 1349 | Usage: 1350 | 1351 | ``` 1352 | (true? x) 1353 | ``` 1354 | 1355 | Returns true if x is true, false otherwise. 1356 | 1357 | ## update-vals 1358 | 1359 | `(function)` 1360 | 1361 | Usage: 1362 | 1363 | ``` 1364 | (update-vals m f) 1365 | ``` 1366 | 1367 | Given a map m and a function f of 1-argument, returns a new map where the keys of m 1368 | are mapped to result of applying f to the corresponding values of m. 1369 | 1370 | ## vals 1371 | 1372 | `(function)` 1373 | 1374 | Usage: 1375 | 1376 | ``` 1377 | (vals map) 1378 | ``` 1379 | 1380 | Returns a list of the map's values, in the same order as (seq map). 1381 | 1382 | ## vec 1383 | 1384 | `(function)` 1385 | 1386 | Usage: 1387 | 1388 | ``` 1389 | (vec coll) 1390 | ``` 1391 | 1392 | Creates a new vector containing the contents of coll. 1393 | 1394 | ## vector 1395 | 1396 | `(function)` 1397 | 1398 | Usage: 1399 | 1400 | ``` 1401 | (vector) 1402 | ``` 1403 | 1404 | Creates a new vector containing xs. 1405 | 1406 | ## vector? 1407 | 1408 | `(function)` 1409 | 1410 | Usage: 1411 | 1412 | ``` 1413 | (vector? x) 1414 | ``` 1415 | 1416 | Return true if x is a Vector 1417 | 1418 | ## when 1419 | 1420 | `(macro)` 1421 | 1422 | Usage: 1423 | 1424 | ``` 1425 | (when test & body) 1426 | ``` 1427 | 1428 | Evaluates test. If logical true, evaluates body in an implicit do. 1429 | 1430 | ## when-let 1431 | 1432 | `(macro)` 1433 | 1434 | Usage: 1435 | 1436 | ``` 1437 | (when-let bindings & body) 1438 | ``` 1439 | 1440 | bindings => binding-form test 1441 | 1442 | When test is true, evaluates body with binding-form bound to the value of test 1443 | 1444 | ## when-not 1445 | 1446 | `(macro)` 1447 | 1448 | Usage: 1449 | 1450 | ``` 1451 | (when-not test & body) 1452 | ``` 1453 | 1454 | Evaluates test. If logical false, evaluates body in an implicit do. 1455 | 1456 | ## while 1457 | 1458 | `(macro)` 1459 | 1460 | Usage: 1461 | 1462 | ``` 1463 | (while test & body) 1464 | ``` 1465 | 1466 | Repeatedly executes body while test expression is true. Presumes 1467 | some side-effect will cause test to become false/nil. Returns nil 1468 | 1469 | ## zero? 1470 | 1471 | `(function)` 1472 | 1473 | Usage: 1474 | 1475 | ``` 1476 | (zero? x) 1477 | ``` 1478 | 1479 | Returns true if x is zero, else false. -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2012-present Evan Czaplicki 2 | 3 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 4 | 5 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 6 | 7 | 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 8 | 9 | 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. 10 | 11 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Enclojure 2 | 3 | [![](https://github.com/temochka/enclojure/workflows/Test%20Suite/badge.svg)](https://github.com/temochka/enclojure/actions/workflows/tests.yml) 4 | 5 | Enclojure is a Clojure-like scripting language for Elm apps. Enclojure is experimental software and subject to breaking changes. 6 | 7 | * [Elm API](https://package.elm-lang.org/packages/temochka/enclojure/latest/) 8 | * [Enclojure API](./API.md) 9 | 10 | This is what an Enclojure script looks like: 11 | 12 | ```clojure 13 | (defn metal? 14 | [song-info] 15 | (let [{:keys [tags]} song-info] 16 | (some #(string/includes? (string/lower-case %) "metal") tags))) 17 | 18 | (->> [{:artist "Pallbearer" :title "I Saw The End" :tags #{"metal" "doom metal"}} 19 | {:artist "Baroness" :title "Tourniquet" :tags #{"metal" "hard-rock"}} 20 | {:artist "Jakob Bro" :title "Giant" :tags #{"jazz" "scandinavian jazz"}}] 21 | (filter metal?) 22 | count) 23 | ``` 24 | 25 | ## Feature highlights 26 | 27 | - ⭐️ **Clojure look'n'feel.** Supports familiar Clojure features: special form syntax, data literals, destructuring. Comes with a subset of functions from `clojure.core` and `clojure.string`. 28 | - ⭐️ **BYO side effects.** An Enclojure function can be configured to produce an arbitrary Elm command. This can be used to script the UI or send HTTP requests from scripts. 29 | - ⭐️ **Eval doesn’t block the render.** A computation budget can be dedicated to eval on every frame. This allows the app to put the interpreter on hold to handle other events or avoid deadlocks due to programming mistakes 30 | - ⭐️ **Synchronous execution model.** Similarly to JVM Clojure (and unlike JavaScript and ClojureScript), all side-effecting functions block the interpreter until the result is available, which leads to simpler programs. 31 | - ⭐️ **Written in pure Elm with minimal dependencies.** Can be installed as a package, integrates seamlessly into an existing Elm app. 32 | 33 | ## Differences from Clojure 34 | 35 | * Not lazy: all functions execute eagerly, “lazy” arities (e.g., `(range)`, `(repeat x)`) of core functions are not implemented. 36 | * No agents or refs: similarly to ClojureScript, only atoms and vars are supported. 37 | * No multimethods (yet?). 38 | * No syntax quote or user macros (yet?). 39 | * No `:or` when destructuring (yet?). 40 | * No namespaces or namespaced keywords. 41 | * No character value type: a single-char string is returned wherever Clojure would return a character. 42 | * No metadata. 43 | * No protocols, records, types. 44 | * No annotation syntax. 45 | * No reader tags. 46 | * No transducers. 47 | * No `catch`: to discourage exception-based control flow and treat exceptions as panic. 48 | * `loop` is a macro that expands to a recursive function call (any function can be recursive without overflowing the stack). 49 | * Only integers and floats are supported: ratios, big integers, long, etc. are out of scope. 50 | * Every `cond` is a `cond-let`. 51 | * No watch functions on atoms. 52 | * No array-map, sorted-map, sorted-set. 53 | -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "name": "temochka/enclojure", 4 | "summary": "A Clojure-like scripting language for Elm apps.", 5 | "license": "BSD-3-Clause", 6 | "version": "2.1.1", 7 | "exposed-modules": [ 8 | "Enclojure", 9 | "Enclojure.Callable", 10 | "Enclojure.Json", 11 | "Enclojure.Located", 12 | "Enclojure.Runtime", 13 | "Enclojure.Value", 14 | "Enclojure.ValueMap", 15 | "Enclojure.ValueKeyMap", 16 | "Enclojure.ValueSet" 17 | ], 18 | "elm-version": "0.19.1 <= v < 0.20.0", 19 | "dependencies": { 20 | "elm/core": "1.0.5 <= v < 2.0.0", 21 | "elm/json": "1.1.3 <= v < 2.0.0", 22 | "elm/parser": "1.1.0 <= v < 2.0.0", 23 | "elm/regex": "1.0.0 <= v < 2.0.0" 24 | }, 25 | "test-dependencies": { 26 | "elm-explorations/test": "1.2.2 <= v < 2.0.0" 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /examples/Docs.elm: -------------------------------------------------------------------------------- 1 | module Docs exposing (..) 2 | 3 | import Browser 4 | import Browser.Navigation 5 | import Element exposing (Element) 6 | import Element.Font 7 | import Element.Input 8 | import Element.Keyed 9 | import Enclojure 10 | import Enclojure.Value 11 | import File.Download 12 | import Html 13 | import Url exposing (Url) 14 | 15 | 16 | type Page 17 | = Docs 18 | | Repl 19 | | NotFound 20 | 21 | 22 | type alias DocsPage = 23 | { query : String 24 | , docs : List ( Enclojure.Doc, Enclojure.FnInfo ) 25 | , matchingDocs : List ( Enclojure.Doc, Enclojure.FnInfo ) 26 | } 27 | 28 | 29 | type ReplHistory 30 | = Input Int String 31 | | Output Int String 32 | 33 | 34 | type alias IO = 35 | () 36 | 37 | 38 | type Interpreter 39 | = Ready (Enclojure.Env IO) 40 | | Running 41 | 42 | 43 | type alias ReplPage = 44 | { code : String 45 | , history : List ReplHistory 46 | , interpreter : Interpreter 47 | } 48 | 49 | 50 | type alias Model = 51 | { navigationKey : Browser.Navigation.Key 52 | , docsPage : DocsPage 53 | , currentPage : Page 54 | } 55 | 56 | 57 | type DocsMessage 58 | = UpdateQuery String 59 | | Download 60 | 61 | 62 | type ReplMessage 63 | = UpdateCode String 64 | | Eval 65 | 66 | 67 | type Message 68 | = OnDocsPage DocsMessage 69 | | Nop 70 | | RequestUrl Browser.UrlRequest 71 | | RouteUrl Url 72 | 73 | 74 | init : () -> Url -> Browser.Navigation.Key -> ( Model, Cmd Message ) 75 | init _ currentUrl navigationKey = 76 | let 77 | docs = 78 | Enclojure.documentation Enclojure.init 79 | in 80 | ( { docsPage = { query = "", docs = docs, matchingDocs = docs } 81 | , navigationKey = navigationKey 82 | , currentPage = routeUrl currentUrl 83 | } 84 | , Cmd.none 85 | ) 86 | 87 | 88 | symbolInfo : ( Enclojure.Doc, Enclojure.FnInfo ) -> Maybe ( String, Element Message ) 89 | symbolInfo ( docType, { name, doc, signatures } ) = 90 | Maybe.map2 91 | (\n d -> 92 | ( n 93 | , Element.column 94 | [ Element.spacing 10 ] 95 | [ Element.paragraph [ Element.Font.size 22, Element.Font.semiBold ] [ Element.text n ] 96 | , (case docType of 97 | Enclojure.FunctionDoc -> 98 | "function" 99 | 100 | Enclojure.MacroDoc -> 101 | "macro" 102 | 103 | Enclojure.SpecialFormDoc -> 104 | "special form" 105 | ) 106 | |> Element.text 107 | , Element.row [ Element.spacing 10 ] 108 | [ Element.el [ Element.alignTop ] (Element.text "Usage:") 109 | , signatures 110 | |> List.map 111 | (\s -> 112 | Element.el 113 | [ Element.Font.family [ Element.Font.monospace ] ] 114 | (Element.text ("(" ++ String.join " " (n :: s) ++ ")")) 115 | ) 116 | |> Element.column [] 117 | ] 118 | , Element.paragraph [] [ Element.text d ] 119 | ] 120 | ) 121 | ) 122 | name 123 | doc 124 | 125 | 126 | symbolInfoMd : ( Enclojure.Doc, Enclojure.FnInfo ) -> Maybe String 127 | symbolInfoMd ( docType, { name, doc, signatures } ) = 128 | Maybe.map2 129 | (\n d -> 130 | [ "## " ++ n 131 | , case docType of 132 | Enclojure.FunctionDoc -> 133 | "`(function)`" 134 | 135 | Enclojure.MacroDoc -> 136 | "`(macro)`" 137 | 138 | Enclojure.SpecialFormDoc -> 139 | "`(special form)`" 140 | , [ "Usage:" 141 | , [ "```" 142 | , signatures 143 | |> List.map 144 | (\s -> 145 | "(" ++ String.join " " (n :: s) ++ ")" 146 | ) 147 | |> String.join "\n" 148 | , "```" 149 | ] 150 | |> String.join "\n" 151 | ] 152 | |> String.join "\n\n" 153 | , d 154 | ] 155 | |> String.join "\n\n" 156 | ) 157 | name 158 | doc 159 | 160 | 161 | viewDocs : DocsPage -> Element Message 162 | viewDocs model = 163 | Element.column 164 | [ Element.width Element.fill 165 | , Element.spacing 20 166 | ] 167 | [ Element.row 168 | [ Element.width Element.fill 169 | , Element.spacing 10 170 | ] 171 | [ Element.Input.button [] 172 | { onPress = Just (OnDocsPage Download) 173 | , label = Element.text "Download as Markdown" 174 | } 175 | , Element.Input.text 176 | [ Element.width Element.fill ] 177 | { onChange = UpdateQuery >> OnDocsPage 178 | , text = model.query 179 | , placeholder = Just (Element.Input.placeholder [] (Element.text "Filter docs...")) 180 | , label = Element.Input.labelHidden "Search docs" 181 | } 182 | ] 183 | , Element.Keyed.column [ Element.width Element.fill, Element.spacing 20 ] <| 184 | List.filterMap symbolInfo model.matchingDocs 185 | ] 186 | 187 | 188 | view : Model -> Browser.Document Message 189 | view model = 190 | { title = "Enclojure" 191 | , body = 192 | [ Element.column 193 | [ Element.padding 20 194 | , Element.spacing 25 195 | , Element.width Element.fill 196 | ] 197 | [ Element.row [ Element.spacing 25, Element.width Element.fill ] 198 | [ Element.el [ Element.Font.size 25, Element.Font.semiBold ] (Element.text "Enclojure API") 199 | , Element.link [] { url = "/docs", label = Element.text "Docs" } 200 | , Element.link [] { url = "/repl", label = Element.text "REPL" } 201 | , Element.link [] { url = "https://github.com/temochka/enclojure", label = Element.text "GitHub" } 202 | ] 203 | , case model.currentPage of 204 | Docs -> 205 | viewDocs model.docsPage 206 | 207 | Repl -> 208 | Element.none 209 | 210 | NotFound -> 211 | Element.el 212 | [ Element.width Element.fill, Element.height Element.fill ] 213 | (Element.column [ Element.centerX, Element.centerY ] 214 | [ Element.text "Page Not Found" 215 | , Element.link [] { url = "/docs", label = Element.text "Return to Docs" } 216 | ] 217 | ) 218 | ] 219 | |> Element.layout [] 220 | ] 221 | } 222 | 223 | 224 | matchDocs : String -> List ( Enclojure.Doc, Enclojure.FnInfo ) -> List ( Enclojure.Doc, Enclojure.FnInfo ) 225 | matchDocs query = 226 | List.filter 227 | (\( _, { name } ) -> 228 | case name of 229 | Just n -> 230 | n |> String.toLower |> String.contains query 231 | 232 | Nothing -> 233 | False 234 | ) 235 | 236 | 237 | updateDocs : DocsMessage -> DocsPage -> ( DocsPage, Cmd Message ) 238 | updateDocs msg model = 239 | case msg of 240 | UpdateQuery query -> 241 | ( { model 242 | | query = query 243 | , matchingDocs = matchDocs query model.docs 244 | } 245 | , Cmd.none 246 | ) 247 | 248 | Download -> 249 | let 250 | markdown = 251 | "# Enclojure API\n\n" ++ (model.docs |> List.filterMap symbolInfoMd |> String.join "\n\n") 252 | in 253 | ( model 254 | , File.Download.string "API.md" "text/markdown" markdown 255 | ) 256 | 257 | 258 | updateRepl : ReplMessage -> ReplPage -> ( ReplPage, Cmd Message ) 259 | updateRepl msg model = 260 | case msg of 261 | UpdateCode code -> 262 | ( { model | code = code }, Cmd.none ) 263 | 264 | Eval -> 265 | ( model, Cmd.none ) 266 | 267 | 268 | routeUrl : Url -> Page 269 | routeUrl url = 270 | case url.path of 271 | "/docs" -> 272 | Docs 273 | 274 | "/repl" -> 275 | Repl 276 | 277 | _ -> 278 | NotFound 279 | 280 | 281 | update : Message -> Model -> ( Model, Cmd Message ) 282 | update msg model = 283 | case msg of 284 | RequestUrl urlRequest -> 285 | case urlRequest of 286 | Browser.Internal url -> 287 | ( model 288 | , Browser.Navigation.pushUrl model.navigationKey (Url.toString url) 289 | ) 290 | 291 | Browser.External url -> 292 | ( model 293 | , Browser.Navigation.load url 294 | ) 295 | 296 | RouteUrl url -> 297 | ( { model | currentPage = routeUrl url }, Cmd.none ) 298 | 299 | OnDocsPage docsMessage -> 300 | updateDocs docsMessage model.docsPage 301 | |> Tuple.mapFirst (\m -> { model | docsPage = m }) 302 | 303 | Nop -> 304 | ( model, Cmd.none ) 305 | 306 | 307 | main : Program () Model Message 308 | main = 309 | Browser.application 310 | { init = init 311 | , subscriptions = always Sub.none 312 | , view = view 313 | , update = update 314 | , onUrlRequest = RequestUrl 315 | , onUrlChange = RouteUrl 316 | } 317 | -------------------------------------------------------------------------------- /examples/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | ".", 5 | "../src" 6 | ], 7 | "elm-version": "0.19.1", 8 | "dependencies": { 9 | "direct": { 10 | "elm/browser": "1.0.2", 11 | "elm/core": "1.0.5", 12 | "elm/file": "1.0.5", 13 | "elm/html": "1.0.0", 14 | "elm/json": "1.1.3", 15 | "elm/parser": "1.1.0", 16 | "elm/regex": "1.0.0", 17 | "elm/url": "1.0.0", 18 | "mdgriffith/elm-ui": "1.1.8" 19 | }, 20 | "indirect": { 21 | "elm/bytes": "1.0.8", 22 | "elm/time": "1.0.0", 23 | "elm/virtual-dom": "1.0.3" 24 | } 25 | }, 26 | "test-dependencies": { 27 | "direct": {}, 28 | "indirect": {} 29 | } 30 | } 31 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "enclojure-testing", 3 | "version": "1.0.0", 4 | "description": "Enclojure test suite", 5 | "main": "index.js", 6 | "directories": { 7 | "example": "examples", 8 | "test": "tests" 9 | }, 10 | "scripts": { 11 | "test": "elm-test" 12 | }, 13 | "repository": { 14 | "type": "git", 15 | "url": "git+https://github.com/temochka/enclojure.git" 16 | }, 17 | "author": "Artem Chistyakov", 18 | "license": "BSD-3-Clause", 19 | "bugs": { 20 | "url": "https://github.com/temochka/enclojure/issues" 21 | }, 22 | "homepage": "https://github.com/temochka/enclojure#readme", 23 | "dependencies": { 24 | "elm": "^0.19.1-5", 25 | "elm-test": "^0.19.1-revision7" 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /src/Enclojure/Callable.elm: -------------------------------------------------------------------------------- 1 | module Enclojure.Callable exposing 2 | ( Callable, new 3 | , fixedArity, variadicArity, toArityFunction, setArity0, setArity1, setArity2, setArity3 4 | , signatures 5 | , setDoc 6 | ) 7 | 8 | {-| Helper functions for defining Enclojure callables. 9 | 10 | 11 | # Getting started 12 | 13 | @docs Callable, new 14 | 15 | 16 | # Fleshing out your callable 17 | 18 | Unlike Elm, one Enclojure function can have more than one "arity": the number of arguments it accepts. Arities can be 19 | fixed (positional arguments only) or variadic (some or no positional arguments + a list of remaining arguments). 20 | 21 | @docs fixedArity, variadicArity, toArityFunction, setArity0, setArity1, setArity2, setArity3 22 | 23 | 24 | # Misc 25 | 26 | @docs signatures 27 | 28 | -} 29 | 30 | import Enclojure.Common exposing (Arity(..), Continuation, Env, Exception(..), IO, Step, Thunk(..), Value(..)) 31 | import Enclojure.Located exposing (Located(..)) 32 | import Enclojure.Value exposing (inspect) 33 | 34 | 35 | {-| Represents a callable (anonymous function). 36 | -} 37 | type alias Callable io = 38 | Enclojure.Common.Callable io 39 | 40 | 41 | {-| Creates a new empty callable. 42 | -} 43 | new : Callable io 44 | new = 45 | { doc = Nothing 46 | , arity0 = Nothing 47 | , arity1 = Nothing 48 | , arity2 = Nothing 49 | , arity3 = Nothing 50 | } 51 | 52 | 53 | {-| Overwrite the doc on a callable. 54 | -} 55 | setDoc : Maybe String -> Callable io -> Callable io 56 | setDoc doc callable = 57 | { callable | doc = doc } 58 | 59 | 60 | {-| Converts a simplified arity to full arity. 61 | 62 | Most Enclojure callables don’t need to modify the environment or to access the continuation. 63 | Thus, it's easier to define them as functions of `a -> Result Exception (IO io)`. 64 | 65 | -} 66 | toArityFunction : (a -> Result Exception (IO io)) -> (a -> Env io -> Continuation io -> Step io) 67 | toArityFunction fn = 68 | \v env k -> 69 | ( fn v 70 | |> Result.map (\io -> ( io, env )) 71 | |> Result.mapError (\(Exception msg _) -> ( Exception msg env.stack, env )) 72 | , Just (Thunk k) 73 | ) 74 | 75 | 76 | {-| Overwrite the arity 0 (no positional arguments) on a callable. 77 | -} 78 | setArity0 : Enclojure.Common.Arity io () -> Callable io -> Callable io 79 | setArity0 arity callable = 80 | { callable | arity0 = Just arity } 81 | 82 | 83 | {-| Overwrite the arity 1 (one positional argument) on a callable 84 | -} 85 | setArity1 : Enclojure.Common.Arity io (Value io) -> Callable io -> Callable io 86 | setArity1 arity callable = 87 | { callable | arity1 = Just arity } 88 | 89 | 90 | {-| Overwrite the arity 2 (two positional arguments) on a callable 91 | -} 92 | setArity2 : Enclojure.Common.Arity io ( Value io, Value io ) -> Callable io -> Callable io 93 | setArity2 arity callable = 94 | { callable | arity2 = Just arity } 95 | 96 | 97 | {-| Overwrite the arity 3 (three positional arguments) on a callable 98 | -} 99 | setArity3 : Enclojure.Common.Arity io ( Value io, Value io, Value io ) -> Callable io -> Callable io 100 | setArity3 arity callable = 101 | { callable | arity3 = Just arity } 102 | 103 | 104 | {-| Build an arity that accepts positional args `a` and doesn’t accept any varargs. 105 | -} 106 | fixedArity : a -> (a -> Result Exception (IO io)) -> Enclojure.Common.Arity io a 107 | fixedArity signature fn = 108 | Enclojure.Common.Fixed signature <| toArityFunction fn 109 | 110 | 111 | {-| Build an arity that accepts positional args `a` and varargs. 112 | -} 113 | variadicArity : { argNames : a, restArgName : Value io } -> ({ args : a, rest : List (Value io) } -> Result Exception (IO io)) -> Enclojure.Common.Arity io a 114 | variadicArity signature fn = 115 | Enclojure.Common.Variadic signature <| toArityFunction fn 116 | 117 | 118 | {-| Returns the list of signatures of a given callable. 119 | -} 120 | signatures : Callable io -> List (List String) 121 | signatures callable = 122 | [ callable.arity0 |> Maybe.map (always []) 123 | , callable.arity1 124 | |> Maybe.map 125 | (\arity -> 126 | case arity of 127 | Fixed v _ -> 128 | [ inspect v ] 129 | 130 | Variadic { argNames, restArgName } _ -> 131 | [ inspect argNames, "&", inspect restArgName ] 132 | ) 133 | , callable.arity2 134 | |> Maybe.map 135 | (\arity -> 136 | case arity of 137 | Fixed ( a, b ) _ -> 138 | [ inspect a, inspect b ] 139 | 140 | Variadic { argNames, restArgName } _ -> 141 | let 142 | ( a, b ) = 143 | argNames 144 | in 145 | [ inspect a, inspect b, "& " ++ inspect restArgName ] 146 | ) 147 | , callable.arity3 148 | |> Maybe.map 149 | (\arity -> 150 | case arity of 151 | Fixed ( a, b, c ) _ -> 152 | [ inspect a, inspect b, inspect c ] 153 | 154 | Variadic { argNames, restArgName } _ -> 155 | let 156 | ( a, b, c ) = 157 | argNames 158 | in 159 | [ inspect a, inspect b, inspect c, "&", inspect restArgName ] 160 | ) 161 | ] 162 | |> List.filterMap identity 163 | -------------------------------------------------------------------------------- /src/Enclojure/Common.elm: -------------------------------------------------------------------------------- 1 | module Enclojure.Common exposing 2 | ( Arity(..) 3 | , Callable 4 | , Continuation 5 | , Env 6 | , Exception(..) 7 | , FnInfo 8 | , IO(..) 9 | , Number(..) 10 | , Ref(..) 11 | , StackFrame 12 | , Step 13 | , Thunk(..) 14 | , Value(..) 15 | , ValueMap(..) 16 | , ValueMapEntry 17 | , ValueSet(..) 18 | , areEqualValues 19 | , linearFind 20 | , toThunk 21 | ) 22 | 23 | import Array exposing (Array) 24 | import Dict exposing (Dict) 25 | import Enclojure.Extra.Maybe 26 | import Enclojure.Located as Located exposing (Located(..)) 27 | import Regex exposing (Regex) 28 | import Set 29 | 30 | 31 | type Exception 32 | = Exception String (List StackFrame) 33 | 34 | 35 | type alias Step io = 36 | ( Result ( Exception, Env io ) ( IO io, Env io ), Maybe (Thunk io) ) 37 | 38 | 39 | type alias Continuation io = 40 | Located (Value io) -> Env io -> Located (Step io) 41 | 42 | 43 | type Thunk io 44 | = Thunk (Continuation io) 45 | 46 | 47 | type Arity io a 48 | = Fixed a (a -> Env io -> Continuation io -> ( Result ( Exception, Env io ) ( IO io, Env io ), Maybe (Thunk io) )) 49 | | Variadic { argNames : a, restArgName : Value io } ({ args : a, rest : List (Value io) } -> Env io -> Continuation io -> ( Result ( Exception, Env io ) ( IO io, Env io ), Maybe (Thunk io) )) 50 | 51 | 52 | type IO io 53 | = Const (Value io) 54 | | SideEffect io 55 | 56 | 57 | type alias Callable io = 58 | { doc : Maybe String 59 | , arity0 : Maybe (Arity io ()) 60 | , arity1 : Maybe (Arity io (Value io)) 61 | , arity2 : Maybe (Arity io ( Value io, Value io )) 62 | , arity3 : Maybe (Arity io ( Value io, Value io, Value io )) 63 | } 64 | 65 | 66 | type alias ValueMapEntry io v = 67 | ( Value io, v ) 68 | 69 | 70 | type ValueMap io v 71 | = ValueMap 72 | { ints : Dict Int v 73 | , floats : Dict Float v 74 | , strings : Dict String v 75 | , keywords : Dict String v 76 | , symbols : Dict String v 77 | , nil : Maybe v 78 | , true : Maybe v 79 | , false : Maybe v 80 | , otherValues : List ( Value io, v ) 81 | } 82 | 83 | 84 | type ValueSet io 85 | = ValueSet 86 | { ints : Set.Set Int 87 | , floats : Set.Set Float 88 | , strings : Set.Set String 89 | , nil : Bool 90 | , true : Bool 91 | , false : Bool 92 | , keywords : Set.Set String 93 | , symbols : Set.Set String 94 | , otherValues : List (Value io) 95 | } 96 | 97 | 98 | type Number 99 | = Float Float 100 | | Int Int 101 | 102 | 103 | type Ref io 104 | = Var String (Value io) 105 | | Atom Int 106 | 107 | 108 | type alias FnInfo = 109 | { name : Maybe String 110 | , doc : Maybe String 111 | , signatures : List (List String) 112 | } 113 | 114 | 115 | type Value io 116 | = Number Number 117 | | String String 118 | | Ref (Ref io) 119 | | Fn FnInfo ({ self : Value io, k : Continuation io } -> Thunk io) 120 | | List (List (Located (Value io))) 121 | | Vector (Array (Located (Value io))) 122 | | Nil 123 | | Bool Basics.Bool 124 | | Keyword String 125 | | Map (ValueMap io (Located (Value io))) 126 | | MapEntry (ValueMapEntry io (Located (Value io))) 127 | | Regex String Regex 128 | | Set (ValueSet io) 129 | | Symbol String 130 | | Throwable Exception 131 | 132 | 133 | type alias StackFrame = 134 | { name : String 135 | , location : Located.Location 136 | } 137 | 138 | 139 | type alias Env io = 140 | { globalScope : Dict String (Value io) 141 | , lexicalScope : Dict String (Value io) 142 | , atoms : Dict Int (Value io) 143 | , stack : List StackFrame 144 | , atomIdGenerator : Int 145 | } 146 | 147 | 148 | areEqualLists : List (Value io) -> List (Value io) -> Bool 149 | areEqualLists listA listB = 150 | case ( listA, listB ) of 151 | ( headA :: restA, headB :: restB ) -> 152 | if areEqualValues headA headB then 153 | areEqualLists restA restB 154 | 155 | else 156 | False 157 | 158 | ( [], [] ) -> 159 | True 160 | 161 | _ -> 162 | False 163 | 164 | 165 | areEqualLocatedLists : List (Located (Value io)) -> List (Located (Value io)) -> Bool 166 | areEqualLocatedLists listA listB = 167 | case ( listA, listB ) of 168 | ( (Located _ headA) :: restA, (Located _ headB) :: restB ) -> 169 | if areEqualValues headA headB then 170 | areEqualLocatedLists restA restB 171 | 172 | else 173 | False 174 | 175 | ( [], [] ) -> 176 | True 177 | 178 | _ -> 179 | False 180 | 181 | 182 | areEqualDictEntries : (key -> Value io) -> List ( key, Located (Value io) ) -> List ( key, Located (Value io) ) -> Bool 183 | areEqualDictEntries f a b = 184 | case ( a, b ) of 185 | ( ( keyA, Located _ valA ) :: restA, ( keyB, Located _ valB ) :: restB ) -> 186 | if areEqualValues (f keyA) (f keyB) && areEqualValues valA valB then 187 | areEqualDictEntries f restA restB 188 | 189 | else 190 | False 191 | 192 | ( [], [] ) -> 193 | True 194 | 195 | _ -> 196 | False 197 | 198 | 199 | areEqualMaps : ValueMap io (Located (Value io)) -> ValueMap io (Located (Value io)) -> Bool 200 | areEqualMaps (ValueMap a) (ValueMap b) = 201 | a 202 | == b 203 | || (areEqualDictEntries (Int >> Number) (Dict.toList a.ints) (Dict.toList b.ints) 204 | && areEqualDictEntries (Float >> Number) (Dict.toList a.floats) (Dict.toList b.floats) 205 | && areEqualDictEntries String (Dict.toList a.strings) (Dict.toList b.strings) 206 | && areEqualDictEntries String (Dict.toList a.keywords) (Dict.toList b.keywords) 207 | && areEqualDictEntries String (Dict.toList a.symbols) (Dict.toList b.symbols) 208 | && (a.nil == b.nil || (Maybe.map2 areEqualValues (a.nil |> Maybe.map Located.getValue) (b.nil |> Maybe.map Located.getValue) |> Maybe.withDefault False)) 209 | && (a.true == b.true || (Maybe.map2 areEqualValues (a.true |> Maybe.map Located.getValue) (b.true |> Maybe.map Located.getValue) |> Maybe.withDefault False)) 210 | && (a.false == b.false || (Maybe.map2 areEqualValues (a.false |> Maybe.map Located.getValue) (b.false |> Maybe.map Located.getValue) |> Maybe.withDefault False)) 211 | && areEqualDictEntries identity a.otherValues b.otherValues 212 | ) 213 | 214 | 215 | areEqualSets : ValueSet io -> ValueSet io -> Bool 216 | areEqualSets (ValueSet a) (ValueSet b) = 217 | a 218 | == b 219 | || (a.ints 220 | == b.ints 221 | && a.floats 222 | == b.floats 223 | && a.strings 224 | == b.strings 225 | && a.nil 226 | == b.nil 227 | && a.true 228 | == b.true 229 | && a.false 230 | == b.false 231 | && a.keywords 232 | == b.keywords 233 | && a.symbols 234 | == b.symbols 235 | && areEqualLists a.otherValues b.otherValues 236 | ) 237 | 238 | 239 | areEqualValues : Value io -> Value io -> Bool 240 | areEqualValues a b = 241 | if a == b then 242 | -- referential equality 243 | True 244 | 245 | else 246 | -- different metadata 247 | case ( a, b ) of 248 | ( List listA, List listB ) -> 249 | areEqualLocatedLists listA listB 250 | 251 | ( MapEntry ( keyA, Located _ valA ), Vector vB ) -> 252 | case Array.toList vB of 253 | [ Located _ keyB, Located _ valB ] -> 254 | areEqualValues keyA keyB && areEqualValues valA valB 255 | 256 | _ -> 257 | False 258 | 259 | ( Vector _, MapEntry _ ) -> 260 | areEqualValues b a 261 | 262 | ( MapEntry ( keyA, Located _ valA ), MapEntry ( keyB, Located _ valB ) ) -> 263 | areEqualValues keyA keyB && areEqualValues valA valB 264 | 265 | ( Vector vectorA, Vector vectorB ) -> 266 | areEqualLocatedLists (Array.toList vectorA) (Array.toList vectorB) 267 | 268 | ( Vector vectorA, List listB ) -> 269 | areEqualLocatedLists (Array.toList vectorA) listB 270 | 271 | ( List listA, Vector vectorB ) -> 272 | areEqualLocatedLists listA (Array.toList vectorB) 273 | 274 | ( Map mapA, Map mapB ) -> 275 | areEqualMaps mapA mapB 276 | 277 | ( Set setA, Set setB ) -> 278 | areEqualSets setA setB 279 | 280 | _ -> 281 | False 282 | 283 | 284 | linearFind : (a -> Bool) -> List a -> Maybe a 285 | linearFind f l = 286 | case l of 287 | [] -> 288 | Nothing 289 | 290 | a :: rest -> 291 | if f a then 292 | Just a 293 | 294 | else 295 | linearFind f rest 296 | 297 | 298 | extractVariadic : Maybe (Arity io a) -> Maybe ({ args : a, rest : List (Value io) } -> Env io -> Continuation io -> Step io) 299 | extractVariadic arity = 300 | arity 301 | |> Maybe.andThen 302 | (\a -> 303 | case a of 304 | Fixed _ _ -> 305 | Nothing 306 | 307 | Variadic _ fn -> 308 | Just fn 309 | ) 310 | 311 | 312 | dispatch : Callable io -> List (Value io) -> Env io -> Continuation io -> Step io 313 | dispatch callable args env k = 314 | case args of 315 | [] -> 316 | callable.arity0 317 | |> Maybe.map 318 | (\arity0 -> 319 | case arity0 of 320 | Fixed _ fn -> 321 | fn () env k 322 | 323 | Variadic _ fn -> 324 | fn { args = (), rest = [] } env k 325 | ) 326 | |> Maybe.withDefault ( Err ( Exception "Invalid arity 0" env.stack, env ), Just (Thunk k) ) 327 | 328 | [ a0 ] -> 329 | extractVariadic callable.arity0 330 | |> Maybe.map (\fn -> fn { args = (), rest = args } env k) 331 | |> Enclojure.Extra.Maybe.orElse 332 | (\_ -> 333 | callable.arity1 334 | |> Maybe.map 335 | (\arity1 -> 336 | case arity1 of 337 | Fixed _ fn -> 338 | fn a0 env k 339 | 340 | Variadic _ fn -> 341 | fn { args = a0, rest = [] } env k 342 | ) 343 | ) 344 | |> Maybe.withDefault ( Err ( Exception "Invalid arity 1" env.stack, env ), Just (Thunk k) ) 345 | 346 | [ a0, a1 ] -> 347 | extractVariadic callable.arity0 348 | |> Maybe.map (\fn -> fn { args = (), rest = args } env k) 349 | |> Enclojure.Extra.Maybe.orElse 350 | (\_ -> 351 | extractVariadic callable.arity1 352 | |> Maybe.map (\fn -> fn { args = a0, rest = [ a1 ] } env k) 353 | ) 354 | |> Enclojure.Extra.Maybe.orElse 355 | (\_ -> 356 | callable.arity2 357 | |> Maybe.map 358 | (\arity2 -> 359 | case arity2 of 360 | Fixed _ fn -> 361 | fn ( a0, a1 ) env k 362 | 363 | Variadic _ fn -> 364 | fn { args = ( a0, a1 ), rest = [] } env k 365 | ) 366 | ) 367 | |> Maybe.withDefault ( Err ( Exception "Invalid arity 2" env.stack, env ), Just (Thunk k) ) 368 | 369 | [ a0, a1, a2 ] -> 370 | extractVariadic callable.arity0 371 | |> Maybe.map (\fn -> fn { args = (), rest = args } env k) 372 | |> Enclojure.Extra.Maybe.orElse 373 | (\_ -> 374 | extractVariadic callable.arity1 375 | |> Maybe.map (\fn -> fn { args = a0, rest = [ a1, a2 ] } env k) 376 | ) 377 | |> Enclojure.Extra.Maybe.orElse 378 | (\_ -> 379 | extractVariadic callable.arity2 380 | |> Maybe.map (\fn -> fn { args = ( a0, a1 ), rest = [ a2 ] } env k) 381 | ) 382 | |> Enclojure.Extra.Maybe.orElse 383 | (\_ -> 384 | callable.arity3 385 | |> Maybe.map 386 | (\arity3 -> 387 | case arity3 of 388 | Fixed _ fn -> 389 | fn ( a0, a1, a2 ) env k 390 | 391 | Variadic _ fn -> 392 | fn { args = ( a0, a1, a2 ), rest = [] } env k 393 | ) 394 | ) 395 | |> Maybe.withDefault ( Err ( Exception "Invalid arity 3" env.stack, env ), Just (Thunk k) ) 396 | 397 | a0 :: a1 :: a2 :: rest -> 398 | extractVariadic callable.arity0 399 | |> Maybe.map (\fn -> fn { args = (), rest = args } env k) 400 | |> Enclojure.Extra.Maybe.orElse 401 | (\_ -> 402 | extractVariadic callable.arity1 403 | |> Maybe.map (\fn -> fn { args = a0, rest = a1 :: a2 :: rest } env k) 404 | ) 405 | |> Enclojure.Extra.Maybe.orElse 406 | (\_ -> 407 | extractVariadic callable.arity2 408 | |> Maybe.map (\fn -> fn { args = ( a0, a1 ), rest = a2 :: rest } env k) 409 | ) 410 | |> Enclojure.Extra.Maybe.orElse 411 | (\_ -> 412 | extractVariadic callable.arity3 413 | |> Maybe.map (\fn -> fn { args = ( a0, a1, a2 ), rest = rest } env k) 414 | ) 415 | |> Maybe.withDefault 416 | ( Err 417 | ( Exception ("Invalid arity " ++ String.fromInt (List.length args)) env.stack 418 | , env 419 | ) 420 | , Nothing 421 | ) 422 | 423 | 424 | toThunk : Callable io -> { self : Value io, k : Continuation io } -> Thunk io 425 | toThunk callable { k } = 426 | Thunk 427 | (\(Located pos arg) env -> 428 | case arg of 429 | List args -> 430 | dispatch callable (List.map Located.getValue args) env k 431 | |> Located pos 432 | 433 | _ -> 434 | Located pos ( Err ( Exception "Foo" env.stack, env ), Nothing ) 435 | ) 436 | -------------------------------------------------------------------------------- /src/Enclojure/Extra/Maybe.elm: -------------------------------------------------------------------------------- 1 | module Enclojure.Extra.Maybe exposing (orElse) 2 | 3 | 4 | orElse : (() -> Maybe a) -> Maybe a -> Maybe a 5 | orElse b a = 6 | case a of 7 | Just _ -> 8 | a 9 | 10 | Nothing -> 11 | b () 12 | -------------------------------------------------------------------------------- /src/Enclojure/Json.elm: -------------------------------------------------------------------------------- 1 | module Enclojure.Json exposing 2 | ( decodeFromString, encodeToString 3 | , decodeValue, encodeValue 4 | ) 5 | 6 | {-| Utilities for converting between JSON and Enclojure values. 7 | 8 | 9 | # Working with JSON strings 10 | 11 | @docs decodeFromString, encodeToString 12 | 13 | 14 | # Working with JSON values 15 | 16 | @docs decodeValue, encodeValue 17 | 18 | -} 19 | 20 | import Array 21 | import Dict exposing (Dict) 22 | import Enclojure.Common exposing (Exception(..), Number(..), Ref(..), Value(..)) 23 | import Enclojure.Located as Located exposing (Located(..)) 24 | import Enclojure.ValueMap as ValueMap exposing (ValueMap) 25 | import Enclojure.ValueSet as ValueSet 26 | import Json.Decode 27 | import Json.Encode 28 | 29 | 30 | {-| A JSON decoder for Enclojure values. 31 | -} 32 | decodeValue : Json.Decode.Decoder (Value io) 33 | decodeValue = 34 | Json.Decode.oneOf 35 | [ Json.Decode.string |> Json.Decode.map String 36 | , Json.Decode.bool |> Json.Decode.map Bool 37 | , Json.Decode.int |> Json.Decode.map (Int >> Number) 38 | , Json.Decode.float |> Json.Decode.map (Float >> Number) 39 | , Json.Decode.null Nil 40 | , Json.Decode.array (Json.Decode.lazy (\_ -> decodeValue)) |> Json.Decode.map (Array.map Located.unknown >> Vector) 41 | , Json.Decode.dict (Json.Decode.lazy (\_ -> decodeValue)) 42 | |> Json.Decode.map 43 | (Dict.toList 44 | >> List.map (\( k, v ) -> ( String k, Located.unknown v )) 45 | >> ValueMap.fromList 46 | >> Map 47 | ) 48 | ] 49 | 50 | 51 | {-| Accepts a JSON string. Returns the result of parsing this string as an Enclojure value. 52 | -} 53 | decodeFromString : String -> Result Exception (Value io) 54 | decodeFromString json = 55 | Json.Decode.decodeString decodeValue json 56 | |> Result.mapError 57 | (Json.Decode.errorToString 58 | >> String.append "JSON parsing error: " 59 | >> (\msg -> Exception msg []) 60 | ) 61 | 62 | 63 | toDict : ValueMap io -> Dict String Json.Encode.Value 64 | toDict map = 65 | map 66 | |> ValueMap.toList 67 | |> List.filterMap 68 | (\( k, Located _ v ) -> 69 | (case k of 70 | String s -> 71 | Just s 72 | 73 | Keyword s -> 74 | Just s 75 | 76 | _ -> 77 | Nothing 78 | ) 79 | |> Maybe.map (\stringKey -> ( stringKey, encodeValue v )) 80 | ) 81 | |> Dict.fromList 82 | 83 | 84 | {-| A JSON encoder for Enclojure values. 85 | -} 86 | encodeValue : Value io -> Json.Encode.Value 87 | encodeValue val = 88 | case val of 89 | Number n -> 90 | case n of 91 | Int i -> 92 | Json.Encode.int i 93 | 94 | Float f -> 95 | Json.Encode.float f 96 | 97 | String s -> 98 | Json.Encode.string s 99 | 100 | Ref ref -> 101 | case ref of 102 | Var n _ -> 103 | Json.Encode.string ("#'" ++ n) 104 | 105 | Atom _ -> 106 | Json.Encode.string "" 107 | 108 | Fn _ _ -> 109 | Json.Encode.null 110 | 111 | List l -> 112 | Json.Encode.list encodeValue (List.map Located.getValue l) 113 | 114 | Vector a -> 115 | Json.Encode.array encodeValue (Array.map Located.getValue a) 116 | 117 | Nil -> 118 | Json.Encode.null 119 | 120 | Bool b -> 121 | Json.Encode.bool b 122 | 123 | Keyword s -> 124 | Json.Encode.string s 125 | 126 | Map vm -> 127 | Json.Encode.dict identity identity (toDict vm) 128 | 129 | MapEntry ( k, Located _ v ) -> 130 | Json.Encode.list encodeValue [ k, v ] 131 | 132 | Regex s _ -> 133 | Json.Encode.string s 134 | 135 | Set vs -> 136 | Json.Encode.list encodeValue (ValueSet.toList vs) 137 | 138 | Symbol s -> 139 | Json.Encode.string s 140 | 141 | Throwable _ -> 142 | Json.Encode.null 143 | 144 | 145 | {-| Accepts an Enclojure value, returns its JSON representation as a string. 146 | -} 147 | encodeToString : Value io -> String 148 | encodeToString val = 149 | Json.Encode.encode 0 (encodeValue val) 150 | -------------------------------------------------------------------------------- /src/Enclojure/Lib/String.elm: -------------------------------------------------------------------------------- 1 | module Enclojure.Lib.String exposing (init) 2 | 3 | import Enclojure.Callable as Callable 4 | import Enclojure.Common as Common exposing (Arity(..), Callable, Exception(..), IO(..), Value(..)) 5 | import Enclojure.Located as Located 6 | import Enclojure.Runtime as Runtime 7 | import Enclojure.Value as Value exposing (inspect) 8 | import Regex 9 | 10 | 11 | emptyCallable : Callable io 12 | emptyCallable = 13 | Callable.new 14 | 15 | 16 | init : Common.Env io -> Common.Env io 17 | init env = 18 | [ ( "string/blank?", isBlank ) 19 | , ( "string/capitalize", capitalize ) 20 | , ( "string/ends-with?", endsWith ) 21 | , ( "string/includes?", includes ) 22 | , ( "string/index-of", indexOf ) 23 | , ( "string/join", join ) 24 | , ( "string/last-index-of", lastIndexOf ) 25 | , ( "string/length", length ) 26 | , ( "string/lower-case", lowerCase ) 27 | , ( "string/replace", replace ) 28 | , ( "string/replace-first", replaceFirst ) 29 | , ( "string/reverse", reverse ) 30 | , ( "string/split-lines", splitLines ) 31 | , ( "string/split", split ) 32 | , ( "string/starts-with?", startsWith ) 33 | , ( "string/trim", trim ) 34 | , ( "string/triml", triml ) 35 | , ( "string/trimr", trimr ) 36 | , ( "string/upper-case", upperCase ) 37 | ] 38 | |> List.foldl 39 | (\( name, fn ) -> 40 | Runtime.bindGlobal name (Fn { name = Just name, doc = Nothing, signatures = Callable.signatures fn } (Common.toThunk fn)) 41 | ) 42 | env 43 | 44 | 45 | splitLines : Common.Callable io 46 | splitLines = 47 | let 48 | arity1 val = 49 | case val of 50 | String s -> 51 | String.lines s 52 | |> List.map (String >> Located.unknown) 53 | |> Common.List 54 | |> Ok 55 | 56 | _ -> 57 | Err (Exception ("type error: expected string, got " ++ inspect val) []) 58 | in 59 | { emptyCallable 60 | | arity1 = Just <| Fixed (Symbol "s") <| Callable.toArityFunction (arity1 >> Result.map Const) 61 | , doc = Just "Splits s on \\n or \\r\\n. Trailing empty lines are not returned." 62 | } 63 | 64 | 65 | length : Common.Callable io 66 | length = 67 | let 68 | arity1 val = 69 | Value.tryString val 70 | |> Maybe.map (String.length >> Common.Int >> Common.Number >> Ok) 71 | |> Maybe.withDefault (Err (Exception ("type error: expected string, got " ++ inspect val) [])) 72 | in 73 | { emptyCallable 74 | | arity1 = Just <| Fixed (Symbol "s") <| Callable.toArityFunction (arity1 >> Result.map Const) 75 | , doc = Just "Returns the length of string s." 76 | } 77 | 78 | 79 | join : Common.Callable io 80 | join = 81 | let 82 | arity1 val = 83 | val 84 | |> Value.trySequenceOf (Value.toString >> Just) 85 | |> Maybe.map (String.join "" >> Common.String >> Ok) 86 | |> Maybe.withDefault (Err (Exception ("type error: expected a sequence, got " ++ inspect val) [])) 87 | 88 | arity2 ( sepVal, collVal ) = 89 | Maybe.map2 (\sep coll -> String.join sep coll |> Common.String |> Ok) 90 | (Value.tryString sepVal) 91 | (Value.trySequenceOf (Value.toString >> Just) collVal) 92 | |> Maybe.withDefault (Err (Exception "type error: expected a separator and a sequence of strings" [])) 93 | in 94 | { emptyCallable 95 | | arity1 = Just <| Fixed (Symbol "coll") <| Callable.toArityFunction (arity1 >> Result.map Const) 96 | , arity2 = Just <| Fixed ( Symbol "sep", Symbol "coll" ) <| Callable.toArityFunction (arity2 >> Result.map Const) 97 | , doc = Just "Returns a string of all elements in coll, as returned by (seq coll), separated by an optional separator." 98 | } 99 | 100 | 101 | isBlank : Common.Callable io 102 | isBlank = 103 | let 104 | arity1 sVal = 105 | case sVal of 106 | String s -> 107 | s |> String.trim |> String.isEmpty |> Bool |> Const |> Ok 108 | 109 | Nil -> 110 | Ok <| Const <| Bool True 111 | 112 | _ -> 113 | Err (Value.exception "type error: blank? expects a string or nil") 114 | in 115 | { emptyCallable 116 | | arity1 = Just <| Fixed (Symbol "s") <| Callable.toArityFunction arity1 117 | , doc = Just "True if s is nil, empty, or contains only whitespace." 118 | } 119 | 120 | 121 | capitalize : Common.Callable io 122 | capitalize = 123 | let 124 | arity1 value = 125 | value 126 | |> Value.tryString 127 | |> Maybe.map 128 | (\s -> 129 | String.uncons s 130 | |> Maybe.map (\( head, tail ) -> String.cons (Char.toUpper head) tail) 131 | |> Maybe.withDefault (String.toUpper s) 132 | |> String 133 | |> Const 134 | ) 135 | |> Result.fromMaybe (Value.exception "type error: capitalize expects a string") 136 | in 137 | { emptyCallable 138 | | arity1 = Just <| Fixed (Symbol "s") <| Callable.toArityFunction arity1 139 | , doc = Just "Converts first character of the string to upper-case, all other characters to lower-case." 140 | } 141 | 142 | 143 | endsWith : Common.Callable io 144 | endsWith = 145 | let 146 | arity2 ( sValue, substrValue ) = 147 | Maybe.map2 (\s substr -> String.endsWith substr s |> Bool |> Const) 148 | (Value.tryString sValue) 149 | (Value.tryString substrValue) 150 | |> Result.fromMaybe (Value.exception "type error: ends-with? expects a string") 151 | in 152 | { emptyCallable 153 | | arity2 = Just <| Fixed ( Symbol "s", Symbol "substr" ) <| Callable.toArityFunction arity2 154 | , doc = Just "True if s ends with substr." 155 | } 156 | 157 | 158 | startsWith : Common.Callable io 159 | startsWith = 160 | let 161 | arity2 ( sValue, substrValue ) = 162 | Maybe.map2 (\s substr -> String.startsWith substr s |> Bool |> Const) 163 | (Value.tryString sValue) 164 | (Value.tryString substrValue) 165 | |> Result.fromMaybe (Value.exception "type error: starts-with? expects a string") 166 | in 167 | { emptyCallable 168 | | arity2 = Just <| Fixed ( Symbol "s", Symbol "substr" ) <| Callable.toArityFunction arity2 169 | , doc = Just "True if s starts with substr." 170 | } 171 | 172 | 173 | includes : Common.Callable io 174 | includes = 175 | let 176 | arity2 ( sValue, substrValue ) = 177 | Maybe.map2 (\s substr -> String.contains substr s |> Bool |> Const) 178 | (Value.tryString sValue) 179 | (Value.tryString substrValue) 180 | |> Result.fromMaybe (Value.exception "type error: includes? expects two string arguments") 181 | in 182 | { emptyCallable 183 | | arity2 = Just <| Fixed ( Symbol "s", Symbol "substr" ) <| Callable.toArityFunction arity2 184 | , doc = Just "True if s includes substr." 185 | } 186 | 187 | 188 | indexOf : Common.Callable io 189 | indexOf = 190 | let 191 | arity2 ( sValue, substrValue ) = 192 | Maybe.map2 193 | (\s substr -> 194 | String.indexes substr s 195 | |> List.head 196 | |> Maybe.map Value.int 197 | |> Maybe.withDefault Nil 198 | |> Const 199 | ) 200 | (Value.tryString sValue) 201 | (Value.tryString substrValue) 202 | |> Result.fromMaybe (Value.exception "type error: index-of expects two string arguments") 203 | 204 | arity3 ( sValue, substrValue, fromIndexValue ) = 205 | Maybe.map3 206 | (\s substr fromIndex -> 207 | String.indexes substr s 208 | |> List.filter (\i -> i >= fromIndex) 209 | |> List.head 210 | |> Maybe.map Value.int 211 | |> Maybe.withDefault Nil 212 | |> Const 213 | ) 214 | (Value.tryString sValue) 215 | (Value.tryString substrValue) 216 | (Value.tryInt fromIndexValue) 217 | |> Result.fromMaybe (Value.exception "type error: last-index-of expects two string arguments and one int argument") 218 | in 219 | { emptyCallable 220 | | arity2 = Just <| Fixed ( Symbol "s", Symbol "substr" ) <| Callable.toArityFunction arity2 221 | , arity3 = Just <| Fixed ( Symbol "s", Symbol "substr", Symbol "from-index" ) <| Callable.toArityFunction arity3 222 | , doc = Just "Return index of value (string or char) in s, optionally searching forward from from-index. Return nil if value not found." 223 | } 224 | 225 | 226 | lastIndexOf : Common.Callable io 227 | lastIndexOf = 228 | let 229 | arity2 ( sValue, substrValue ) = 230 | Maybe.map2 231 | (\s substr -> 232 | String.indexes substr s 233 | |> List.reverse 234 | |> List.head 235 | |> Maybe.map Value.int 236 | |> Maybe.withDefault Nil 237 | |> Const 238 | ) 239 | (Value.tryString sValue) 240 | (Value.tryString substrValue) 241 | |> Result.fromMaybe (Value.exception "type error: index-of expects two string arguments") 242 | 243 | arity3 ( sValue, substrValue, fromIndexValue ) = 244 | Maybe.map3 245 | (\s substr fromIndex -> 246 | String.indexes substr s 247 | |> List.filter (\i -> i <= fromIndex) 248 | |> List.reverse 249 | |> List.head 250 | |> Maybe.map Value.int 251 | |> Maybe.withDefault Nil 252 | |> Const 253 | ) 254 | (Value.tryString sValue) 255 | (Value.tryString substrValue) 256 | (Value.tryInt fromIndexValue) 257 | |> Result.fromMaybe (Value.exception "type error: last-index-of expects two string arguments and one int argument") 258 | in 259 | { emptyCallable 260 | | arity2 = Just <| Fixed ( Symbol "s", Symbol "substr" ) <| Callable.toArityFunction arity2 261 | , arity3 = Just <| Fixed ( Symbol "s", Symbol "substr", Symbol "from-index" ) <| Callable.toArityFunction arity3 262 | , doc = Just "Return last index of value (string or char) in s, optionally searching backward from from-index. Return nil if value not found." 263 | } 264 | 265 | 266 | lowerCase : Common.Callable io 267 | lowerCase = 268 | let 269 | arity1 sValue = 270 | sValue 271 | |> Value.tryString 272 | |> Maybe.map (String.toLower >> String >> Const) 273 | |> Result.fromMaybe (Value.exception "type error: lower-case expects one string argument") 274 | in 275 | { emptyCallable 276 | | arity1 = Just <| Fixed (Symbol "s") <| Callable.toArityFunction arity1 277 | , doc = Just "Converts string to all lower-case." 278 | } 279 | 280 | 281 | upperCase : Common.Callable io 282 | upperCase = 283 | let 284 | arity1 sValue = 285 | sValue 286 | |> Value.tryString 287 | |> Maybe.map (String.toUpper >> String >> Const) 288 | |> Result.fromMaybe (Value.exception "type error: upper-case expects one string argument") 289 | in 290 | { emptyCallable 291 | | arity1 = Just <| Fixed (Symbol "s") <| Callable.toArityFunction arity1 292 | , doc = Just "Converts string to all upper-case." 293 | } 294 | 295 | 296 | replaceMatch : String -> Regex.Match -> String 297 | replaceMatch pattern match = 298 | match.submatches 299 | |> List.indexedMap Tuple.pair 300 | |> List.foldr 301 | (\( i, mSubmatch ) a -> 302 | case mSubmatch of 303 | Just submatch -> 304 | String.replace ("$" ++ String.fromInt (i + 1)) submatch a 305 | 306 | Nothing -> 307 | a 308 | ) 309 | pattern 310 | 311 | 312 | replace : Common.Callable io 313 | replace = 314 | let 315 | arity3 ( sValue, matchValue, replacementValue ) = 316 | Maybe.map3 317 | (\s replaceMatchFn replacement -> 318 | replaceMatchFn replacement s 319 | |> String 320 | |> Const 321 | ) 322 | (Value.tryString sValue) 323 | (Value.tryOneOf 324 | [ Value.tryString >> Maybe.map String.replace 325 | , Value.tryRegex >> Maybe.map (\regex -> \replacement -> Regex.replace regex (replaceMatch replacement)) 326 | ] 327 | matchValue 328 | ) 329 | (Value.tryString replacementValue) 330 | |> Result.fromMaybe (Value.exception "type error: wrong argument types to replace") 331 | in 332 | { emptyCallable 333 | | arity3 = Just <| Fixed ( Symbol "s", Symbol "match", Symbol "replacement" ) <| Callable.toArityFunction arity3 334 | , doc = Just """Replaces all instance of match with replacement in s. 335 | 336 | match/replacement can be: 337 | 338 | string / string 339 | pattern / string 340 | 341 | See also replace-first. 342 | 343 | The replacement is literal (i.e. none of its characters are treated 344 | specially) for all cases above except pattern / string. 345 | 346 | For pattern / string, $1, $2, etc. in the replacement string are 347 | substituted with the string that matched the corresponding 348 | parenthesized group in the pattern. If you wish your replacement 349 | string r to be used literally, use (re-quote-replacement r) as the 350 | replacement argument. See also documentation for 351 | java.util.regex.Matcher's appendReplacement method. 352 | 353 | Example: 354 | (string/replace "Almost Pig Latin" #"\\b(\\w)(\\w+)\\b" "$2$1ay") 355 | -> "lmostAay igPay atinLay" """ 356 | } 357 | 358 | 359 | replaceFirst : Common.Callable io 360 | replaceFirst = 361 | let 362 | arity3 ( sValue, matchValue, replacementValue ) = 363 | Maybe.map3 364 | (\s replaceMatchFn replacement -> 365 | replaceMatchFn replacement s 366 | |> String 367 | |> Const 368 | ) 369 | (Value.tryString sValue) 370 | (Value.tryOneOf 371 | [ Value.tryString >> Maybe.map String.replace 372 | , Value.tryRegex >> Maybe.map (\regex -> \replacement -> Regex.replaceAtMost 1 regex (replaceMatch replacement)) 373 | ] 374 | matchValue 375 | ) 376 | (Value.tryString replacementValue) 377 | |> Result.fromMaybe (Value.exception "type error: wrong argument types to replace-first") 378 | in 379 | { emptyCallable 380 | | arity3 = Just <| Fixed ( Symbol "s", Symbol "match", Symbol "replacement" ) <| Callable.toArityFunction arity3 381 | , doc = Just """Usage: (replace s match replacement) 382 | Replaces all instance of match with replacement in s. 383 | 384 | match/replacement can be: 385 | 386 | string / string 387 | pattern / string 388 | 389 | See also replace-first. 390 | 391 | The replacement is literal (i.e. none of its characters are treated 392 | specially) for all cases above except pattern / string. 393 | 394 | For pattern / string, $1, $2, etc. in the replacement string are 395 | substituted with the string that matched the corresponding 396 | parenthesized group in the pattern. If you wish your replacement 397 | string r to be used literally, use (re-quote-replacement r) as the 398 | replacement argument. See also documentation for 399 | java.util.regex.Matcher's appendReplacement method. 400 | 401 | Example: 402 | (string/replace "Almost Pig Latin" #"\\b(\\w)(\\w+)\\b" "$2$1ay") 403 | -> "lmostAay igPay atinLay" """ 404 | } 405 | 406 | 407 | reverse : Common.Callable io 408 | reverse = 409 | let 410 | arity1 sValue = 411 | sValue 412 | |> Value.tryString 413 | |> Maybe.map (String.reverse >> String >> Const) 414 | |> Result.fromMaybe (Value.exception "type error: reverse expects one string argument") 415 | in 416 | { emptyCallable 417 | | arity1 = Just <| Fixed (Symbol "s") <| Callable.toArityFunction arity1 418 | , doc = Just "Returns s with its characters reversed." 419 | } 420 | 421 | 422 | split : Common.Callable io 423 | split = 424 | let 425 | arity2 ( sValue, splitstrValue ) = 426 | Result.map2 (\s splitFn -> splitFn s |> List.map String |> Value.vectorFromList |> Const) 427 | (Value.tryString sValue |> Result.fromMaybe (Value.exception "type error: the first argument to split should be a string")) 428 | (Value.tryOneOf 429 | [ Value.tryString >> Maybe.map String.split 430 | , Value.tryRegex >> Maybe.map Regex.split 431 | ] 432 | splitstrValue 433 | |> Result.fromMaybe (Value.exception "type error: the second argument to split should be a string or a regular expression") 434 | ) 435 | in 436 | { emptyCallable 437 | | arity2 = Just <| Fixed ( Symbol "s", Symbol "splitter" ) <| Callable.toArityFunction arity2 438 | , doc = Just """Splits string on a regular expression or a string. Optional argument limit is 439 | the maximum number of parts. Not lazy. Returns vector of the parts. 440 | Trailing empty strings are not returned - pass limit of -1 to return all.""" 441 | } 442 | 443 | 444 | trim : Common.Callable io 445 | trim = 446 | let 447 | arity1 sValue = 448 | sValue 449 | |> Value.tryString 450 | |> Maybe.map (String.trim >> String >> Const) 451 | |> Result.fromMaybe (Value.exception "type error: trim expects one string argument") 452 | in 453 | { emptyCallable 454 | | arity1 = Just <| Fixed (Symbol "s") <| Callable.toArityFunction arity1 455 | , doc = Just "Removes whitespace from both ends of string." 456 | } 457 | 458 | 459 | triml : Common.Callable io 460 | triml = 461 | let 462 | arity1 sValue = 463 | sValue 464 | |> Value.tryString 465 | |> Maybe.map (String.trimLeft >> String >> Const) 466 | |> Result.fromMaybe (Value.exception "type error: triml expects one string argument") 467 | in 468 | { emptyCallable 469 | | arity1 = Just <| Fixed (Symbol "s") <| Callable.toArityFunction arity1 470 | , doc = Just "Removes whitespace from the left side of string." 471 | } 472 | 473 | 474 | trimr : Common.Callable io 475 | trimr = 476 | let 477 | arity1 sValue = 478 | sValue 479 | |> Value.tryString 480 | |> Maybe.map (String.trimRight >> String >> Const) 481 | |> Result.fromMaybe (Value.exception "type error: trimr expects one string argument") 482 | in 483 | { emptyCallable 484 | | arity1 = Just <| Fixed (Symbol "s") <| Callable.toArityFunction arity1 485 | , doc = Just "Removes whitespace from the right side of string." 486 | } 487 | -------------------------------------------------------------------------------- /src/Enclojure/Located.elm: -------------------------------------------------------------------------------- 1 | module Enclojure.Located exposing 2 | ( Located(..), Location(..), Offsets 3 | , at, getValue, map, sameAs, unknown 4 | , getLocation, getOffsets 5 | ) 6 | 7 | {-| Some values have known locations in the evaluated source code. This module provides functions for 8 | working with them. 9 | 10 | 11 | # Types 12 | 13 | @docs Located, Location, Offsets 14 | 15 | 16 | # Working with located values 17 | 18 | @docs at, getValue, map, sameAs, unknown 19 | 20 | 21 | # Extracting location information 22 | 23 | @docs getLocation, getOffsets 24 | 25 | -} 26 | 27 | 28 | {-| Represents the offsets of the start and the end of a value in the source code. 29 | -} 30 | type alias Offsets = 31 | { start : ( Int, Int ), end : ( Int, Int ) } 32 | 33 | 34 | {-| Represents the location of a value in the source code. Known offsets or unknown. 35 | -} 36 | type Location 37 | = Known Offsets 38 | | Unknown 39 | 40 | 41 | {-| Represents a value `a` with location information. 42 | -} 43 | type Located a 44 | = Located Location a 45 | 46 | 47 | {-| Assigns location information from `a` to `b` 48 | -} 49 | sameAs : Located a -> b -> Located b 50 | sameAs (Located pos _) val = 51 | Located pos val 52 | 53 | 54 | {-| Applies a function to the located value 55 | -} 56 | map : (a -> b) -> Located a -> Located b 57 | map f (Located pos a) = 58 | Located pos (f a) 59 | 60 | 61 | {-| Extracts the located value 62 | -} 63 | getValue : Located a -> a 64 | getValue (Located _ val) = 65 | val 66 | 67 | 68 | {-| Extract the offsets of the located value (if known) 69 | -} 70 | getOffsets : Located a -> Maybe Offsets 71 | getOffsets (Located location _) = 72 | case location of 73 | Known offsets -> 74 | Just offsets 75 | 76 | Unknown -> 77 | Nothing 78 | 79 | 80 | {-| Extract the location of a located value 81 | -} 82 | getLocation : Located a -> Location 83 | getLocation (Located location _) = 84 | location 85 | 86 | 87 | {-| Wraps `a` in an unknown location 88 | -} 89 | unknown : a -> Located a 90 | unknown v = 91 | Located Unknown v 92 | 93 | 94 | {-| Wraps `a` in a location at given offsets 95 | -} 96 | at : ( Int, Int ) -> ( Int, Int ) -> a -> Located a 97 | at start end val = 98 | Located (Known { start = start, end = end }) val 99 | -------------------------------------------------------------------------------- /src/Enclojure/Reader.elm: -------------------------------------------------------------------------------- 1 | module Enclojure.Reader exposing (parse, readString) 2 | 3 | import Array 4 | import Enclojure.Common exposing (Exception(..), Number(..), Value(..)) 5 | import Enclojure.Located as Located exposing (Located(..)) 6 | import Enclojure.Reader.DoubleQuotedString as DoubleQuotedString 7 | import Enclojure.Reader.Macros as Macros 8 | import Enclojure.Value as Value 9 | import Enclojure.ValueMap as ValueMap exposing (ValueMapEntry) 10 | import Enclojure.ValueSet as ValueSet 11 | import Parser exposing ((|.), (|=), Parser) 12 | import Regex 13 | import Set 14 | 15 | 16 | located : Parser a -> Parser (Located a) 17 | located p = 18 | Parser.succeed (\start v end -> Located.at start end v) 19 | |= Parser.getPosition 20 | |= p 21 | |= Parser.getPosition 22 | 23 | 24 | parse : String -> Result (List Parser.DeadEnd) (List (Located (Value io))) 25 | parse code = 26 | Parser.run parser code 27 | 28 | 29 | negateNumber : Number -> Number 30 | negateNumber num = 31 | case num of 32 | Int v -> 33 | Int -v 34 | 35 | Float v -> 36 | Float -v 37 | 38 | 39 | positiveNumber : Parser Number 40 | positiveNumber = 41 | Parser.number 42 | { int = Just Int 43 | , float = Just Float 44 | , hex = Nothing 45 | , octal = Nothing 46 | , binary = Nothing 47 | } 48 | 49 | 50 | number : Parser (Value io) 51 | number = 52 | Parser.oneOf 53 | [ Parser.succeed (Number << negateNumber) 54 | |. Parser.symbol "-" 55 | |= positiveNumber 56 | , Parser.map Number positiveNumber 57 | ] 58 | |> Parser.backtrackable 59 | 60 | 61 | isAllowedSymbolSpecialChar : Char -> Bool 62 | isAllowedSymbolSpecialChar c = 63 | c 64 | == '-' 65 | || c 66 | == '+' 67 | || c 68 | == '/' 69 | || c 70 | == '-' 71 | || c 72 | == '*' 73 | || c 74 | == '>' 75 | || c 76 | == '<' 77 | || c 78 | == '=' 79 | || c 80 | == '\'' 81 | || c 82 | == '&' 83 | || c 84 | == '%' 85 | || c 86 | == '?' 87 | || c 88 | == '.' 89 | || c 90 | == '$' 91 | || c 92 | == '_' 93 | || c 94 | == '!' 95 | 96 | 97 | symbolLike : Parser String 98 | symbolLike = 99 | Parser.variable 100 | { start = 101 | \c -> 102 | Char.isAlpha c 103 | || isAllowedSymbolSpecialChar c 104 | , inner = \c -> Char.isAlphaNum c || isAllowedSymbolSpecialChar c 105 | , reserved = Set.empty 106 | } 107 | 108 | 109 | symbol : Parser (Value io) 110 | symbol = 111 | Parser.succeed 112 | (\token -> 113 | case token of 114 | "nil" -> 115 | Nil 116 | 117 | "true" -> 118 | Bool True 119 | 120 | "false" -> 121 | Bool False 122 | 123 | _ -> 124 | Symbol token 125 | ) 126 | |= symbolLike 127 | 128 | 129 | keyword : Parser (Value io) 130 | keyword = 131 | Parser.variable 132 | { start = \c -> c == ':' 133 | , inner = \c -> Char.isAlphaNum c || isAllowedSymbolSpecialChar c 134 | , reserved = Set.empty 135 | } 136 | |> Parser.map (String.dropLeft 1 >> Keyword) 137 | 138 | 139 | expressionsHelper : List (Located (Value io)) -> Parser (Parser.Step (List (Located (Value io))) (List (Located (Value io)))) 140 | expressionsHelper revExprs = 141 | Parser.oneOf 142 | [ Parser.succeed (\expr -> Parser.Loop (expr :: revExprs)) 143 | |= located expression 144 | |. spaces 145 | , Parser.succeed (\_ -> Parser.Loop revExprs) 146 | |= lineComment 147 | , Parser.succeed () 148 | |> Parser.map (\_ -> Parser.Done (List.reverse revExprs)) 149 | ] 150 | 151 | 152 | lineComment : Parser () 153 | lineComment = 154 | Parser.lineComment ";" 155 | 156 | 157 | uncommentedExpression : Parser (Value io) 158 | uncommentedExpression = 159 | Parser.succeed identity 160 | |. Parser.spaces 161 | |= Parser.oneOf 162 | [ lambda 163 | , regex 164 | , string 165 | , list 166 | , vector 167 | , valueMap 168 | , valueSet 169 | , number 170 | , symbol 171 | , keyword 172 | ] 173 | |. Parser.spaces 174 | 175 | 176 | wrapInQuote : Value io -> Value io 177 | wrapInQuote val = 178 | List [ Located.unknown (Symbol "quote"), Located.unknown val ] 179 | 180 | 181 | expression : Parser (Value io) 182 | expression = 183 | Parser.oneOf 184 | [ Parser.backtrackable <| 185 | Parser.succeed identity 186 | |. Parser.spaces 187 | |. Parser.token "#_" 188 | |. Parser.spaces 189 | |. uncommentedExpression 190 | |= uncommentedExpression 191 | , Parser.backtrackable <| 192 | Parser.succeed wrapInQuote 193 | |. Parser.spaces 194 | |. Parser.symbol "'" 195 | |. Parser.spaces 196 | |= uncommentedExpression 197 | , uncommentedExpression 198 | ] 199 | 200 | 201 | spaces : Parser () 202 | spaces = 203 | Parser.oneOf 204 | [ Parser.spaces 205 | , Parser.chompIf (\c -> c == ',') 206 | ] 207 | 208 | 209 | vector : Parser (Value io) 210 | vector = 211 | Parser.sequence 212 | { start = "[" 213 | , separator = "" 214 | , spaces = spaces 215 | , item = Parser.lazy (\_ -> located expression) 216 | , trailing = Parser.Optional 217 | , end = "]" 218 | } 219 | |> Parser.map (Array.fromList >> Vector) 220 | 221 | 222 | lambda : Parser (Value io) 223 | lambda = 224 | Parser.sequence 225 | { start = "#(" 226 | , separator = "" 227 | , spaces = spaces 228 | , item = Parser.lazy (\_ -> located expression) 229 | , trailing = Parser.Optional 230 | , end = ")" 231 | } 232 | |> located 233 | |> Parser.map (\(Located loc v) -> List (Located loc (Symbol "__lambda") :: v)) 234 | 235 | 236 | list : Parser (Value io) 237 | list = 238 | Parser.sequence 239 | { start = "(" 240 | , separator = "" 241 | , spaces = spaces 242 | , item = Parser.lazy (\_ -> located expression) 243 | , trailing = Parser.Optional 244 | , end = ")" 245 | } 246 | |> Parser.map List 247 | 248 | 249 | mapEntry : Parser (ValueMapEntry io) 250 | mapEntry = 251 | Parser.succeed Tuple.pair 252 | |= expression 253 | |. spaces 254 | |= located expression 255 | 256 | 257 | valueMap : Parser (Value io) 258 | valueMap = 259 | Parser.sequence 260 | { start = "{" 261 | , separator = "" 262 | , spaces = spaces 263 | , item = Parser.lazy (\_ -> mapEntry) 264 | , trailing = Parser.Optional 265 | , end = "}" 266 | } 267 | |> Parser.map (ValueMap.fromList >> Map) 268 | 269 | 270 | valueSet : Parser (Value io) 271 | valueSet = 272 | Parser.sequence 273 | { start = "#{" 274 | , separator = "" 275 | , spaces = spaces 276 | , item = Parser.lazy (\_ -> expression) 277 | , trailing = Parser.Optional 278 | , end = "}" 279 | } 280 | |> Parser.map (ValueSet.fromList >> Set) 281 | 282 | 283 | string : Parser (Value io) 284 | string = 285 | DoubleQuotedString.string |> Parser.map String 286 | 287 | 288 | parser : Parser (List (Located (Value io))) 289 | parser = 290 | Parser.loop [] expressionsHelper 291 | |> Parser.andThen 292 | (\l -> 293 | List.foldr (\e a -> a |> Result.andThen (\lr -> Macros.macroexpandAll e |> Result.map (\v -> v :: lr))) 294 | (Ok []) 295 | l 296 | |> (\r -> 297 | case r of 298 | Ok v -> 299 | Parser.succeed v 300 | 301 | Err (Exception e _) -> 302 | Parser.problem e 303 | ) 304 | ) 305 | 306 | 307 | regex : Parser (Value io) 308 | regex = 309 | (Parser.succeed identity 310 | |. (Parser.token "#" |> Parser.backtrackable) 311 | |= DoubleQuotedString.string 312 | ) 313 | |> Parser.andThen 314 | (\pattern -> 315 | Regex.fromString pattern 316 | |> Maybe.map (Regex pattern >> Parser.succeed) 317 | |> Maybe.withDefault (Parser.problem "invalid regex") 318 | ) 319 | 320 | 321 | deadEndsToString : List Parser.DeadEnd -> String 322 | deadEndsToString deadEnds = 323 | String.concat (List.intersperse "; " (List.map deadEndToString deadEnds)) 324 | 325 | 326 | deadEndToString : Parser.DeadEnd -> String 327 | deadEndToString deadend = 328 | problemToString deadend.problem ++ " at row " ++ String.fromInt deadend.row ++ ", col " ++ String.fromInt deadend.col 329 | 330 | 331 | problemToString : Parser.Problem -> String 332 | problemToString p = 333 | case p of 334 | Parser.Expecting s -> 335 | "expecting '" ++ s ++ "'" 336 | 337 | Parser.ExpectingInt -> 338 | "expecting int" 339 | 340 | Parser.ExpectingHex -> 341 | "expecting hex" 342 | 343 | Parser.ExpectingOctal -> 344 | "expecting octal" 345 | 346 | Parser.ExpectingBinary -> 347 | "expecting binary" 348 | 349 | Parser.ExpectingFloat -> 350 | "expecting float" 351 | 352 | Parser.ExpectingNumber -> 353 | "expecting number" 354 | 355 | Parser.ExpectingVariable -> 356 | "expecting variable" 357 | 358 | Parser.ExpectingSymbol s -> 359 | "expecting symbol '" ++ s ++ "'" 360 | 361 | Parser.ExpectingKeyword s -> 362 | "expecting keyword '" ++ s ++ "'" 363 | 364 | Parser.ExpectingEnd -> 365 | "expecting end" 366 | 367 | Parser.UnexpectedChar -> 368 | "unexpected char" 369 | 370 | Parser.Problem s -> 371 | s 372 | 373 | Parser.BadRepeat -> 374 | "bad repeat" 375 | 376 | 377 | {-| Same as `parse` but converts parser errors to exceptions. 378 | -} 379 | readString : String -> Result Exception (List (Located (Value io))) 380 | readString s = 381 | parse s 382 | |> Result.mapError (deadEndsToString >> Value.exception) 383 | -------------------------------------------------------------------------------- /src/Enclojure/Reader/DoubleQuotedString.elm: -------------------------------------------------------------------------------- 1 | {- 2 | https://github.com/elm/parser/blob/7506b07eaa93a93d13b508b948c016105b0953c8/examples/DoubleQuoteString.elm 3 | 4 | Copyright (c) 2017-present, Evan Czaplicki 5 | All rights reserved. 6 | 7 | Redistribution and use in source and binary forms, with or without 8 | modification, are permitted provided that the following conditions are met: 9 | 10 | * Redistributions of source code must retain the above copyright notice, this 11 | list of conditions and the following disclaimer. 12 | 13 | * Redistributions in binary form must reproduce the above copyright notice, 14 | this list of conditions and the following disclaimer in the documentation 15 | and/or other materials provided with the distribution. 16 | 17 | * Neither the name of the {organization} nor the names of its 18 | contributors may be used to endorse or promote products derived from 19 | this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 22 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 23 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 24 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 25 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 26 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 27 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 28 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 29 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -} 32 | 33 | 34 | module Enclojure.Reader.DoubleQuotedString exposing (string) 35 | 36 | import Parser exposing (..) 37 | 38 | 39 | string : Parser String 40 | string = 41 | succeed identity 42 | |. token "\"" 43 | |= loop [] stringHelp 44 | |> Parser.andThen 45 | (\v -> 46 | case v of 47 | Ok val -> 48 | succeed val 49 | 50 | Err err -> 51 | problem err 52 | ) 53 | 54 | 55 | stringHelp : List String -> Parser (Step (List String) (Result String String)) 56 | stringHelp revChunks = 57 | oneOf 58 | [ succeed (\chunk -> Loop (chunk :: revChunks)) 59 | |. token "\\" 60 | |= oneOf 61 | [ map (\_ -> "\n") (token "n") 62 | , map (\_ -> "\t") (token "t") 63 | , map (\_ -> "\"") (token "\"") 64 | , map (\_ -> "\\") (token "\\") 65 | , map (\_ -> "\u{000D}") (token "r") 66 | , succeed String.fromChar 67 | |. token "u{" 68 | |= unicode 69 | |. token "}" 70 | , Parser.succeed "\\" 71 | ] 72 | , token "\"" 73 | |> map (\_ -> Done <| Ok (String.join "" (List.reverse revChunks))) 74 | , end 75 | |> map (\_ -> Done <| Err "Missing closing quote for a string") 76 | , chompWhile isUninteresting 77 | |> getChompedString 78 | |> map (\chunk -> Loop (chunk :: revChunks)) 79 | ] 80 | 81 | 82 | isUninteresting : Char -> Bool 83 | isUninteresting char = 84 | char /= '\\' && char /= '"' 85 | 86 | 87 | 88 | -- UNICODE 89 | 90 | 91 | unicode : Parser Char 92 | unicode = 93 | getChompedString (chompWhile Char.isHexDigit) 94 | |> andThen codeToChar 95 | 96 | 97 | codeToChar : String -> Parser Char 98 | codeToChar str = 99 | let 100 | length = 101 | String.length str 102 | 103 | code = 104 | String.foldl addHex 0 str 105 | in 106 | if 4 <= length && length <= 6 then 107 | problem "code point must have between 4 and 6 digits" 108 | 109 | else if 0 <= code && code <= 0x0010FFFF then 110 | succeed (Char.fromCode code) 111 | 112 | else 113 | problem "code point must be between 0 and 0x10FFFF" 114 | 115 | 116 | addHex : Char -> Int -> Int 117 | addHex char total = 118 | let 119 | code = 120 | Char.toCode char 121 | in 122 | if 0x30 <= code && code <= 0x39 then 123 | 16 * total + (code - 0x30) 124 | 125 | else if 0x41 <= code && code <= 0x46 then 126 | 16 * total + (10 + code - 0x41) 127 | 128 | else 129 | 16 * total + (10 + code - 0x61) 130 | -------------------------------------------------------------------------------- /src/Enclojure/Reader/Macros.elm: -------------------------------------------------------------------------------- 1 | module Enclojure.Reader.Macros exposing (all, macroexpandAll) 2 | 3 | import Array 4 | import Dict exposing (Dict) 5 | import Enclojure.Common exposing (Exception(..), FnInfo, Number(..), Value(..)) 6 | import Enclojure.Located as Located exposing (Located(..)) 7 | import Enclojure.Value as Value 8 | import Enclojure.ValueMap as ValueMap 9 | 10 | 11 | type Expansion a 12 | = Expanded a 13 | | Returned a 14 | 15 | 16 | macroexpandAll : Located (Value io) -> Result Exception (Located (Value io)) 17 | macroexpandAll v = 18 | macroexpandAllInternal 0 v |> Result.map Tuple.second 19 | 20 | 21 | macroexpandAllInternal : Int -> Located (Value io) -> Result Exception ( Int, Located (Value io) ) 22 | macroexpandAllInternal i v = 23 | case macroexpand i v of 24 | Ok result -> 25 | case result of 26 | Expanded ( nextI, val ) -> 27 | macroexpandAllInternal nextI val 28 | 29 | Returned ( nextI, Located loc val ) -> 30 | case val of 31 | List l -> 32 | List.foldr 33 | (\e a -> 34 | a 35 | |> Result.andThen 36 | (\( ni, lr ) -> 37 | macroexpandAllInternal ni e |> Result.map (\( nni, r ) -> ( nni, r :: lr )) 38 | ) 39 | ) 40 | (Ok ( nextI, [] )) 41 | l 42 | |> Result.map (Tuple.mapSecond (List >> Located loc)) 43 | 44 | Vector l -> 45 | Array.foldl 46 | (\e a -> a |> Result.andThen (\( ni, lr ) -> macroexpandAllInternal ni e |> Result.map (\( nni, r ) -> ( nni, Array.push r lr )))) 47 | (Ok ( nextI, Array.empty )) 48 | l 49 | |> Result.map (Tuple.mapSecond (Vector >> Located loc)) 50 | 51 | Map m -> 52 | m 53 | |> ValueMap.toList 54 | |> List.foldl 55 | (\( mapKey, mapVal ) a -> a |> Result.andThen (\( ni, lr ) -> macroexpandAllInternal ni mapVal |> Result.map (\( nni, r ) -> ( nni, ( mapKey, r ) :: lr )))) 56 | (Ok ( nextI, [] )) 57 | |> Result.map (Tuple.mapSecond (ValueMap.fromList >> Map >> Located loc)) 58 | 59 | _ -> 60 | Ok ( nextI, Located loc val ) 61 | 62 | Err e -> 63 | Err e 64 | 65 | 66 | type alias Macro io = 67 | { info : FnInfo 68 | , expand : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 69 | } 70 | 71 | 72 | all : List (Macro io) 73 | all = 74 | [ Macro 75 | { name = Just "__lambda" 76 | , doc = Just "Inserted by the reader in place of #()." 77 | , signatures = [] 78 | } 79 | expandLambda 80 | , Macro 81 | { name = Just "and" 82 | , doc = Just """Evaluates exprs one at a time, from left to right. If a form 83 | returns logical false (nil or false), and returns that value and 84 | doesn't evaluate any of the other expressions, otherwise it returns 85 | the value of the last expr. (and) returns true.""" 86 | , signatures = [ [ "x" ], [ "x", "&", "next" ] ] 87 | } 88 | expandAnd 89 | , Macro 90 | { name = Just "case" 91 | , doc = Just """Takes an expression and a set of test/expr pairs. Each clause can take the form of either: 92 | test-constant result-expr 93 | (test-constant1 ... test-constantN) result-expr 94 | 95 | The test-constants are not evaluated. They must be compile-time 96 | literals, and need not be quoted. If the expression is equal to a 97 | test-constant, the corresponding result-expr is returned. A single 98 | default expression can follow the clauses, and its value will be 99 | returned if no clause matches. If no default expression is provided 100 | and no clause matches, an exception is thrown. 101 | 102 | Unlike Clojure, the clauses are considered sequentially. 103 | The current implementation doesn't throw on redundant test expressions. 104 | All manner of constant 105 | expressions are acceptable in case, including numbers, strings, 106 | symbols, keywords, and (Clojure) composites thereof. Note that since 107 | lists are used to group multiple constants that map to the same 108 | expression, a vector can be used to match a list if needed. The 109 | test-constants need not be all of the same type. 110 | """ 111 | , signatures = [ [ "e", "&", "clauses" ] ] 112 | } 113 | expandCase 114 | , Macro 115 | { name = Just "cond" 116 | , doc = Just """Takes a set of test/expr pairs. It evaluates each test one at a 117 | time. If a test returns logical true, cond evaluates and returns 118 | the value of the corresponding expr and doesn't evaluate any of the 119 | other tests or exprs. (cond) returns nil. 120 | 121 | If the test is a :let keyword, the next test/expr pair will be wrapped in a let expression with the values supplied 122 | as the expr for the :let. 123 | """ 124 | , signatures = [ [ "&", "clauses" ] ] 125 | } 126 | expandCond 127 | , Macro 128 | { name = Just "defn" 129 | , doc = Just """Same as (def name "doc" (fn [params* ] exprs*)) or (def 130 | name (fn "doc" ([params* ] exprs*)+)).""" 131 | , signatures = [ [ "name", "doc-string?", "[params*]", "body" ], [ "name", "doc-string?", "&", "bodies" ] ] 132 | } 133 | expandDefn 134 | , Macro 135 | { name = Just "doseq" 136 | , doc = Just """Repeatedly executes body (presumably for side-effects) with 137 | bindings and filtering as provided by "for". Does not retain 138 | the head of the sequence. Returns nil.""" 139 | , signatures = [ [ "seq-exprs", "&", "body" ] ] 140 | } 141 | expandDoseq 142 | , Macro 143 | { name = Just "dotimes" 144 | , doc = Just """bindings => name n 145 | 146 | Repeatedly executes body (presumably for side-effects) with name 147 | bound to integers from 0 through n-1.""" 148 | , signatures = [ [ "bindings", "& body" ] ] 149 | } 150 | expandDotimes 151 | , Macro 152 | { name = Just "for" 153 | , doc = Just """List comprehension. Takes a vector of one or more 154 | binding-form/collection-expr pairs, each followed by zero or more 155 | modifiers, and yields a list of evaluations of expr. 156 | Collections are iterated in a nested fashion, rightmost fastest, 157 | and nested coll-exprs can refer to bindings created in prior 158 | binding-forms. Supported modifiers are: :let [binding-form expr ...], 159 | :when test. 160 | 161 | (take 100 (for [x (range 100000000) y (range 1000000) :when (< y x)] [x y]))""" 162 | , signatures = [ [ "seq-exprs", "body-expr" ] ] 163 | } 164 | expandFor 165 | , Macro 166 | { name = Just "if-let" 167 | , doc = Just """bindings => binding-form test 168 | 169 | If test is true, evaluates then with binding-form bound to the value of 170 | test, if not, yields else""" 171 | , signatures = [ [ "bindings", "then" ], [ "bindings", "then", "else", "&", "oldform" ] ] 172 | } 173 | expandIfLet 174 | , Macro 175 | { name = Just "loop" 176 | , doc = Just """Evaluates the exprs in a lexical context in which the symbols in 177 | the binding-forms are bound to their respective init-exprs or parts 178 | therein. Acts as a recur target.""" 179 | , signatures = [ [ "[bindings*]", "exprs*" ] ] 180 | } 181 | expandLoop 182 | , Macro 183 | { name = Just "or" 184 | , doc = Just """Evaluates exprs one at a time, from left to right. If a form 185 | returns a logical true value, or returns that value and doesn't 186 | evaluate any of the other expressions, otherwise it returns the 187 | value of the last expression. (or) returns nil.""" 188 | , signatures = [ [], [ "x" ], [ "x", "&", "next" ] ] 189 | } 190 | expandOr 191 | , Macro 192 | { name = Just "some->" 193 | , doc = Just """When expr is not nil, threads it into the first form (via ->), 194 | and when that result is not nil, through the next etc""" 195 | , signatures = [ [ "expr", "&", "forms" ] ] 196 | } 197 | expandThreadSomeFirst 198 | , Macro 199 | { name = Just "some->>" 200 | , doc = Just """When expr is not nil, threads it into the first form (via ->>), 201 | and when that result is not nil, through the next etc""" 202 | , signatures = [ [ "expr", "&", "forms" ] ] 203 | } 204 | expandThreadSomeLast 205 | , Macro 206 | { name = Just "when" 207 | , doc = Just """Evaluates test. If logical true, evaluates body in an implicit do.""" 208 | , signatures = [ [ "test", "&", "body" ] ] 209 | } 210 | expandWhen 211 | , Macro 212 | { name = Just "when-let" 213 | , doc = Just """bindings => binding-form test 214 | 215 | When test is true, evaluates body with binding-form bound to the value of test""" 216 | , signatures = [ [ "bindings", "&", "body" ] ] 217 | } 218 | expandWhenLet 219 | , Macro 220 | { name = Just "when-not" 221 | , doc = Just "Evaluates test. If logical false, evaluates body in an implicit do." 222 | , signatures = [ [ "test", "&", "body" ] ] 223 | } 224 | expandWhenNot 225 | , Macro 226 | { name = Just "while" 227 | , doc = Just """Repeatedly executes body while test expression is true. Presumes 228 | some side-effect will cause test to become false/nil. Returns nil""" 229 | , signatures = [ [ "test", "&", "body" ] ] 230 | } 231 | expandWhile 232 | , Macro 233 | { name = Just "->" 234 | , doc = Just """Threads the expr through the forms. Inserts x as the 235 | second item in the first form, making a list of it if it is not a 236 | list already. If there are more forms, inserts the first form as the 237 | second item in second form, etc.""" 238 | , signatures = [ [ "x", "&", "forms" ] ] 239 | } 240 | expandThreadFirst 241 | , Macro 242 | { name = Just "->>" 243 | , doc = Just """Threads the expr through the forms. Inserts x as the 244 | last item in the first form, making a list of it if it is not a 245 | list already. If there are more forms, inserts the first form as the 246 | last item in second form, etc.""" 247 | , signatures = [ [ "x", "&", "forms" ] ] 248 | } 249 | expandThreadLast 250 | ] 251 | 252 | 253 | allByName : Dict String (Macro io) 254 | allByName = 255 | List.foldl 256 | (\({ info } as macro) acc -> 257 | info.name |> Maybe.map (\n -> Dict.insert n macro acc) |> Maybe.withDefault acc 258 | ) 259 | Dict.empty 260 | all 261 | 262 | 263 | macroexpand : Int -> Located (Value io) -> Result Exception (Expansion ( Int, Located (Value io) )) 264 | macroexpand i (Located loc value) = 265 | case value of 266 | List l -> 267 | case l of 268 | (Located _ (Symbol name)) :: args -> 269 | allByName 270 | |> Dict.get name 271 | |> Maybe.map (\{ expand } -> expand i (Located loc args)) 272 | |> Maybe.map (Result.map Expanded) 273 | |> Maybe.withDefault (Ok (Returned ( i, Located loc value ))) 274 | 275 | _ -> 276 | Ok (Returned ( i, Located loc value )) 277 | 278 | _ -> 279 | Ok (Returned ( i, Located loc value )) 280 | 281 | 282 | expandDefn : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 283 | expandDefn i (Located loc args) = 284 | case args of 285 | (Located _ (Symbol name)) :: (Located _ (String doc)) :: fnBody -> 286 | Ok 287 | ( i 288 | , Located loc 289 | (List 290 | [ Located loc (Symbol "def") 291 | , Located loc (Symbol name) 292 | , Located loc 293 | (List 294 | (Located loc (Symbol "fn") 295 | :: Located loc (Symbol name) 296 | :: Located loc (String doc) 297 | :: fnBody 298 | ) 299 | ) 300 | ] 301 | ) 302 | ) 303 | 304 | (Located _ (Symbol name)) :: fnBody -> 305 | Ok 306 | ( i 307 | , Located loc 308 | (List 309 | [ Located loc (Symbol "def") 310 | , Located loc (Symbol name) 311 | , Located loc 312 | (List 313 | (Located loc (Symbol "fn") 314 | :: Located loc (Symbol name) 315 | :: fnBody 316 | ) 317 | ) 318 | ] 319 | ) 320 | ) 321 | 322 | _ -> 323 | Err (Exception "Argument error: invalid arguments to defn" []) 324 | 325 | 326 | expandDotimes : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 327 | expandDotimes i (Located loc args) = 328 | case args of 329 | (Located _ (Vector bindings)) :: body -> 330 | case Array.toList bindings of 331 | (Located _ ((Symbol _) as binding)) :: (Located _ ((Number (Int _)) as nTimes)) :: [] -> 332 | Ok 333 | ( i 334 | , (Located loc (Value.symbol "doseq") 335 | :: Located loc (Value.vectorFromList [ binding, Value.list [ Value.symbol "range", nTimes ] ]) 336 | :: body 337 | ) 338 | |> List 339 | |> Located loc 340 | ) 341 | 342 | _ -> 343 | Err (Value.exception "Argument error: invalid arguments to dotimes") 344 | 345 | _ -> 346 | Err (Value.exception "Argument error: invalid arguments to dotimes") 347 | 348 | 349 | expandDoseq : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 350 | expandDoseq i (Located loc args) = 351 | case args of 352 | (Located bindingsPos (Vector bindings)) :: body -> 353 | case Array.toList bindings of 354 | (Located letPos (Keyword "let")) :: ((Located _ (Vector _)) as letBindings) :: rest -> 355 | expandDoseq 356 | i 357 | (Located loc (Located bindingsPos (Value.vectorFromLocatedList rest) :: body)) 358 | |> Result.map 359 | (\( retI, ret ) -> 360 | ( retI 361 | , Located loc 362 | (List 363 | [ Located letPos (Symbol "let") 364 | , letBindings 365 | , ret 366 | ] 367 | ) 368 | ) 369 | ) 370 | 371 | (Located whenPos (Keyword "when")) :: whenCond :: rest -> 372 | expandDoseq 373 | i 374 | (Located loc (Located bindingsPos (Value.vectorFromLocatedList rest) :: body)) 375 | |> Result.map 376 | (\( retI, ret ) -> 377 | ( retI 378 | , Located whenPos 379 | (List 380 | [ Located whenPos (Symbol "do") 381 | , Located whenPos 382 | (List 383 | [ Located whenPos (Symbol "when") 384 | , whenCond 385 | , ret 386 | ] 387 | ) 388 | , Located whenPos Nil 389 | ] 390 | ) 391 | ) 392 | ) 393 | 394 | ((Located mapLoc _) as mapArg) :: mappedSeq :: rest -> 395 | expandDoseq 396 | i 397 | (Located loc (Located bindingsPos (Value.vectorFromLocatedList rest) :: body)) 398 | |> Result.map 399 | (\( retI, ret ) -> 400 | ( retI 401 | , Located mapLoc 402 | (List 403 | [ Located mapLoc (Symbol "do") 404 | , Located mapLoc 405 | (List 406 | [ Located mapLoc (Symbol "map") 407 | , Located mapLoc 408 | (List 409 | [ Located mapLoc (Symbol "fn") 410 | , Located mapLoc (Value.vectorFromLocatedList [ mapArg ]) 411 | , ret 412 | ] 413 | ) 414 | , mappedSeq 415 | ] 416 | ) 417 | , Located mapLoc Nil 418 | ] 419 | ) 420 | ) 421 | ) 422 | 423 | [ _ ] -> 424 | Err (Value.exception "Argument error: uneven number of bindings to doseq") 425 | 426 | [] -> 427 | Ok ( i, Located loc (List (Located loc (Symbol "do") :: body)) ) 428 | 429 | _ -> 430 | Err (Value.exception "Argument error: invalid arguments to doseq") 431 | 432 | 433 | expandFor : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 434 | expandFor i (Located loc args) = 435 | let 436 | id = 437 | "for__" ++ String.fromInt i ++ "__auto__" 438 | in 439 | case args of 440 | ((Located _ (Vector _)) as bindings) :: (Located _ body) :: [] -> 441 | Ok 442 | ( i + 1 443 | , Located loc 444 | (List 445 | [ Located loc (Symbol "let") 446 | , Located loc 447 | (Value.vectorFromList 448 | [ Value.symbol id 449 | , Value.list [ Value.symbol "atom", Value.vectorFromList [] ] 450 | ] 451 | ) 452 | , Located loc 453 | (List 454 | [ Located loc (Symbol "doseq") 455 | , bindings 456 | , Located loc 457 | (Value.list 458 | [ Value.symbol "swap!" 459 | , Value.symbol id 460 | , Value.symbol "conj" 461 | , body 462 | ] 463 | ) 464 | ] 465 | ) 466 | , Located loc (Value.list [ Symbol "deref", Value.symbol id ]) 467 | ] 468 | ) 469 | ) 470 | 471 | _ -> 472 | Err (Value.exception "for expects a vector of bindings followed by the body") 473 | 474 | 475 | expandIfLet : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 476 | expandIfLet i (Located loc args) = 477 | case args of 478 | (Located _ (Vector bindings)) :: branches -> 479 | case Array.toList bindings of 480 | n :: v :: [] -> 481 | Ok 482 | ( i 483 | , Located loc 484 | (List 485 | [ Located loc (Symbol "let") 486 | , Located loc (Vector (Array.fromList [ n, v ])) 487 | , Located loc (List (Located loc (Symbol "if") :: n :: branches)) 488 | ] 489 | ) 490 | ) 491 | 492 | _ -> 493 | Err (Exception "Argument error: more than 2 elements in bindings array to if-let" []) 494 | 495 | _ -> 496 | Err (Exception "Argument error: invalid arguments to if-let" []) 497 | 498 | 499 | expandWhenLet : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 500 | expandWhenLet i (Located loc args) = 501 | case args of 502 | (Located _ (Vector bindings)) :: do -> 503 | case Array.toList bindings of 504 | n :: v :: [] -> 505 | Ok 506 | ( i 507 | , Located loc 508 | (List 509 | [ Located loc (Symbol "let") 510 | , Located loc (Vector (Array.fromList [ n, v ])) 511 | , Located loc (List (Located loc (Symbol "when") :: n :: do)) 512 | ] 513 | ) 514 | ) 515 | 516 | _ -> 517 | Err (Exception "Argument error: more than 2 elements in bindings array to if-let" []) 518 | 519 | _ -> 520 | Err (Exception "Argument error: invalid arguments to when-let" []) 521 | 522 | 523 | expandAnd : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 524 | expandAnd i (Located loc args) = 525 | case args of 526 | (Located _ form) :: rest -> 527 | let 528 | id = 529 | "and__" ++ String.fromInt i ++ "__auto__" 530 | in 531 | Ok <| 532 | ( i + 1 533 | , Located loc 534 | (List 535 | [ Located loc (Symbol "let") 536 | , Located loc (Vector (Array.fromList [ Located loc (Symbol id), Located loc form ])) 537 | , Located loc 538 | (List 539 | [ Located loc (Symbol "if") 540 | , Located loc (Symbol id) 541 | , if List.isEmpty rest then 542 | Located loc (Symbol id) 543 | 544 | else 545 | Located loc (List (Located loc (Symbol "and") :: rest)) 546 | , Located loc (Symbol id) 547 | ] 548 | ) 549 | ] 550 | ) 551 | ) 552 | 553 | [] -> 554 | Ok ( i, Located loc (Bool True) ) 555 | 556 | 557 | expandLoop : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 558 | expandLoop i (Located loc args) = 559 | let 560 | toArgsAndValues argSymbols values bindings = 561 | case bindings of 562 | [] -> 563 | Ok ( List.reverse argSymbols, List.reverse values ) 564 | 565 | a :: v :: rest -> 566 | toArgsAndValues (a :: argSymbols) (v :: values) rest 567 | 568 | _ -> 569 | Err (Value.exception "Uneven number of loop bindings") 570 | in 571 | case args of 572 | (Located _ (Vector bindings)) :: loopBody -> 573 | bindings 574 | |> Array.toList 575 | |> toArgsAndValues [] [] 576 | |> Result.map 577 | (\( argSymbols, argValues ) -> 578 | ( i 579 | , Located loc 580 | (List 581 | (Located loc 582 | (List 583 | (Located loc (Symbol "fn") 584 | :: Located loc (Vector (Array.fromList argSymbols)) 585 | :: loopBody 586 | ) 587 | ) 588 | :: argValues 589 | ) 590 | ) 591 | ) 592 | ) 593 | 594 | _ -> 595 | Err <| Value.exception "Invalid number of arguments to loop" 596 | 597 | 598 | expandOr : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 599 | expandOr i (Located loc args) = 600 | case args of 601 | (Located _ form) :: rest -> 602 | let 603 | id = 604 | "or__" ++ String.fromInt i ++ "__auto__" 605 | in 606 | Ok <| 607 | ( i + 1 608 | , Located loc 609 | (List 610 | [ Located loc (Symbol "let") 611 | , Located loc (Vector (Array.fromList [ Located loc (Symbol id), Located loc form ])) 612 | , Located loc 613 | (List 614 | [ Located loc (Symbol "if") 615 | , Located loc (Symbol id) 616 | , Located loc (Symbol id) 617 | , Located loc (List (Located loc (Symbol "or") :: rest)) 618 | ] 619 | ) 620 | ] 621 | ) 622 | ) 623 | 624 | [] -> 625 | Ok ( i, Located loc Nil ) 626 | 627 | 628 | expandWhen : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 629 | expandWhen i (Located loc args) = 630 | case args of 631 | cond :: rest -> 632 | Ok <| 633 | ( i 634 | , Located loc 635 | (List 636 | [ Located loc (Symbol "if") 637 | , cond 638 | , Located loc 639 | (List 640 | (Located loc (Symbol "do") :: rest) 641 | ) 642 | ] 643 | ) 644 | ) 645 | 646 | [] -> 647 | Err (Exception "Argument error: wrong number of arguments (0) passed to when" []) 648 | 649 | 650 | expandWhenNot : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 651 | expandWhenNot i (Located loc args) = 652 | case args of 653 | cond :: rest -> 654 | Ok <| 655 | ( i 656 | , Located loc 657 | (List 658 | [ Located loc (Symbol "if") 659 | , Located loc (List [ Located loc (Symbol "not"), cond ]) 660 | , Located loc 661 | (List 662 | (Located loc (Symbol "do") :: rest) 663 | ) 664 | ] 665 | ) 666 | ) 667 | 668 | [] -> 669 | Err (Exception "Argument error: wrong number of arguments (0) passed to when-not" []) 670 | 671 | 672 | expandWhile : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 673 | expandWhile i (Located loc args) = 674 | case args of 675 | test :: body -> 676 | Ok 677 | ( i 678 | , Located loc 679 | (List 680 | [ Located loc (Symbol "loop") 681 | , Located loc (Vector Array.empty) 682 | , Located loc 683 | (List 684 | (Located loc (Symbol "when") 685 | :: test 686 | :: Located loc (List (Located loc (Symbol "do") :: body)) 687 | :: [ Located loc (List [ Located loc (Symbol "recur") ]) ] 688 | ) 689 | ) 690 | ] 691 | ) 692 | ) 693 | 694 | _ -> 695 | Err (Value.exception "invalid number of arguments provided to while") 696 | 697 | 698 | expandCase : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 699 | expandCase i (Located loc args) = 700 | case args of 701 | (Located exprLoc expr) :: clauses -> 702 | let 703 | id = 704 | "case__" ++ String.fromInt i ++ "__auto__" 705 | 706 | parseClauses remainingClauses = 707 | case remainingClauses of 708 | (Located testLoc (List tests)) :: ret :: rest -> 709 | Located testLoc 710 | (List 711 | [ Located testLoc (Symbol "or") 712 | , parseClauses (List.concatMap (\test -> [ test, ret ]) tests) 713 | , parseClauses rest 714 | ] 715 | ) 716 | 717 | (Located testLoc test) :: ret :: rest -> 718 | Located testLoc 719 | (List 720 | [ Located testLoc (Symbol "if") 721 | , Located testLoc 722 | (List 723 | [ Located testLoc (Symbol "=") 724 | , Located testLoc (Symbol id) 725 | , Located testLoc 726 | (List 727 | [ Located testLoc (Symbol "quote") 728 | , Located testLoc test 729 | ] 730 | ) 731 | ] 732 | ) 733 | , ret 734 | , parseClauses rest 735 | ] 736 | ) 737 | 738 | [ defaultClause ] -> 739 | defaultClause 740 | 741 | [] -> 742 | Located loc 743 | (List 744 | [ Located loc (Symbol "throw") 745 | , Located loc 746 | (List 747 | [ Located loc (Symbol "Exception.") 748 | , Located loc 749 | (List 750 | [ Located loc (Symbol "str") 751 | , Located loc (String "No matching clause: ") 752 | , Located exprLoc (Symbol id) 753 | ] 754 | ) 755 | ] 756 | ) 757 | ] 758 | ) 759 | in 760 | Ok 761 | ( i + 1 762 | , Located loc 763 | (List 764 | [ Located loc (Symbol "let") 765 | , Located loc 766 | (Vector (Array.fromList [ Located loc (Symbol id), Located loc expr ])) 767 | , parseClauses clauses 768 | ] 769 | ) 770 | ) 771 | 772 | _ -> 773 | Err <| Value.exception "Wrong number of args (0) passed to: case" 774 | 775 | 776 | expandCond : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 777 | expandCond i (Located loc args) = 778 | case args of 779 | (Located letLoc (Keyword "let")) :: bindings :: rest -> 780 | Ok <| 781 | ( i 782 | , Located loc 783 | (List 784 | [ Located letLoc (Symbol "let") 785 | , bindings 786 | , Located loc (List (Located loc (Symbol "cond") :: rest)) 787 | ] 788 | ) 789 | ) 790 | 791 | condForm :: thenForm :: rest -> 792 | Ok <| 793 | ( i 794 | , Located loc 795 | (List 796 | [ Located loc (Symbol "if") 797 | , condForm 798 | , thenForm 799 | , Located loc (List (Located loc (Symbol "cond") :: rest)) 800 | ] 801 | ) 802 | ) 803 | 804 | [ _ ] -> 805 | Err (Exception "compilation error: cond has uneven number of forms" []) 806 | 807 | [] -> 808 | Ok <| ( i, Located loc Nil ) 809 | 810 | 811 | expandThreadFirst : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 812 | expandThreadFirst i (Located loc args) = 813 | case args of 814 | arg :: op :: rest -> 815 | Ok 816 | ( i 817 | , Located loc 818 | (List 819 | (Located loc (Symbol "->") 820 | :: (case op of 821 | Located _ (List forms) -> 822 | (\fn restArgs -> 823 | Located.sameAs fn (List (fn :: arg :: restArgs)) 824 | ) 825 | (List.head forms |> Maybe.withDefault (Located loc Nil)) 826 | (List.tail forms |> Maybe.withDefault []) 827 | 828 | _ -> 829 | Located.sameAs arg (List [ op, arg ]) 830 | ) 831 | :: rest 832 | ) 833 | ) 834 | ) 835 | 836 | [ arg ] -> 837 | Ok ( i, arg ) 838 | 839 | [] -> 840 | Err (Exception "Argument error: wrong number of arguments (0) passed to ->" []) 841 | 842 | 843 | expandThreadLast : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 844 | expandThreadLast i (Located loc args) = 845 | case args of 846 | arg :: op :: rest -> 847 | Ok 848 | ( i 849 | , Located loc 850 | (List 851 | (Located loc (Symbol "->>") 852 | :: (case op of 853 | Located lloc (List forms) -> 854 | Located lloc (List (forms ++ [ arg ])) 855 | 856 | _ -> 857 | Located.sameAs arg (List [ op, arg ]) 858 | ) 859 | :: rest 860 | ) 861 | ) 862 | ) 863 | 864 | [ arg ] -> 865 | Ok ( i, arg ) 866 | 867 | [] -> 868 | Err (Exception "Argument error: wrong number of arguments (0) passed to ->>" []) 869 | 870 | 871 | expandThreadSomeFirst : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 872 | expandThreadSomeFirst i (Located loc args) = 873 | case args of 874 | someArg :: op :: rest -> 875 | let 876 | binding = 877 | Located loc (Symbol ("some->__" ++ String.fromInt i ++ "__auto__")) 878 | in 879 | Ok 880 | ( i + 1 881 | , Located loc 882 | (List 883 | [ Located loc (Symbol "when-let") 884 | , Located loc (Vector (Array.fromList [ binding, someArg ])) 885 | , Located loc 886 | (List 887 | (Located loc (Symbol "some->") 888 | :: (case op of 889 | Located _ (List forms) -> 890 | (\fn restArgs -> 891 | Located.sameAs fn (List (fn :: binding :: restArgs)) 892 | ) 893 | (List.head forms |> Maybe.withDefault (Located loc Nil)) 894 | (List.tail forms |> Maybe.withDefault []) 895 | 896 | _ -> 897 | Located.sameAs binding (List [ op, binding ]) 898 | ) 899 | :: rest 900 | ) 901 | ) 902 | ] 903 | ) 904 | ) 905 | 906 | [ arg ] -> 907 | Ok ( i, arg ) 908 | 909 | [] -> 910 | Err (Exception "Argument error: wrong number of arguments (0) passed to some->" []) 911 | 912 | 913 | expandThreadSomeLast : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 914 | expandThreadSomeLast i (Located loc args) = 915 | case args of 916 | someArg :: op :: rest -> 917 | let 918 | binding = 919 | Located loc (Symbol ("some->>__" ++ String.fromInt i ++ "__auto__")) 920 | in 921 | Ok 922 | ( i + 1 923 | , Located loc 924 | (List 925 | [ Located loc (Symbol "when-let") 926 | , Located loc (Vector (Array.fromList [ binding, someArg ])) 927 | , Located loc 928 | (List 929 | (Located loc (Symbol "some->>") 930 | :: (case op of 931 | Located lloc (List forms) -> 932 | Located lloc (List (forms ++ [ binding ])) 933 | 934 | _ -> 935 | Located.sameAs binding (List [ op, binding ]) 936 | ) 937 | :: rest 938 | ) 939 | ) 940 | ] 941 | ) 942 | ) 943 | 944 | [ arg ] -> 945 | Ok ( i, arg ) 946 | 947 | [] -> 948 | Err (Exception "Argument error: wrong number of arguments (0) passed to some->>" []) 949 | 950 | 951 | walk : a -> (a -> Located (Value io) -> Result (Located Exception) ( a, Located (Value io) )) -> Located (Value io) -> Result (Located Exception) ( a, Located (Value io) ) 952 | walk state f (Located loc val) = 953 | case val of 954 | List l -> 955 | l 956 | |> List.foldr (\e a -> a |> Result.andThen (\( aState, av ) -> walk aState f e |> Result.map (\( nState, v ) -> ( nState, v :: av )))) (Ok ( state, [] )) 957 | |> Result.map (\( s, r ) -> ( s, Located loc (List r) )) 958 | 959 | Vector l -> 960 | l 961 | |> Array.foldl (\e a -> a |> Result.andThen (\( aState, av ) -> walk aState f e |> Result.map (\( nState, v ) -> ( nState, Array.push v av )))) (Ok ( state, Array.empty )) 962 | |> Result.map (\( s, r ) -> ( s, Located loc (Vector r) )) 963 | 964 | Map m -> 965 | m 966 | |> ValueMap.toList 967 | |> List.foldr 968 | (\( mapKey, mapVal ) a -> 969 | a 970 | |> Result.andThen 971 | (\( aState, av ) -> 972 | walk aState f mapVal |> Result.map (\( nState, v ) -> ( nState, ( mapKey, v ) :: av )) 973 | ) 974 | ) 975 | (Ok ( state, [] )) 976 | |> Result.map (\( s, r ) -> ( s, Located loc (Map (ValueMap.fromList r)) )) 977 | 978 | _ -> 979 | f state (Located loc val) 980 | 981 | 982 | type alias Arguments = 983 | { positional : Dict Int String 984 | , variadic : Maybe String 985 | } 986 | 987 | 988 | expandLambda : Int -> Located (List (Located (Value io))) -> Result Exception ( Int, Located (Value io) ) 989 | expandLambda i (Located loc body) = 990 | case body of 991 | [] -> 992 | Ok ( i, Located loc (List [ Located loc (Symbol "fn"), Located loc (Vector Array.empty), Located loc (List []) ]) ) 993 | 994 | exprs -> 995 | case substituteLambdaArgs i exprs of 996 | Ok ( ( newI, args ), newExprs ) -> 997 | let 998 | ( finalI, completedArgs ) = 999 | completeArguments newI args 1000 | in 1001 | Ok ( finalI, Located loc (List [ Located loc (Symbol "fn"), Located loc (argsToValue (Located loc completedArgs)), Located loc (List newExprs) ]) ) 1002 | 1003 | Err e -> 1004 | Err (Located.getValue e) 1005 | 1006 | 1007 | completeArguments : Int -> Arguments -> ( Int, Arguments ) 1008 | completeArguments startI arguments = 1009 | let 1010 | maxPositional = 1011 | List.maximum (Dict.keys arguments.positional) |> Maybe.withDefault 0 1012 | in 1013 | List.range 1 maxPositional 1014 | |> List.foldr 1015 | (\e ( i, a ) -> 1016 | let 1017 | ( newI, id ) = 1018 | a.positional 1019 | |> Dict.get e 1020 | |> Maybe.map (Tuple.pair i) 1021 | |> Maybe.withDefault ( i + 1, "p" ++ String.fromInt e ++ "__" ++ String.fromInt i ) 1022 | in 1023 | ( newI, { a | positional = Dict.insert e id a.positional } ) 1024 | ) 1025 | ( startI, arguments ) 1026 | 1027 | 1028 | argsToValue : Located Arguments -> Value io 1029 | argsToValue (Located loc arguments) = 1030 | let 1031 | positional = 1032 | arguments.positional 1033 | |> Dict.toList 1034 | |> List.sortBy Tuple.first 1035 | |> List.map (Tuple.second >> Symbol >> Located loc) 1036 | 1037 | variadic = 1038 | arguments.variadic |> Maybe.map (Symbol >> Located loc >> List.singleton >> (++) [ Located loc (Symbol "&") ]) |> Maybe.withDefault [] 1039 | in 1040 | Vector (Array.fromList (positional ++ variadic)) 1041 | 1042 | 1043 | substituteLambdaArgsWalker : ( Int, Arguments ) -> Located (Value io) -> Result (Located Exception) ( ( Int, Arguments ), Located (Value io) ) 1044 | substituteLambdaArgsWalker ( i, args ) (Located loc expr) = 1045 | case expr of 1046 | Symbol "__lambda" -> 1047 | Err (Located loc (Exception "Parsing error: nested #() are not supported, use fn instead." [])) 1048 | 1049 | Symbol "%&" -> 1050 | let 1051 | ( newI, id ) = 1052 | args.variadic |> Maybe.map (Tuple.pair i) |> Maybe.withDefault ( i + 1, "rest__" ++ String.fromInt i ) 1053 | in 1054 | Ok ( ( newI, { args | variadic = Just id } ), Located loc (Symbol id) ) 1055 | 1056 | Symbol name -> 1057 | let 1058 | argN = 1059 | if name == "%" then 1060 | Just 1 1061 | 1062 | else if String.startsWith "%" name then 1063 | String.toInt (String.dropLeft 1 name) 1064 | |> Maybe.andThen 1065 | (\n -> 1066 | if n < 1 then 1067 | Nothing 1068 | 1069 | else 1070 | Just n 1071 | ) 1072 | 1073 | else 1074 | Nothing 1075 | in 1076 | case argN of 1077 | Just n -> 1078 | let 1079 | ( newI, id ) = 1080 | Dict.get n args.positional |> Maybe.map (Tuple.pair i) |> Maybe.withDefault ( i + 1, "p" ++ String.fromInt n ++ "__" ++ String.fromInt i ) 1081 | in 1082 | Ok ( ( newI, { args | positional = Dict.insert n id args.positional } ), Located loc (Symbol id) ) 1083 | 1084 | Nothing -> 1085 | Ok ( ( i, args ), Located loc expr ) 1086 | 1087 | _ -> 1088 | Ok ( ( i, args ), Located loc expr ) 1089 | 1090 | 1091 | substituteLambdaArgs : Int -> List (Located (Value io)) -> Result (Located Exception) ( ( Int, Arguments ), List (Located (Value io)) ) 1092 | substituteLambdaArgs i exprs = 1093 | let 1094 | startState = 1095 | ( i, { positional = Dict.empty, variadic = Nothing } ) 1096 | in 1097 | exprs 1098 | |> List.foldr 1099 | (\e a -> a |> Result.andThen (\( aState, av ) -> walk aState substituteLambdaArgsWalker e |> Result.map (\( nState, v ) -> ( nState, v :: av )))) 1100 | (Ok ( startState, [] )) 1101 | -------------------------------------------------------------------------------- /src/Enclojure/Runtime.elm: -------------------------------------------------------------------------------- 1 | module Enclojure.Runtime exposing 2 | ( emptyEnv, bindGlobal, bindLexical, fetchGlobal, fetchLexical, setCurrentStackFrameLocation 3 | , prettyTrace, throw 4 | , const, sideEffect 5 | , addAtom, deref, resetAtom 6 | , apply, terminate 7 | ) 8 | 9 | {-| Advanced functions for working with Enclojure runtime. 10 | 11 | 12 | # Environment 13 | 14 | @docs emptyEnv, bindGlobal, bindLexical, fetchGlobal, fetchLexical, setCurrentStackFrameLocation 15 | 16 | 17 | # Exceptions 18 | 19 | @docs prettyTrace, throw 20 | 21 | 22 | # I/O 23 | 24 | @docs const, sideEffect 25 | 26 | 27 | # References 28 | 29 | @docs addAtom, deref, resetAtom 30 | 31 | 32 | # Misc 33 | 34 | @docs apply, terminate 35 | 36 | -} 37 | 38 | import Dict 39 | import Enclojure.Callable as Callable 40 | import Enclojure.Common as Common 41 | exposing 42 | ( Arity(..) 43 | , Callable 44 | , Continuation 45 | , Env 46 | , Exception(..) 47 | , IO(..) 48 | , Number(..) 49 | , Ref(..) 50 | , Step 51 | , Thunk(..) 52 | , Value(..) 53 | ) 54 | import Enclojure.Located as Located exposing (Located(..)) 55 | import Enclojure.Reader as Reader 56 | import Enclojure.Value as Value 57 | import Enclojure.ValueMap as ValueMap exposing (ValueMap) 58 | import Enclojure.ValueSet as ValueSet exposing (ValueSet) 59 | 60 | 61 | emptyCallable : Callable io 62 | emptyCallable = 63 | Callable.new 64 | 65 | 66 | {-| Returns an empty environment 67 | -} 68 | emptyEnv : Env io 69 | emptyEnv = 70 | { globalScope = Dict.empty 71 | , lexicalScope = Dict.empty 72 | , atoms = Dict.empty 73 | , atomIdGenerator = 0 74 | , stack = [ { name = "user", location = Located.Unknown } ] 75 | } 76 | 77 | 78 | {-| Binds a given `String` name to `Value io` in the lexical scope of `Env io` 79 | -} 80 | bindLexical : String -> Value io -> Env io -> Env io 81 | bindLexical key value env = 82 | { env | lexicalScope = Dict.insert key value env.lexicalScope } 83 | 84 | 85 | {-| Binds a given `String` name to `Value io` in the global scope of `Env io`. 86 | -} 87 | bindGlobal : String -> Value io -> Env io -> Env io 88 | bindGlobal key value env = 89 | { env | globalScope = Dict.insert key value env.globalScope } 90 | 91 | 92 | {-| Adds a new atom containing a provided value to the environment. Returns a tuple of the updated environment and the 93 | generated atom id. 94 | -} 95 | addAtom : Value io -> Env io -> ( Env io, Int ) 96 | addAtom val env = 97 | let 98 | atomId = 99 | env.atomIdGenerator 100 | 101 | newEnv = 102 | { env 103 | | atoms = Dict.insert atomId val env.atoms 104 | , atomIdGenerator = atomId + 1 105 | } 106 | in 107 | ( newEnv, atomId ) 108 | 109 | 110 | {-| Fetches a value by name from the global scope 111 | -} 112 | fetchGlobal : String -> Env io -> Maybe (Value io) 113 | fetchGlobal name env = 114 | Dict.get name env.globalScope 115 | 116 | 117 | {-| Fetches a value by name from the lexical scope 118 | -} 119 | fetchLexical : String -> Env io -> Maybe (Value io) 120 | fetchLexical name env = 121 | Dict.get name env.lexicalScope 122 | 123 | 124 | {-| Dereferences given `Ref io` in `Env io`. 125 | -} 126 | deref : Ref io -> Env io -> Value io 127 | deref ref env = 128 | case ref of 129 | Var _ value -> 130 | value 131 | 132 | Atom atomId -> 133 | Dict.get atomId env.atoms |> Maybe.withDefault Nil 134 | 135 | 136 | {-| Resets an atom identified by `Int` id to value `Value io` in the given environment `Env io`. 137 | -} 138 | resetAtom : Int -> Value io -> Env io -> Env io 139 | resetAtom atomId val env = 140 | { env | atoms = Dict.insert atomId val env.atoms } 141 | 142 | 143 | getFn : String -> Callable io 144 | getFn key = 145 | let 146 | arity1 mapVal = 147 | arity2 ( mapVal, Nil ) 148 | 149 | arity2 ( mapVal, default ) = 150 | (case mapVal of 151 | Map m -> 152 | ValueMap.get (Keyword key) m |> Maybe.map Located.getValue 153 | 154 | Set s -> 155 | if ValueSet.member (Keyword key) s then 156 | Just (Keyword key) 157 | 158 | else 159 | Nothing 160 | 161 | Nil -> 162 | Nothing 163 | 164 | _ -> 165 | Just Nil 166 | ) 167 | |> Maybe.withDefault default 168 | in 169 | { emptyCallable 170 | | arity1 = Just <| Fixed (Symbol "coll") <| Callable.toArityFunction (arity1 >> Const >> Ok) 171 | , arity2 = Just <| Fixed ( Symbol "coll", Symbol "not-found" ) <| Callable.toArityFunction (arity2 >> Const >> Ok) 172 | } 173 | 174 | 175 | setLookupFn : ValueSet io -> Callable io 176 | setLookupFn set = 177 | let 178 | arity1 val = 179 | if ValueSet.member val set then 180 | val 181 | 182 | else 183 | Nil 184 | in 185 | { emptyCallable 186 | | arity1 = Just <| Fixed (Symbol "x") <| Callable.toArityFunction (arity1 >> Const >> Ok) 187 | } 188 | 189 | 190 | mapLookupFn : ValueMap io -> Callable io 191 | mapLookupFn map = 192 | let 193 | arity1 val = 194 | ValueMap.get val map |> Maybe.map Located.getValue |> Maybe.withDefault Nil 195 | in 196 | { emptyCallable 197 | | arity1 = Just <| Fixed (Symbol "key") <| Callable.toArityFunction (arity1 >> Const >> Ok) 198 | } 199 | 200 | 201 | {-| Attempts to interpret the first argument as a function and the second argument as a list of its arguments. 202 | -} 203 | apply : Located (Value io) -> Located (Value io) -> Env io -> Continuation io -> Located (Step io) 204 | apply ((Located fnLoc fnExpr) as fn) arg inputEnv inputK = 205 | let 206 | currentStack = 207 | inputEnv.stack 208 | |> List.head 209 | |> Maybe.map (\frame -> { frame | location = fnLoc } :: List.drop 1 inputEnv.stack) 210 | |> Maybe.withDefault inputEnv.stack 211 | 212 | k = 213 | \v kEnv -> inputK v { kEnv | stack = List.drop 1 kEnv.stack } 214 | in 215 | case fnExpr of 216 | Fn { name } callable -> 217 | let 218 | env = 219 | { inputEnv 220 | | stack = 221 | { name = name |> Maybe.withDefault "fn" 222 | , location = fnLoc 223 | } 224 | :: currentStack 225 | } 226 | in 227 | ( Ok ( Const <| Located.getValue arg, env ), Just (callable { self = fnExpr, k = k }) ) 228 | |> Located.sameAs arg 229 | 230 | Keyword key -> 231 | let 232 | env = 233 | { inputEnv 234 | | stack = 235 | { name = key 236 | , location = fnLoc 237 | } 238 | :: currentStack 239 | } 240 | in 241 | ( Ok ( Const <| Located.getValue arg, env ), Just (Common.toThunk (getFn key) { self = fnExpr, k = k }) ) 242 | |> Located.sameAs arg 243 | 244 | Map map -> 245 | let 246 | env = 247 | { inputEnv 248 | | stack = 249 | { name = "Map" 250 | , location = fnLoc 251 | } 252 | :: currentStack 253 | } 254 | in 255 | ( Ok ( Const <| Located.getValue arg, env ), Just (Common.toThunk (mapLookupFn map) { self = fnExpr, k = k }) ) 256 | |> Located.sameAs arg 257 | 258 | Set set -> 259 | let 260 | env = 261 | { inputEnv 262 | | stack = 263 | { name = "Set" 264 | , location = fnLoc 265 | } 266 | :: currentStack 267 | } 268 | in 269 | ( Ok ( Const <| Located.getValue arg, env ), Just (Common.toThunk (setLookupFn set) { self = fnExpr, k = k }) ) 270 | |> Located.sameAs arg 271 | 272 | _ -> 273 | ( Err 274 | ( Value.exception (Value.inspectLocated fn ++ " is not a valid callable.") |> throw inputEnv 275 | , inputEnv 276 | ) 277 | , Just (Thunk k) 278 | ) 279 | |> Located fnLoc 280 | 281 | 282 | setStackTrace : List Common.StackFrame -> Exception -> Exception 283 | setStackTrace stack (Exception msg _) = 284 | Exception msg stack 285 | 286 | 287 | {-| Overwrites the location of the current stack frame in a given environment. 288 | -} 289 | setCurrentStackFrameLocation : Located.Location -> Env io -> Env io 290 | setCurrentStackFrameLocation location env = 291 | let 292 | newStack = 293 | env.stack 294 | |> List.head 295 | |> Maybe.map (\currentFrame -> { currentFrame | location = location } :: List.drop 1 env.stack) 296 | |> Maybe.withDefault env.stack 297 | in 298 | { env | stack = newStack } 299 | 300 | 301 | {-| Return a "prettified" stack trace for an exception. 302 | -} 303 | prettyTrace : Exception -> List String 304 | prettyTrace (Exception _ trace) = 305 | trace 306 | |> List.map 307 | (\frame -> 308 | frame.name 309 | ++ (case frame.location of 310 | Located.Unknown -> 311 | "" 312 | 313 | Located.Known { start } -> 314 | ":" ++ (Tuple.first start |> String.fromInt) 315 | ) 316 | ) 317 | 318 | 319 | {-| Assigns the stack from the given environment to the exception. 320 | -} 321 | throw : Env io -> Exception -> Exception 322 | throw env (Exception msg _) = 323 | Exception msg env.stack 324 | 325 | 326 | {-| Indicates that the returned value is a side effect. 327 | -} 328 | sideEffect : io -> IO io 329 | sideEffect = 330 | SideEffect 331 | 332 | 333 | {-| Indicates that the returned value is a constant. 334 | -} 335 | const : Value io -> IO io 336 | const = 337 | Const 338 | 339 | 340 | {-| Returns a continuation that terminates the program. 341 | -} 342 | terminate : Continuation io 343 | terminate (Located pos v) env = 344 | Located pos ( Ok ( Const v, env ), Nothing ) 345 | -------------------------------------------------------------------------------- /src/Enclojure/Value.elm: -------------------------------------------------------------------------------- 1 | module Enclojure.Value exposing 2 | ( Value 3 | , inspect, inspectLocated, inspectType, isEqual, isTruthy 4 | , toMap, toSeq, toString 5 | , boolean, exception, float, fn, int, keyword, list, map, nil, string, symbol, throwable, vector, vectorFromList, vectorFromLocatedList 6 | , tryAtom, tryBool, tryDictOf, tryFloat, tryInt, tryKeyword, tryList, tryListOf, tryMap, tryNil, tryOneOf, tryPatternOf2, tryRef, tryRegex, trySequenceOf, tryString, trySymbol, tryVector, tryVectorOf 7 | ) 8 | 9 | {-| Functions for working with Enclojure values and translating between Elm and Enclojure types. 10 | 11 | 12 | # Value type 13 | 14 | @docs Value 15 | 16 | 17 | # Inspecting values 18 | 19 | @docs inspect, inspectLocated, inspectType, isEqual, isTruthy 20 | 21 | 22 | # Transforming values 23 | 24 | @docs toMap, toSeq, toString 25 | 26 | 27 | # Encoding values 28 | 29 | @docs boolean, exception, float, fn, int, keyword, list, map, nil, string, symbol, throwable, vector, vectorFromList, vectorFromLocatedList 30 | 31 | 32 | # Decoding values 33 | 34 | @docs tryAtom, tryBool, tryDictOf, tryFloat, tryInt, tryKeyword, tryList, tryListOf, tryMap, tryNil, tryOneOf, tryPatternOf2, tryRef, tryRegex, trySequenceOf, tryString, trySymbol, tryVector, tryVectorOf 35 | 36 | -} 37 | 38 | import Array 39 | import Dict 40 | import Enclojure.Common as Common exposing (Callable, Exception(..), Number(..), Ref(..), Value(..)) 41 | import Enclojure.Located as Located exposing (Located(..)) 42 | import Enclojure.ValueMap as ValueMap exposing (ValueMap) 43 | import Enclojure.ValueSet as ValueSet 44 | import Regex exposing (Regex) 45 | 46 | 47 | {-| Represents an Enclojure value. 48 | -} 49 | type alias Value io = 50 | Common.Value io 51 | 52 | 53 | {-| Attempts to interpret a given value as a sequence (list). 54 | -} 55 | toSeq : Value io -> Result Exception (List (Located (Value io))) 56 | toSeq val = 57 | case val of 58 | List l -> 59 | Ok l 60 | 61 | Vector v -> 62 | Ok <| Array.toList v 63 | 64 | Set s -> 65 | Ok <| List.map Located.unknown <| ValueSet.toList s 66 | 67 | Map m -> 68 | Ok <| List.map (\(( _, Located loc _ ) as entry) -> Located loc (MapEntry entry)) (ValueMap.toList m) 69 | 70 | String s -> 71 | Ok <| List.map (String.fromChar >> String >> Located.unknown) (String.toList s) 72 | 73 | MapEntry ( k, v ) -> 74 | Ok <| [ Located.sameAs v k, v ] 75 | 76 | Nil -> 77 | Ok [] 78 | 79 | _ -> 80 | Err <| Exception (inspect val ++ " is not a sequence") [] 81 | 82 | 83 | {-| Attempts to interpret a given value as a map. 84 | -} 85 | toMap : Value io -> Maybe (ValueMap io) 86 | toMap val = 87 | case val of 88 | Nil -> 89 | Just ValueMap.empty 90 | 91 | Vector vec -> 92 | Array.toList vec |> List.indexedMap (\i e -> ( Number <| Int i, e )) |> ValueMap.fromList |> Just 93 | 94 | Map m -> 95 | Just m 96 | 97 | _ -> 98 | Nothing 99 | 100 | 101 | {-| Returns a string if the given value is a string. 102 | -} 103 | tryString : Value io -> Maybe String 104 | tryString value = 105 | case value of 106 | String s -> 107 | Just s 108 | 109 | _ -> 110 | Nothing 111 | 112 | 113 | {-| Returns a bool if the given value is a string. 114 | -} 115 | tryBool : Value io -> Maybe Bool 116 | tryBool value = 117 | case value of 118 | Bool s -> 119 | Just s 120 | 121 | _ -> 122 | Nothing 123 | 124 | 125 | {-| Returns a ref if the given value is a ref. 126 | -} 127 | tryRef : Value io -> Maybe (Ref io) 128 | tryRef value = 129 | case value of 130 | Ref ref -> 131 | Just ref 132 | 133 | _ -> 134 | Nothing 135 | 136 | 137 | {-| Returns an atom id if the given value is an atom ref. 138 | -} 139 | tryAtom : Value io -> Maybe Int 140 | tryAtom value = 141 | case value of 142 | Ref (Atom id) -> 143 | Just id 144 | 145 | _ -> 146 | Nothing 147 | 148 | 149 | {-| Returns a regex if the given value is a regex. 150 | -} 151 | tryRegex : Value io -> Maybe Regex 152 | tryRegex value = 153 | case value of 154 | Regex _ r -> 155 | Just r 156 | 157 | _ -> 158 | Nothing 159 | 160 | 161 | {-| Returns a keyword as a string if the given value is a keyword. 162 | -} 163 | tryKeyword : Value io -> Maybe String 164 | tryKeyword value = 165 | case value of 166 | Keyword s -> 167 | Just s 168 | 169 | _ -> 170 | Nothing 171 | 172 | 173 | {-| Returns a symbol as a string if the given value is a symbol. 174 | -} 175 | trySymbol : Value io -> Maybe String 176 | trySymbol value = 177 | case value of 178 | Symbol s -> 179 | Just s 180 | 181 | _ -> 182 | Nothing 183 | 184 | 185 | {-| Returns a `ValueMap io` if the given value is a map. 186 | -} 187 | tryMap : Value io -> Maybe (ValueMap io) 188 | tryMap value = 189 | case value of 190 | Map s -> 191 | Just s 192 | 193 | _ -> 194 | Nothing 195 | 196 | 197 | {-| Returns a float if the given value is a float. 198 | -} 199 | tryFloat : Value io -> Maybe Float 200 | tryFloat value = 201 | case value of 202 | Number (Float n) -> 203 | Just n 204 | 205 | _ -> 206 | Nothing 207 | 208 | 209 | {-| Returns an integer if the given value is an integer. 210 | -} 211 | tryInt : Value io -> Maybe Int 212 | tryInt value = 213 | case value of 214 | Number (Int n) -> 215 | Just n 216 | 217 | _ -> 218 | Nothing 219 | 220 | 221 | {-| Returns an empty tuple if the given value is nil. 222 | -} 223 | tryNil : Value io -> Maybe () 224 | tryNil value = 225 | case value of 226 | Nil -> 227 | Just () 228 | 229 | _ -> 230 | Nothing 231 | 232 | 233 | {-| If the value is a map, attempts to convert it to an Elm dictionary using the first argument to convert values to 234 | keys and the second argument to convert values. 235 | -} 236 | tryDictOf : (Value io -> Maybe comparable) -> (Value io -> Maybe b) -> Value io -> Maybe (Dict.Dict comparable b) 237 | tryDictOf extractKey extractValue value = 238 | let 239 | extractAllKv kvSequence = 240 | kvSequence 241 | |> List.foldr 242 | (\( key, val ) a -> 243 | a 244 | |> Maybe.andThen 245 | (\acc -> 246 | Maybe.map2 247 | (\extractedKey extractedVal -> ( extractedKey, extractedVal ) :: acc) 248 | (extractKey key) 249 | (extractValue (Located.getValue val)) 250 | ) 251 | ) 252 | (Just []) 253 | in 254 | case value of 255 | Map m -> 256 | m |> ValueMap.toList |> extractAllKv |> Maybe.map Dict.fromList 257 | 258 | _ -> 259 | Nothing 260 | 261 | 262 | extractAll : (Value io -> Maybe a) -> List (Value io) -> Maybe (List a) 263 | extractAll extract sequence = 264 | sequence 265 | |> List.foldr 266 | (\e a -> 267 | a 268 | |> Maybe.andThen 269 | (\acc -> 270 | extract e 271 | |> Maybe.map (\extracted -> extracted :: acc) 272 | ) 273 | ) 274 | (Just []) 275 | 276 | 277 | {-| Returns an array of values if the given value is a vector. 278 | -} 279 | tryVector : Value io -> Maybe (Array.Array (Located (Value io))) 280 | tryVector value = 281 | case value of 282 | Vector v -> 283 | Just v 284 | 285 | _ -> 286 | Nothing 287 | 288 | 289 | {-| If the given value is a vector, returns a list of `a` using the first argument as a function to interpret vector 290 | values as `a`. 291 | -} 292 | tryVectorOf : (Value io -> Maybe a) -> Value io -> Maybe (List a) 293 | tryVectorOf extract value = 294 | case value of 295 | Vector v -> 296 | Array.toList v 297 | |> List.map Located.getValue 298 | |> extractAll extract 299 | 300 | _ -> 301 | Nothing 302 | 303 | 304 | {-| Returns a list of values if the given value is a list 305 | -} 306 | tryList : Value io -> Maybe (List (Located (Value io))) 307 | tryList value = 308 | case value of 309 | List l -> 310 | Just l 311 | 312 | _ -> 313 | Nothing 314 | 315 | 316 | {-| If the given value is a list, returns a list of `a` using the first argument as a function to interpret list 317 | values as `a`. 318 | -} 319 | tryListOf : (Value io -> Maybe a) -> Value io -> Maybe (List a) 320 | tryListOf extract value = 321 | case value of 322 | List l -> 323 | l 324 | |> List.map Located.getValue 325 | |> extractAll extract 326 | 327 | _ -> 328 | Nothing 329 | 330 | 331 | {-| If the given value can be interpreted as a sequence, returns a list of `a` using the first argument as a function 332 | to interpret list values as `a`. 333 | -} 334 | trySequenceOf : (Value io -> Maybe a) -> Value io -> Maybe (List a) 335 | trySequenceOf extract value = 336 | toSeq value 337 | |> Result.map (List.map Located.getValue) 338 | |> Result.toMaybe 339 | |> Maybe.andThen (extractAll extract) 340 | 341 | 342 | {-| Attempts to interpret the given value as `a` as one of the given "decoders". 343 | -} 344 | tryOneOf : List (Value io -> Maybe a) -> Value io -> Maybe a 345 | tryOneOf decoders value = 346 | case decoders of 347 | [] -> 348 | Nothing 349 | 350 | decoder :: rest -> 351 | case decoder value of 352 | Just v -> 353 | Just v 354 | 355 | Nothing -> 356 | tryOneOf rest value 357 | 358 | 359 | {-| Attempts to interpret a list of values as a pattern of two values of known type and the rest. 360 | -} 361 | tryPatternOf2 : (a -> b -> List (Value io) -> Maybe c) -> (Value io -> Maybe a) -> (Value io -> Maybe b) -> List (Value io) -> Maybe c 362 | tryPatternOf2 combine matchA matchB values = 363 | case values of 364 | a :: b :: rest -> 365 | Maybe.map2 366 | (\matchedA matchedB -> 367 | combine matchedA matchedB rest 368 | ) 369 | (matchA a) 370 | (matchB b) 371 | |> Maybe.andThen identity 372 | 373 | _ -> 374 | Nothing 375 | 376 | 377 | {-| Creates an exception with a given message. 378 | -} 379 | exception : String -> Exception 380 | exception message = 381 | Exception message [] 382 | 383 | 384 | {-| Prints a value with location information. 385 | -} 386 | inspectLocated : Located (Value io) -> String 387 | inspectLocated locatedValue = 388 | let 389 | suffix = 390 | locatedValue 391 | |> Located.getOffsets 392 | |> Maybe.map (\{ start } -> ":" ++ String.fromInt (Tuple.first start) ++ ":" ++ String.fromInt (Tuple.second start)) 393 | |> Maybe.withDefault "" 394 | in 395 | inspect (Located.getValue locatedValue) ++ suffix 396 | 397 | 398 | {-| Print value in a human readable way. 399 | -} 400 | inspect : Value io -> String 401 | inspect value = 402 | case value of 403 | Ref ref -> 404 | case ref of 405 | Atom id -> 406 | "" 407 | 408 | Var name _ -> 409 | "#'" ++ name 410 | 411 | String s -> 412 | "\"" ++ s ++ "\"" 413 | 414 | Number (Int x) -> 415 | String.fromInt x 416 | 417 | Number (Float x) -> 418 | String.fromFloat x 419 | 420 | Fn { name } _ -> 421 | "fn<" ++ (name |> Maybe.withDefault "anonymous") ++ ">" 422 | 423 | List l -> 424 | "(" ++ (List.map (Located.getValue >> inspect) l |> String.join " ") ++ ")" 425 | 426 | Nil -> 427 | "nil" 428 | 429 | Bool b -> 430 | if b then 431 | "true" 432 | 433 | else 434 | "false" 435 | 436 | Vector l -> 437 | "[" ++ (List.map (Located.getValue >> inspect) (Array.toList l) |> String.join " ") ++ "]" 438 | 439 | Keyword name -> 440 | ":" ++ name 441 | 442 | Map m -> 443 | List.map (\( k, Located _ v ) -> inspect k ++ " " ++ inspect v) (ValueMap.toList m) 444 | |> String.join ", " 445 | |> (\r -> "{" ++ r ++ "}") 446 | 447 | MapEntry ( k, v ) -> 448 | inspect (Vector (Array.fromList [ Located.unknown k, v ])) 449 | 450 | Regex s _ -> 451 | "#" ++ s 452 | 453 | Set set -> 454 | List.map (\v -> inspect v) (ValueSet.toList set) 455 | |> String.join ", " 456 | |> (\r -> "#{" ++ r ++ "}") 457 | 458 | Symbol name -> 459 | name 460 | 461 | Throwable (Exception str _) -> 462 | "Exception: " ++ str 463 | 464 | 465 | {-| Prints a value as a string. 466 | -} 467 | print : Value io -> String 468 | print value = 469 | case value of 470 | String s -> 471 | s 472 | 473 | Nil -> 474 | "" 475 | 476 | _ -> 477 | inspect value 478 | 479 | 480 | {-| Attempts to intrpret a value as a string. 481 | -} 482 | toString : Value io -> String 483 | toString value = 484 | case value of 485 | String s -> 486 | s 487 | 488 | _ -> 489 | print value 490 | 491 | 492 | {-| Wraps a float as a number value. 493 | -} 494 | float : Float -> Value io 495 | float n = 496 | Number <| Float n 497 | 498 | 499 | {-| Wraps an int as a number value. 500 | -} 501 | int : Int -> Value io 502 | int n = 503 | Number <| Int n 504 | 505 | 506 | {-| Wraps a string as a string value. 507 | -} 508 | string : String -> Value io 509 | string = 510 | String 511 | 512 | 513 | {-| Wraps a string as a keyword value. 514 | -} 515 | keyword : String -> Value io 516 | keyword = 517 | Keyword 518 | 519 | 520 | {-| Wraps a string as a symbol value. 521 | -} 522 | symbol : String -> Value io 523 | symbol = 524 | Symbol 525 | 526 | 527 | {-| Returns a nil value. 528 | -} 529 | nil : Value io 530 | nil = 531 | Nil 532 | 533 | 534 | {-| Returns a boolean value for a given Elm Bool. 535 | -} 536 | boolean : Bool -> Value io 537 | boolean = 538 | Bool 539 | 540 | 541 | {-| Wraps a value map as a map value. 542 | -} 543 | map : ValueMap io -> Value io 544 | map = 545 | Map 546 | 547 | 548 | {-| Wraps a list as a list value. 549 | -} 550 | list : List (Value io) -> Value io 551 | list vs = 552 | List <| List.map Located.unknown vs 553 | 554 | 555 | {-| Wraps a located list as a vector value. 556 | -} 557 | vectorFromLocatedList : List (Located (Value io)) -> Value io 558 | vectorFromLocatedList ls = 559 | Vector <| Array.fromList ls 560 | 561 | 562 | {-| Wraps a list as a vector value. 563 | -} 564 | vectorFromList : List (Value io) -> Value io 565 | vectorFromList ls = 566 | Vector <| Array.fromList <| List.map Located.unknown ls 567 | 568 | 569 | {-| Wraps an array as a vector value. 570 | -} 571 | vector : Array.Array (Value io) -> Value io 572 | vector = 573 | Vector << Array.map Located.unknown 574 | 575 | 576 | {-| Wraps an (optionally named) function as a value. 577 | -} 578 | fn : Maybe String -> Callable io -> Value io 579 | fn name callable = 580 | Fn { name = name, doc = Nothing, signatures = [] } (Common.toThunk callable) 581 | 582 | 583 | {-| Wraps an exception into a value. 584 | -} 585 | throwable : Exception -> Value io 586 | throwable = 587 | Throwable 588 | 589 | 590 | {-| Returns True if the two values are equal. 591 | -} 592 | isEqual : Value io -> Value io -> Bool 593 | isEqual = 594 | Common.areEqualValues 595 | 596 | 597 | {-| Return a string representation of the value type 598 | -} 599 | inspectType : Value io -> String 600 | inspectType val = 601 | case val of 602 | Number n -> 603 | case n of 604 | Int _ -> 605 | "Integer" 606 | 607 | Float _ -> 608 | "Float" 609 | 610 | String _ -> 611 | "String" 612 | 613 | Ref r -> 614 | case r of 615 | Atom _ -> 616 | "Atom" 617 | 618 | Var _ _ -> 619 | "Var" 620 | 621 | Fn _ _ -> 622 | "Function" 623 | 624 | List _ -> 625 | "List" 626 | 627 | Vector _ -> 628 | "Vector" 629 | 630 | Nil -> 631 | "Nil" 632 | 633 | Bool _ -> 634 | "Bool" 635 | 636 | Keyword _ -> 637 | "Keyword" 638 | 639 | Map _ -> 640 | "Map" 641 | 642 | MapEntry _ -> 643 | "MapEntry" 644 | 645 | Regex _ _ -> 646 | "Regex" 647 | 648 | Set _ -> 649 | "Set" 650 | 651 | Symbol _ -> 652 | "Symbol" 653 | 654 | Throwable _ -> 655 | "Throwable" 656 | 657 | 658 | {-| Returns True if the value is truthy. 659 | -} 660 | isTruthy : Value io -> Bool 661 | isTruthy val = 662 | case val of 663 | Nil -> 664 | False 665 | 666 | Bool False -> 667 | False 668 | 669 | _ -> 670 | True 671 | -------------------------------------------------------------------------------- /src/Enclojure/ValueKeyMap.elm: -------------------------------------------------------------------------------- 1 | module Enclojure.ValueKeyMap exposing 2 | ( ValueKeyMap, ValueKeyMapEntry, empty, fromList 3 | , get, keys, values, toList 4 | , foldl, insert, map, remove 5 | , isEmpty, member 6 | ) 7 | 8 | {-| Represents a dictionary-like type where the keys are Enclojure values and values are arbitrary Elm types. 9 | Used internally by `ValueMap io`. 10 | 11 | 12 | # Creating 13 | 14 | @docs ValueKeyMap, ValueKeyMapEntry, empty, fromList 15 | 16 | 17 | # Accessing values 18 | 19 | @docs get, keys, values, toList 20 | 21 | 22 | # Modifying 23 | 24 | @docs foldl, insert, map, remove 25 | 26 | 27 | # Predicates 28 | 29 | @docs isEmpty, member 30 | 31 | -} 32 | 33 | import Dict 34 | import Enclojure.Common exposing (Number(..), Value(..), ValueMap(..), ValueMapEntry, areEqualValues, linearFind) 35 | 36 | 37 | {-| Represents a map of values to `v`. Operation complexity depends on the type of the key. 38 | For keywords, symbols, strings, floats, and integers, the complexity of insert/remove operations is logarithmic. 39 | For other value types, the complexity ranges from linear or worse, depending on the type of key values. 40 | -} 41 | type alias ValueKeyMap io v = 42 | Enclojure.Common.ValueMap io v 43 | 44 | 45 | {-| Represents a map entry. 46 | -} 47 | type alias ValueKeyMapEntry io v = 48 | Enclojure.Common.ValueMapEntry io v 49 | 50 | 51 | {-| Returns an empty map. 52 | -} 53 | empty : ValueKeyMap io v 54 | empty = 55 | ValueMap 56 | { ints = Dict.empty 57 | , floats = Dict.empty 58 | , strings = Dict.empty 59 | , nil = Nothing 60 | , true = Nothing 61 | , false = Nothing 62 | , symbols = Dict.empty 63 | , keywords = Dict.empty 64 | , otherValues = [] 65 | } 66 | 67 | 68 | {-| Returns True if the map is empty. 69 | -} 70 | isEmpty : ValueKeyMap io v -> Bool 71 | isEmpty (ValueMap m) = 72 | Dict.isEmpty m.ints 73 | && Dict.isEmpty m.floats 74 | && Dict.isEmpty m.strings 75 | && m.nil 76 | == Nothing 77 | && m.true 78 | == Nothing 79 | && m.false 80 | == Nothing 81 | && Dict.isEmpty m.symbols 82 | && List.isEmpty m.otherValues 83 | && Dict.isEmpty m.keywords 84 | 85 | 86 | insertOtherValue : Value io -> v -> List (ValueKeyMapEntry io v) -> List (ValueKeyMapEntry io v) 87 | insertOtherValue k v list = 88 | case list of 89 | (( existingKey, _ ) as entry) :: rst -> 90 | if areEqualValues existingKey k then 91 | ( k, v ) :: rst 92 | 93 | else 94 | entry :: insertOtherValue k v rst 95 | 96 | [] -> 97 | [ ( k, v ) ] 98 | 99 | 100 | {-| Inserts a value specified by the second argument to the key specified by the first argument. 101 | -} 102 | insert : Value io -> v -> ValueKeyMap io v -> ValueMap io v 103 | insert k v (ValueMap m) = 104 | (case k of 105 | Number (Int int) -> 106 | { m | ints = Dict.insert int v m.ints } 107 | 108 | Number (Float float) -> 109 | { m | floats = Dict.insert float v m.floats } 110 | 111 | String string -> 112 | { m | strings = Dict.insert string v m.strings } 113 | 114 | Nil -> 115 | { m | nil = Just v } 116 | 117 | Bool True -> 118 | { m | true = Just v } 119 | 120 | Bool False -> 121 | { m | false = Just v } 122 | 123 | Keyword keyword -> 124 | { m | keywords = Dict.insert keyword v m.keywords } 125 | 126 | Symbol symbol -> 127 | { m | symbols = Dict.insert symbol v m.symbols } 128 | 129 | _ -> 130 | { m | otherValues = insertOtherValue k v m.otherValues } 131 | ) 132 | |> ValueMap 133 | 134 | 135 | {-| Removes the value at a given key from the map. 136 | -} 137 | remove : Value io -> ValueKeyMap io v -> ValueKeyMap io v 138 | remove k (ValueMap m) = 139 | (case k of 140 | Number (Int int) -> 141 | { m | ints = Dict.remove int m.ints } 142 | 143 | Number (Float float) -> 144 | { m | floats = Dict.remove float m.floats } 145 | 146 | String string -> 147 | { m | strings = Dict.remove string m.strings } 148 | 149 | Nil -> 150 | { m | nil = Nothing } 151 | 152 | Bool True -> 153 | { m | true = Nothing } 154 | 155 | Bool False -> 156 | { m | false = Nothing } 157 | 158 | Keyword keyword -> 159 | { m | keywords = Dict.remove keyword m.keywords } 160 | 161 | Symbol symbol -> 162 | { m | symbols = Dict.remove symbol m.symbols } 163 | 164 | _ -> 165 | { m | otherValues = m.otherValues |> List.filter (Tuple.first >> areEqualValues k >> not) } 166 | ) 167 | |> ValueMap 168 | 169 | 170 | {-| Returns the value at a given key in the map if present. 171 | -} 172 | get : Value io -> ValueKeyMap io v -> Maybe v 173 | get k (ValueMap m) = 174 | case k of 175 | Number (Int int) -> 176 | Dict.get int m.ints 177 | 178 | Number (Float float) -> 179 | Dict.get float m.floats 180 | 181 | String string -> 182 | Dict.get string m.strings 183 | 184 | Nil -> 185 | m.nil 186 | 187 | Bool True -> 188 | m.true 189 | 190 | Bool False -> 191 | m.false 192 | 193 | Keyword keyword -> 194 | Dict.get keyword m.keywords 195 | 196 | Symbol symbol -> 197 | Dict.get symbol m.symbols 198 | 199 | _ -> 200 | linearFind (Tuple.first >> areEqualValues k) m.otherValues 201 | |> Maybe.map Tuple.second 202 | 203 | 204 | {-| Returns True if the map has a value at a given key. 205 | -} 206 | member : Value io -> ValueKeyMap io v -> Bool 207 | member keyVal m = 208 | Nothing /= get keyVal m 209 | 210 | 211 | {-| Transforms a given map into a list of map entries. 212 | -} 213 | toList : ValueKeyMap io v -> List (ValueKeyMapEntry io v) 214 | toList (ValueMap m) = 215 | let 216 | ints = 217 | Dict.toList m.ints |> List.map (Tuple.mapFirst (Int >> Number)) 218 | 219 | floats = 220 | Dict.toList m.floats |> List.map (Tuple.mapFirst (Float >> Number)) 221 | 222 | strings = 223 | Dict.toList m.strings |> List.map (Tuple.mapFirst String) 224 | 225 | nils = 226 | m.nil |> Maybe.map (Tuple.pair Nil >> List.singleton) |> Maybe.withDefault [] 227 | 228 | trues = 229 | m.true |> Maybe.map (Tuple.pair (Bool True) >> List.singleton) |> Maybe.withDefault [] 230 | 231 | falses = 232 | m.false |> Maybe.map (Tuple.pair (Bool False) >> List.singleton) |> Maybe.withDefault [] 233 | 234 | keywords = 235 | Dict.toList m.keywords |> List.map (Tuple.mapFirst Keyword) 236 | 237 | symbols = 238 | Dict.toList m.symbols |> List.map (Tuple.mapFirst Symbol) 239 | in 240 | ints 241 | ++ floats 242 | ++ strings 243 | ++ nils 244 | ++ trues 245 | ++ falses 246 | ++ keywords 247 | ++ symbols 248 | ++ m.otherValues 249 | 250 | 251 | {-| Folds a given map from left to right using a function that accepts the key, the value, and the accumulator, 252 | and is called for each entry in the map. 253 | -} 254 | foldl : (Value io -> v -> a -> a) -> a -> ValueKeyMap io v -> a 255 | foldl fn init m = 256 | List.foldl (\( k, v ) a -> fn k v a) init (toList m) 257 | 258 | 259 | {-| Creates a map from a given list of map entries. 260 | -} 261 | fromList : List (ValueKeyMapEntry io v) -> ValueKeyMap io v 262 | fromList entries = 263 | entries 264 | |> List.foldl (\( k, v ) a -> insert k v a) empty 265 | 266 | 267 | {-| Applies a function to every mapEntry in the map. 268 | -} 269 | map : (ValueKeyMapEntry io v -> ValueKeyMapEntry io v) -> ValueKeyMap io v -> ValueKeyMap io v 270 | map f m = 271 | m |> toList |> List.map f |> fromList 272 | 273 | 274 | {-| Returns the list of map values 275 | -} 276 | values : ValueKeyMap io v -> List v 277 | values m = 278 | m |> toList |> List.map Tuple.second 279 | 280 | 281 | {-| Returns the list of map keys. 282 | -} 283 | keys : ValueKeyMap io v -> List (Value io) 284 | keys m = 285 | m |> toList |> List.map Tuple.first 286 | -------------------------------------------------------------------------------- /src/Enclojure/ValueMap.elm: -------------------------------------------------------------------------------- 1 | module Enclojure.ValueMap exposing 2 | ( ValueMap, ValueMapEntry, empty, fromList 3 | , get, keys, values, toList 4 | , foldl, insert, map, remove 5 | , isEmpty, member 6 | ) 7 | 8 | {-| All Enclojure maps are backed by `ValueMap io` type. This namespace provides functions for working with this type. 9 | 10 | 11 | # Creating 12 | 13 | @docs ValueMap, ValueMapEntry, empty, fromList 14 | 15 | 16 | # Accessing values 17 | 18 | @docs get, keys, values, toList 19 | 20 | 21 | # Modifying 22 | 23 | @docs foldl, insert, map, remove 24 | 25 | 26 | # Predicates 27 | 28 | @docs isEmpty, member 29 | 30 | -} 31 | 32 | import Enclojure.Common exposing (Value) 33 | import Enclojure.Located as Located exposing (Located(..)) 34 | import Enclojure.ValueKeyMap as ValueKeyMap exposing (ValueKeyMap, ValueKeyMapEntry) 35 | 36 | 37 | {-| Represents a map of values to located values. Operation complexity depends on the type of the key. 38 | For keywords, symbols, strings, floats, and integers, the complexity of insert/remove operations is logarithmic. 39 | For other value types, the complexity ranges from linear or worse, depending on the type of key values. 40 | -} 41 | type alias ValueMap io = 42 | ValueKeyMap io (Located (Value io)) 43 | 44 | 45 | {-| Represents a map entry. 46 | -} 47 | type alias ValueMapEntry io = 48 | ValueKeyMapEntry io (Located (Value io)) 49 | 50 | 51 | {-| Returns an empty map. 52 | -} 53 | empty : ValueMap io 54 | empty = 55 | ValueKeyMap.empty 56 | 57 | 58 | {-| Returns True if the map is empty. 59 | -} 60 | isEmpty : ValueMap io -> Bool 61 | isEmpty = 62 | ValueKeyMap.isEmpty 63 | 64 | 65 | {-| Inserts a located value specified by the second argument to the key specified by the first argument. 66 | -} 67 | insert : Value io -> Located (Value io) -> ValueMap io -> ValueMap io 68 | insert = 69 | ValueKeyMap.insert 70 | 71 | 72 | {-| Removes the value at a given key from the map. 73 | -} 74 | remove : Value io -> ValueMap io -> ValueMap io 75 | remove = 76 | ValueKeyMap.remove 77 | 78 | 79 | {-| Returns the located value at a given key in the map if present. 80 | -} 81 | get : Value io -> ValueMap io -> Maybe (Located (Value io)) 82 | get = 83 | ValueKeyMap.get 84 | 85 | 86 | {-| Returns True if the map has a value at a given key. 87 | -} 88 | member : Value io -> ValueMap io -> Bool 89 | member = 90 | ValueKeyMap.member 91 | 92 | 93 | {-| Transforms a given map into a list of map entries. 94 | -} 95 | toList : ValueMap io -> List (ValueMapEntry io) 96 | toList = 97 | ValueKeyMap.toList 98 | 99 | 100 | {-| Folds a given map from left to right using a function that accepts the key, the located value, and the accumulator, 101 | and is called for each entry in the map. 102 | -} 103 | foldl : (Value io -> Located (Value io) -> a -> a) -> a -> ValueMap io -> a 104 | foldl = 105 | ValueKeyMap.foldl 106 | 107 | 108 | {-| Creates a map from a given list of map entries. 109 | -} 110 | fromList : List (ValueMapEntry io) -> ValueMap io 111 | fromList = 112 | ValueKeyMap.fromList 113 | 114 | 115 | {-| Applies a function to every mapEntry in the map. 116 | -} 117 | map : (ValueMapEntry io -> ValueMapEntry io) -> ValueMap io -> ValueMap io 118 | map = 119 | ValueKeyMap.map 120 | 121 | 122 | {-| Returns the list of map values without their source code locations. 123 | -} 124 | values : ValueMap io -> List (Value io) 125 | values = 126 | ValueKeyMap.values >> List.map Located.getValue 127 | 128 | 129 | {-| Returns the list of map keys. 130 | -} 131 | keys : ValueMap io -> List (Value io) 132 | keys = 133 | ValueKeyMap.keys 134 | -------------------------------------------------------------------------------- /src/Enclojure/ValueSet.elm: -------------------------------------------------------------------------------- 1 | module Enclojure.ValueSet exposing 2 | ( ValueSet, empty, fromList 3 | , toList 4 | , insert, map, remove 5 | , isEmpty, member 6 | ) 7 | 8 | {-| Represents a set of values. Operation complexity depends on the type of the value. 9 | For keywords, symbols, strings, floats, and integers, the complexity of insert/remove operations is logarithmic. 10 | For other value types, the complexity is typically linear or worse, depending on the type of key values. 11 | 12 | 13 | # Creating 14 | 15 | @docs ValueSet, empty, fromList 16 | 17 | 18 | # Accessing values 19 | 20 | @docs toList 21 | 22 | 23 | # Modifying 24 | 25 | @docs insert, map, remove 26 | 27 | 28 | # Predicates 29 | 30 | @docs isEmpty, member 31 | 32 | -} 33 | 34 | import Enclojure.Common exposing (Number(..), Value(..), ValueSet(..), areEqualValues) 35 | import Set 36 | 37 | 38 | {-| Represents a set of values. 39 | -} 40 | type alias ValueSet io = 41 | Enclojure.Common.ValueSet io 42 | 43 | 44 | {-| Returns an empty set. 45 | -} 46 | empty : ValueSet io 47 | empty = 48 | ValueSet 49 | { ints = Set.empty 50 | , floats = Set.empty 51 | , strings = Set.empty 52 | , nil = False 53 | , true = False 54 | , false = False 55 | , symbols = Set.empty 56 | , keywords = Set.empty 57 | , otherValues = [] 58 | } 59 | 60 | 61 | {-| Returns True if the set is empty. 62 | -} 63 | isEmpty : ValueSet io -> Bool 64 | isEmpty (Enclojure.Common.ValueSet m) = 65 | Set.isEmpty m.ints 66 | && Set.isEmpty m.floats 67 | && Set.isEmpty m.strings 68 | && List.isEmpty m.otherValues 69 | && m.nil 70 | == False 71 | && m.true 72 | == False 73 | && m.false 74 | == False 75 | && Set.isEmpty m.symbols 76 | && Set.isEmpty m.keywords 77 | 78 | 79 | insertOtherValue : Value io -> List (Value io) -> List (Value io) 80 | insertOtherValue v list = 81 | case list of 82 | existingValue :: rst -> 83 | if areEqualValues existingValue v then 84 | existingValue :: rst 85 | 86 | else 87 | existingValue :: insertOtherValue v rst 88 | 89 | [] -> 90 | [ v ] 91 | 92 | 93 | {-| Inserts a value into the set. 94 | -} 95 | insert : Value io -> ValueSet io -> ValueSet io 96 | insert v (Enclojure.Common.ValueSet set) = 97 | Enclojure.Common.ValueSet <| 98 | case v of 99 | Number (Int int) -> 100 | { set | ints = Set.insert int set.ints } 101 | 102 | Number (Float float) -> 103 | { set | floats = Set.insert float set.floats } 104 | 105 | String string -> 106 | { set | strings = Set.insert string set.strings } 107 | 108 | Nil -> 109 | { set | nil = True } 110 | 111 | Bool True -> 112 | { set | true = True } 113 | 114 | Bool False -> 115 | { set | false = True } 116 | 117 | Keyword keyword -> 118 | { set | keywords = Set.insert keyword set.keywords } 119 | 120 | Symbol symbol -> 121 | { set | symbols = Set.insert symbol set.symbols } 122 | 123 | _ -> 124 | { set | otherValues = insertOtherValue v set.otherValues } 125 | 126 | 127 | {-| Removes a value from the set or does nothing if it's not present. 128 | -} 129 | remove : Value io -> ValueSet io -> ValueSet io 130 | remove v (Enclojure.Common.ValueSet set) = 131 | Enclojure.Common.ValueSet <| 132 | case v of 133 | Number (Int int) -> 134 | { set | ints = Set.remove int set.ints } 135 | 136 | Number (Float float) -> 137 | { set | floats = Set.remove float set.floats } 138 | 139 | String string -> 140 | { set | strings = Set.remove string set.strings } 141 | 142 | Nil -> 143 | { set | nil = False } 144 | 145 | Bool True -> 146 | { set | true = False } 147 | 148 | Bool False -> 149 | { set | false = False } 150 | 151 | Keyword keyword -> 152 | { set | keywords = Set.remove keyword set.keywords } 153 | 154 | Symbol symbol -> 155 | { set | symbols = Set.remove symbol set.symbols } 156 | 157 | _ -> 158 | { set | otherValues = set.otherValues |> List.filter (areEqualValues v >> not) } 159 | 160 | 161 | {-| Creates a new set from a list of values. 162 | -} 163 | fromList : List (Value io) -> ValueSet io 164 | fromList entries = 165 | entries 166 | |> List.foldl (\v a -> insert v a) empty 167 | 168 | 169 | {-| Returns a list of values in the set. 170 | -} 171 | toList : ValueSet io -> List (Value io) 172 | toList (Enclojure.Common.ValueSet set) = 173 | let 174 | ints = 175 | Set.toList set.ints |> List.map (Int >> Number) 176 | 177 | floats = 178 | Set.toList set.floats |> List.map (Float >> Number) 179 | 180 | strings = 181 | Set.toList set.strings |> List.map String 182 | 183 | nils = 184 | if set.nil then 185 | [ Nil ] 186 | 187 | else 188 | [] 189 | 190 | trues = 191 | if set.true then 192 | [ Bool True ] 193 | 194 | else 195 | [] 196 | 197 | falses = 198 | if set.false then 199 | [ Bool False ] 200 | 201 | else 202 | [] 203 | 204 | keywords = 205 | Set.toList set.keywords |> List.map Keyword 206 | 207 | symbols = 208 | Set.toList set.symbols |> List.map Symbol 209 | in 210 | ints 211 | ++ floats 212 | ++ strings 213 | ++ nils 214 | ++ trues 215 | ++ falses 216 | ++ keywords 217 | ++ symbols 218 | ++ set.otherValues 219 | 220 | 221 | {-| Applies a given function to each value in the set. 222 | -} 223 | map : (Value io -> Value io) -> ValueSet io -> ValueSet io 224 | map f set = 225 | set |> toList |> List.map f |> fromList 226 | 227 | 228 | {-| Returns True if a given value is in the set. 229 | -} 230 | member : Value io -> ValueSet io -> Bool 231 | member v (Enclojure.Common.ValueSet set) = 232 | case v of 233 | Number (Int int) -> 234 | Set.member int set.ints 235 | 236 | Number (Float float) -> 237 | Set.member float set.floats 238 | 239 | String string -> 240 | Set.member string set.strings 241 | 242 | Nil -> 243 | set.nil 244 | 245 | Bool False -> 246 | set.false 247 | 248 | Bool True -> 249 | set.true 250 | 251 | Keyword keyword -> 252 | Set.member keyword set.keywords 253 | 254 | Symbol symbol -> 255 | Set.member symbol set.symbols 256 | 257 | _ -> 258 | List.member v set.otherValues 259 | --------------------------------------------------------------------------------