├── .gitignore ├── _misc ├── help.png ├── complete.png ├── neovim-help.png ├── neovim-complete.png ├── yal.el ├── init.lua └── tapview ├── .github ├── FUNDING.yml ├── workflows │ ├── push.yml │ ├── release.yml │ └── pull_request.yml ├── build ├── run-tests.sh └── test-ordering.pl ├── testdata └── fuzz │ └── FuzzYAL │ ├── 009033e90ee584820f38b3cd24caf06318b1b8a3452948c33c6c721cd26933f1 │ ├── 068ca1255acd9d72793be309907bdef09c7ed67b6ae753484a9b97ed4e30db18 │ ├── 39a6fe7b7f4d0f4ef37a498faf1d8a513948ee447aa41d85be94ed6782b96c3c │ ├── 405d389996e4d2bb9300bb956fdf77032ae5c1c5aff2af086d5caf06a452395e │ ├── 4f511a4c208477912373b75d1f91fc8a51608750f1f25d0442545511336fac86 │ ├── 963b09bdab242b643451c8719d011dfb41dbd31c181cc96655b3bf5d8446f33e │ ├── 9cfbf0291fb9b305580122518eb524edbb816f8dd51785019c07e280e8a2ef0c │ ├── 9f759cbcd5dc99e65b24bf930d8bfdef36293f70ed0d34edf45cb3e0b8e7e665 │ ├── a0868bd3f3a35949fa21ee06baf4333c329203d150f335c1f5efcf659fd7a965 │ ├── cb3b28fb4c1fe8cc4b9679fad842fcd7e70574a65c5a5da64cd005733afe8bab │ ├── 0c1ea457a663e40d7bd7021530aaa9513de3d566fd84eaad459d301e665bcfe3 │ ├── 1903822091752a9fa1df21da243570937fcd1fb1b23429e37ce45bc8e79e0f9e │ ├── 1f275fbf2e99d36b284935b2acd9a765d1137cde98bef34f7b51f56660f83336 │ ├── 221ce1617db9fd6c81f68ffdc3c172e4dea165425f38bd30fc98d725c1fcdef0 │ ├── 4b095858dc03b9b7ce7b0193de26256745401ef2958dcff4837d4565b762dffa │ ├── 4c6659a7807818db64de15c9088ab3a5a320867dd7beabd41b8f5738bee445c1 │ ├── 51575636bc9018026cce0a386e5775320e8e8f2f057187737fa18b2982a8e3de │ ├── 51aa073ac7190c9a87e99ee96d548dff6ed677cd7b8bf6ebd31190fd408138e4 │ ├── 62865dd27bdcbb3341ccea7cad9dca55f0a4cd46baa0e8c1b11c0f3338eddfa1 │ ├── 63dd0a4a178e4e7e4625a519d2de560a7b7f29bb30ed5e3c94433d401584b023 │ ├── 79974f1a04a6ea39d8500cbfe7a7195f466705f7b09bccb163eae648f0b78c77 │ ├── 7ab73af7f44eda885ba7e7234a8261b38e5d9042268328e7b2dd552cda967d76 │ ├── 95198f065dd3024f09e9d475b14ff4fe604298770ed4ca2fa6619803faeb2fa7 │ ├── 9d20ed39700196ddb7ea719d42d08e358c7c504a7ee2484b6abbba1d49ed4273 │ ├── a8851cc5925ca7fdb591af3673ca9d98dfa32d60f10fca1d63b928065d0703c4 │ ├── e7eddd9c73cdb4a651ff7a06bccbbd09cebb5518c1ac29baa524fdb97bfb7997 │ ├── f62f8f68ef73d2c5e78b3cfe94961999fdbe02f5078e6a9b461d0d5cba8ff565 │ ├── 73b0150158decb4bd08a584d263158261431c9f89b492a1d9ad122a63b477427 │ ├── 8de40f105cd00b80cc29f2554c638a1785a6f0bf7e8a4fb4622a10db921b5f3b │ ├── 9b07682a4c420c49db528e61935171684e0ce290d2887ce24c84f7ef23595a92 │ ├── cd76aa0d78c148be2fe20ab759b50f2f80e56a13e097a00d8999704c38f1a616 │ ├── d89c0fa8efcb458edeae4c776933abb443bf350bca17302403228276d67a40d9 │ ├── dc4447badede601c48f2ef075c2953c7b426177a81b1e15304aa3277e8bcc915 │ ├── fe8db6ab96f45e8c2759e05339624973e9a44a4af3898685c8f898c5a983bea8 │ ├── 34f7cf0f4f116c1b9372310c41fe146b07f11b198d608f08300d9c519369a269 │ ├── 9e395bbddea9b09bf287c94ccbbc262352395bfa7da7b9e88d427ad67bfb532e │ ├── a02fbb33a18785d6f9749cab45728eece5d9d39a2344253bed54c7c5fef22281 │ ├── 20c2fe6dd5f60cb4cd4d1f772ac28afb1793151af4823a4d6f3e882ff1ccb03a │ ├── 5c6af0c63ad7388119372d67a7bda8b6f9d641d4033ddaa6162085604e6e2579 │ ├── d62c220ce0eb80d6fcf35a0f72278068c971bf9b815226c36baaed582fca6111 │ ├── f8b95e2ec49d73cf04e02aa5eba93f8915393a601d1317c59b5242a7b6e97843 │ ├── 451a01ed4d1e4b1ec76261cf795484eea53ed700e3f80b4f78a6e6c4f09437f8 │ ├── ba0fcef6ab521763179f52a1f2ef9fed78574074e826d61f9c362bd4ca07f62e │ ├── 3ff61a000e5e4af25078033223cfffade896ffd626d6206ddb449ee8af2c6a57 │ ├── 42a384a638c8ca5b0ae5f8f69a2f993e11aaacb0cf032a4bd2fdc777ced33f63 │ ├── 459a760b1737676f54b5943dd906fc5d371d4741e1eb6cd62e7dcecd56633a6b │ ├── b9272c865c482df24c0624f816e4980a429caafd75072d57a6a14352cdc991c8 │ ├── 915badb02db715f83b38fbe5e3a35b981e2683c8dfb3823522b13175814993ac │ └── cff0b3d13ee546ea351b0978a4d86f69d989b8ff96105bc305471e2212902653 ├── examples ├── Makefile ├── args.lisp ├── time.lisp ├── try.lisp ├── sentences.lisp ├── fizzbuzz.lisp ├── README.md ├── readme.lisp ├── adder.lisp ├── fibonacci.lisp ├── dynamic.lisp ├── hash.lisp ├── fuzz.lisp ├── sorting.lisp ├── mtest.lisp └── test.lisp ├── bin ├── built-in └── stdlib ├── stdlib ├── stdlib │ ├── directory.lisp │ ├── string-substr.lisp │ ├── random.lisp │ ├── sort.lisp │ ├── string-pad.lisp │ ├── date.lisp │ ├── time.lisp │ ├── stack.lisp │ ├── type-checks.lisp │ ├── string-case.lisp │ ├── logical.lisp │ ├── comparisons.lisp │ ├── maths.lisp │ ├── file.lisp │ ├── lists.lisp │ ├── stdlib.lisp │ └── mal.lisp ├── stdlib_test.go └── stdlib.go ├── primitive ├── string.go ├── nil.go ├── symbol.go ├── bool.go ├── character.go ├── list.go ├── number.go ├── error.go ├── primitive.go ├── hash_test.go ├── procedure_test.go ├── procedure.go ├── hash.go └── primitive_test.go ├── Makefile ├── builtins ├── file_info_unix.go ├── file_info_windows.go ├── builtins_shell_test.go └── help.txt ├── go.mod ├── .yalrc ├── env ├── env_test.go └── env.go ├── config └── config.go ├── main_test.go ├── LSP.md ├── go.sum ├── INTRODUCTION.md ├── lsp.go ├── fuzz_test.go ├── README.md └── main.go /.gitignore: -------------------------------------------------------------------------------- 1 | yal 2 | -------------------------------------------------------------------------------- /_misc/help.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skx/yal/HEAD/_misc/help.png -------------------------------------------------------------------------------- /_misc/complete.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skx/yal/HEAD/_misc/complete.png -------------------------------------------------------------------------------- /_misc/neovim-help.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skx/yal/HEAD/_misc/neovim-help.png -------------------------------------------------------------------------------- /_misc/neovim-complete.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skx/yal/HEAD/_misc/neovim-complete.png -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | github: skx 3 | custom: https://steve.fi/donate/ 4 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/009033e90ee584820f38b3cd24caf06318b1b8a3452948c33c6c721cd26933f1: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(*)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/068ca1255acd9d72793be309907bdef09c7ed67b6ae753484a9b97ed4e30db18: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(!)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/39a6fe7b7f4d0f4ef37a498faf1d8a513948ee447aa41d85be94ed6782b96c3c: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(#)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/405d389996e4d2bb9300bb956fdf77032ae5c1c5aff2af086d5caf06a452395e: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(0)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/4f511a4c208477912373b75d1f91fc8a51608750f1f25d0442545511336fac86: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("#\\") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/963b09bdab242b643451c8719d011dfb41dbd31c181cc96655b3bf5d8446f33e: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(% 0 0)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/9cfbf0291fb9b305580122518eb524edbb816f8dd51785019c07e280e8a2ef0c: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(eval )") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/9f759cbcd5dc99e65b24bf930d8bfdef36293f70ed0d34edf45cb3e0b8e7e665: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(if)0") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/a0868bd3f3a35949fa21ee06baf4333c329203d150f335c1f5efcf659fd7a965: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(str )") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/cb3b28fb4c1fe8cc4b9679fad842fcd7e70574a65c5a5da64cd005733afe8bab: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(* A)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/0c1ea457a663e40d7bd7021530aaa9513de3d566fd84eaad459d301e665bcfe3: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(try()())") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/1903822091752a9fa1df21da243570937fcd1fb1b23429e37ce45bc8e79e0f9e: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(let((00)))") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/1f275fbf2e99d36b284935b2acd9a765d1137cde98bef34f7b51f56660f83336: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(set!()00)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/221ce1617db9fd6c81f68ffdc3c172e4dea165425f38bd30fc98d725c1fcdef0: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(nth()00)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/4b095858dc03b9b7ce7b0193de26256745401ef2958dcff4837d4565b762dffa: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(let'000)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/4c6659a7807818db64de15c9088ab3a5a320867dd7beabd41b8f5738bee445c1: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(help 00)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/51575636bc9018026cce0a386e5775320e8e8f2f057187737fa18b2982a8e3de: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(random 0)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/51aa073ac7190c9a87e99ee96d548dff6ed677cd7b8bf6ebd31190fd408138e4: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(let 000)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/62865dd27bdcbb3341ccea7cad9dca55f0a4cd46baa0e8c1b11c0f3338eddfa1: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(let(()))") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/63dd0a4a178e4e7e4625a519d2de560a7b7f29bb30ed5e3c94433d401584b023: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(vals 000)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/79974f1a04a6ea39d8500cbfe7a7195f466705f7b09bccb163eae648f0b78c77: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(lambda 0)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/7ab73af7f44eda885ba7e7234a8261b38e5d9042268328e7b2dd552cda967d76: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(lambda)0") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/95198f065dd3024f09e9d475b14ff4fe604298770ed4ca2fa6619803faeb2fa7: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(let*(00))") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/9d20ed39700196ddb7ea719d42d08e358c7c504a7ee2484b6abbba1d49ed4273: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(let((0 0)))") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/a8851cc5925ca7fdb591af3673ca9d98dfa32d60f10fca1d63b928065d0703c4: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(define)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/e7eddd9c73cdb4a651ff7a06bccbbd09cebb5518c1ac29baa524fdb97bfb7997: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(eval 0)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/f62f8f68ef73d2c5e78b3cfe94961999fdbe02f5078e6a9b461d0d5cba8ff565: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(apply()()0)") 3 | -------------------------------------------------------------------------------- /examples/Makefile: -------------------------------------------------------------------------------- 1 | # 2 | # Generate README.md, by running readme.lisp. 3 | # 4 | README.md: *.lisp 5 | ../yal readme.lisp > README.md 6 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/73b0150158decb4bd08a584d263158261431c9f89b492a1d9ad122a63b477427: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(defmacro! A 0)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/8de40f105cd00b80cc29f2554c638a1785a6f0bf7e8a4fb4622a10db921b5f3b: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(file:lines\"\")") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/9b07682a4c420c49db528e61935171684e0ce290d2887ce24c84f7ef23595a92: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(try()(0 0()))") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/cd76aa0d78c148be2fe20ab759b50f2f80e56a13e097a00d8999704c38f1a616: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(match\"(\"0)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/d89c0fa8efcb458edeae4c776933abb443bf350bca17302403228276d67a40d9: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("00(define 0 0)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/dc4447badede601c48f2ef075c2953c7b426177a81b1e15304aa3277e8bcc915: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(glob\"\\\"\")") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/fe8db6ab96f45e8c2759e05339624973e9a44a4af3898685c8f898c5a983bea8: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(print(let*()))") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/34f7cf0f4f116c1b9372310c41fe146b07f11b198d608f08300d9c519369a269: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("0000000000(quote )0") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/9e395bbddea9b09bf287c94ccbbc262352395bfa7da7b9e88d427ad67bfb532e: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("0000000000000(lambda(0)0)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/a02fbb33a18785d6f9749cab45728eece5d9d39a2344253bed54c7c5fef22281: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("0000000000000(lambda 0 0)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/20c2fe6dd5f60cb4cd4d1f772ac28afb1793151af4823a4d6f3e882ff1ccb03a: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(let((vals ()))0(rest vals ))") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/5c6af0c63ad7388119372d67a7bda8b6f9d641d4033ddaa6162085604e6e2579: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(let((vals ()))(first vals))") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/d62c220ce0eb80d6fcf35a0f72278068c971bf9b815226c36baaed582fca6111: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(define q())(apply(nat x)))d") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/f8b95e2ec49d73cf04e02aa5eba93f8915393a601d1317c59b5242a7b6e97843: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(define e\"\")(print (eval e))") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/451a01ed4d1e4b1ec76261cf795484eea53ed700e3f80b4f78a6e6c4f09437f8: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(define fact(lambda(A)(if())))(fact 0)") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/ba0fcef6ab521763179f52a1f2ef9fed78574074e826d61f9c362bd4ca07f62e: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(defmacro! unless(fn*()`(~!)))(unless )") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/3ff61a000e5e4af25078033223cfffade896ffd626d6206ddb449ee8af2c6a57: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte(";\n(define sq(lambda(x)(*x x)));\n(apply(nat()))a") 3 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/42a384a638c8ca5b0ae5f8f69a2f993e11aaacb0cf032a4bd2fdc777ced33f63: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte(";\n(define sq(lambda(x)(* x x)));\n(apply(nat(lambda(x)print \"\"x(sq x)))q") 3 | -------------------------------------------------------------------------------- /bin/built-in: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | # Show built-in functions 4 | # 5 | 6 | set -o noglob 7 | for i in $(grep "env.Set" builtins/builtins.go | awk -F\" '{print $2}' | sort -u) ; do 8 | echo "* ${i}" 9 | done 10 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/459a760b1737676f54b5943dd906fc5d371d4741e1eb6cd62e7dcecd56633a6b: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("(define t(()(()((())))))(apply(ist 1 2 3 4 5 6 7 8 9 10)\n (lambda (x)\n (print \"%s! => %s\" x (fact x))))") 3 | -------------------------------------------------------------------------------- /bin/stdlib: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | # Show functions implemented in lisp 4 | # 5 | 6 | set -o noglob 7 | 8 | for i in $(grep '(set!' stdlib/stdlib.lisp stdlib/mal.lisp | awk '{ print $2}' | sort -u); do 9 | 10 | echo "* \`$i\`" 11 | done 12 | -------------------------------------------------------------------------------- /.github/workflows/push.yml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: 4 | - master 5 | name: Push Event 6 | jobs: 7 | test: 8 | name: Run tests 9 | runs-on: ubuntu-latest 10 | steps: 11 | - uses: actions/checkout@master 12 | - name: Test 13 | uses: skx/github-action-tester@master 14 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/b9272c865c482df24c0624f816e4980a429caafd75072d57a6a14352cdc991c8: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("\n; Split a string into a list, reverse it, and join it\n(let ((input \"Steve Kemp\"))\n (begin\n (print \"Starting string: %s\" input)\n (print \"Reversed string: %s\" (join (reverse (split\x10\x00Steve Kemp\" \"\"))))))\n") 3 | -------------------------------------------------------------------------------- /stdlib/stdlib/directory.lisp: -------------------------------------------------------------------------------- 1 | ;;; directory.lisp - Directory-related functions 2 | 3 | 4 | ;; Handy function to invoke a callback on files 5 | (set! directory:walk (fn* (path:string fn:function) 6 | "Invoke the specified callback on every file beneath the given path." 7 | 8 | (apply (directory:entries path) fn))) 9 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/915badb02db715f83b38fbe5e3a35b981e2683c8dfb3823522b13175814993ac: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte("\n;; Defin\x82 a funct\x01on, 'fact', to \xd4alzulate factorials.\n(define fact (lambda (n)\n (if (<= n 1)\n 1\n, (* \x10 (fact 666666(- n 1))))))\n\n;; Invoke the factorial function, using apply\n(apply (list 1 2 3 4 5 6 7\x00\x00\x00\x80 10)\n (lambda (x)\n (print \"%s => %s\" x (fact x))))\n") 3 | -------------------------------------------------------------------------------- /examples/args.lisp: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env yal 2 | ;; 3 | ;; Usage: 4 | ;; 5 | ;; ./args.lisp 2 34 4 6 | ;; 7 | 8 | ;; Show the count. 9 | (print "I received %d command-line arguments." (length os.args)) 10 | 11 | ;; Show the actual arguments 12 | (print "Args: %s" os.args) 13 | 14 | ;; And followup with the username 15 | (print "The current user is %s, running on %s (arch:%s)" 16 | (getenv "USER") 17 | (os) 18 | (arch) 19 | ) 20 | -------------------------------------------------------------------------------- /.github/workflows/release.yml: -------------------------------------------------------------------------------- 1 | on: release 2 | name: Handle Release 3 | jobs: 4 | upload: 5 | name: Upload release 6 | runs-on: ubuntu-latest 7 | steps: 8 | - uses: actions/checkout@master 9 | - name: Generate the artifacts 10 | uses: skx/github-action-build@master 11 | - name: Upload 12 | uses: skx/github-action-publish-binaries@master 13 | env: 14 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 15 | with: 16 | args: yal*-* 17 | -------------------------------------------------------------------------------- /primitive/string.go: -------------------------------------------------------------------------------- 1 | package primitive 2 | 3 | // String holds a string value. 4 | type String string 5 | 6 | // IsSimpleType is used to denote whether this object 7 | // is self-evaluating. 8 | func (s String) IsSimpleType() bool { 9 | return true 10 | } 11 | 12 | // ToString converts this object to a string. 13 | func (s String) ToString() string { 14 | return string(s) 15 | } 16 | 17 | // Type returns the type of this primitive object. 18 | func (s String) Type() string { 19 | return "string" 20 | } 21 | -------------------------------------------------------------------------------- /.github/workflows/pull_request.yml: -------------------------------------------------------------------------------- 1 | on: pull_request 2 | name: Pull Request 3 | jobs: 4 | golangci: 5 | name: lint 6 | runs-on: ubuntu-latest 7 | steps: 8 | - uses: actions/setup-go@v2 9 | - uses: actions/checkout@v2 10 | - name: golangci-lint 11 | uses: golangci/golangci-lint-action@v2 12 | test: 13 | name: Test 14 | runs-on: ubuntu-latest 15 | steps: 16 | - uses: actions/checkout@master 17 | - name: Test 18 | uses: skx/github-action-tester@master 19 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # 2 | # Simple Makefile to run our lisp-based tests, and update our examples/ 3 | # index 4 | # 5 | 6 | ALL: test-lisp test-go update-examples 7 | 8 | 9 | # 10 | # Build our binary 11 | # 12 | yal: 13 | go build . 14 | 15 | # 16 | # Run our lisp-based tests 17 | # 18 | test-lisp: yal 19 | ./yal examples/lisp-tests.lisp | _misc/tapview 20 | 21 | 22 | # 23 | # Run our go-based tests 24 | # 25 | test-go: 26 | go test ./... 27 | 28 | 29 | # 30 | # Update our list of examples. 31 | # 32 | update-examples: yal 33 | cd examples && make 34 | -------------------------------------------------------------------------------- /primitive/nil.go: -------------------------------------------------------------------------------- 1 | package primitive 2 | 3 | // Nil type holds the undefined value 4 | type Nil struct{} 5 | 6 | // IsSimpleType is used to denote whether this object 7 | // is self-evaluating. 8 | func (n Nil) IsSimpleType() bool { 9 | return true 10 | } 11 | 12 | // ToInterface converts this object to a golang value 13 | func (n Nil) ToInterface() any { 14 | return nil 15 | } 16 | 17 | // ToString converts this object to a string. 18 | func (n Nil) ToString() string { 19 | return "nil" 20 | } 21 | 22 | // Type returns the type of this primitive object. 23 | func (n Nil) Type() string { 24 | return "nil" 25 | } 26 | -------------------------------------------------------------------------------- /primitive/symbol.go: -------------------------------------------------------------------------------- 1 | package primitive 2 | 3 | // Symbol is the type for our symbols. 4 | type Symbol string 5 | 6 | // IsSimpleType is used to denote whether this object 7 | // is self-evaluating. 8 | func (s Symbol) IsSimpleType() bool { 9 | return false 10 | } 11 | 12 | // ToInterface converts this object to a golang value 13 | func (s Symbol) ToInterface() any { 14 | return s.ToString() 15 | } 16 | 17 | // ToString converts this object to a string. 18 | func (s Symbol) ToString() string { 19 | return string(s) 20 | } 21 | 22 | // Type returns the type of this primitive object. 23 | func (s Symbol) Type() string { 24 | return "symbol" 25 | } 26 | -------------------------------------------------------------------------------- /primitive/bool.go: -------------------------------------------------------------------------------- 1 | package primitive 2 | 3 | // Bool is our wrapping of bool 4 | type Bool bool 5 | 6 | // IsSimpleType is used to denote whether this object 7 | // is self-evaluating. 8 | func (b Bool) IsSimpleType() bool { 9 | return true 10 | } 11 | 12 | // ToInterface converts this object to a golang value 13 | func (b Bool) ToInterface() any { 14 | return bool(b) 15 | } 16 | 17 | // ToString converts this object to a string. 18 | func (b Bool) ToString() string { 19 | if b { 20 | return "#t" 21 | } 22 | return "#f" 23 | } 24 | 25 | // Type returns the type of this primitive object. 26 | func (b Bool) Type() string { 27 | return "boolean" 28 | } 29 | -------------------------------------------------------------------------------- /primitive/character.go: -------------------------------------------------------------------------------- 1 | package primitive 2 | 3 | // Character holds a string value. 4 | type Character string 5 | 6 | // IsSimpleType is used to denote whether this object 7 | // is self-evaluating. 8 | func (c Character) IsSimpleType() bool { 9 | return true 10 | } 11 | 12 | // ToInterface converts this object to a golang value 13 | func (c Character) ToInterface() any { 14 | if len(c) > 0 { 15 | return c[0] 16 | } 17 | return "" 18 | } 19 | 20 | // ToString converts this object to a string. 21 | func (c Character) ToString() string { 22 | return string(c) 23 | } 24 | 25 | // Type returns the type of this primitive object. 26 | func (c Character) Type() string { 27 | return "character" 28 | } 29 | -------------------------------------------------------------------------------- /primitive/list.go: -------------------------------------------------------------------------------- 1 | package primitive 2 | 3 | import "strings" 4 | 5 | // List holds a collection of other types, including Lists. 6 | type List []Primitive 7 | 8 | // IsSimpleType is used to denote whether this object 9 | // is self-evaluating. 10 | func (l List) IsSimpleType() bool { 11 | return false 12 | } 13 | 14 | // ToString converts this object to a string. 15 | func (l List) ToString() string { 16 | elemStrings := []string{} 17 | for _, e := range l { 18 | elemStrings = append(elemStrings, e.ToString()) 19 | } 20 | return "(" + strings.Join(elemStrings, " ") + ")" 21 | } 22 | 23 | // Type returns the type of this primitive object. 24 | func (l List) Type() string { 25 | return "list" 26 | } 27 | -------------------------------------------------------------------------------- /examples/time.lisp: -------------------------------------------------------------------------------- 1 | ;;; time.lisp - Demonstrate our date/time functions. 2 | 3 | ;; 4 | ;; This is a sample input file for our minimal lisp interpreter. 5 | ;; 6 | ;; We use it to demonstrate the date and time functions. 7 | ;; 8 | ;; (date) and (time) are implemented in our golang application, 9 | ;; and each returns a list of values. The individual fields are 10 | ;; made available by helper-functions defined in our standard-library. 11 | ;; 12 | 13 | (print "The year is %d" (date:year)) 14 | (print "The date is %d/%d/%d" (date:day) (date:month) (date:year)) 15 | (print "The time is %s (%d seconds past the epoch)" (time:hms) (now)) 16 | (print "Today is a %s" (date:weekday)) 17 | 18 | (print "Date as a list %s" (date)) 19 | (print "Time as a list %s" (time)) 20 | -------------------------------------------------------------------------------- /examples/try.lisp: -------------------------------------------------------------------------------- 1 | ;;; try.lisp - Demonstrate our error-handling, with try/catch. 2 | 3 | ;; 4 | ;; This file demonstrates our try/catch behaviour, which allows 5 | ;; catching errors at runtime, and continuing execution. 6 | ;; 7 | 8 | 9 | (try 10 | (print "OK") 11 | (catch e 12 | (print "We expected no error to be thrown, but we got one:%s" e))) 13 | 14 | 15 | (try 16 | (print (/ 1 0)) 17 | (catch e 18 | (print "Expected error caught, when attempting division by zero:%s" e))) 19 | 20 | 21 | (try 22 | (try "foo") 23 | (catch e 24 | (print "Expected error caught, when calling '(try)' with bogus arguments:%s" e))) 25 | 26 | 27 | (try 28 | (nth () 1) 29 | (catch e 30 | (print "Expected error caught, when accessing beyond the end of a list:%s" e))) 31 | -------------------------------------------------------------------------------- /stdlib/stdlib/string-substr.lisp: -------------------------------------------------------------------------------- 1 | ;;; string-substr.lisp - Fetch substrings from a string 2 | 3 | ;; String handling is good to have, and here we implement substr in the 4 | ;; naive way: 5 | ;; 6 | ;; Split the string into a list, and take parts of it using "take" and 7 | ;; "drop". 8 | ;; 9 | 10 | 11 | (set! substr (fn* (str start &len) 12 | "Return a substring of the given string, by starting index. 13 | 14 | The length of the substring is optional." 15 | (if (> start (strlen str)) ; out of bounds? 16 | "" 17 | (if (nil? len) ; start at the given offset 18 | (join (drop start (explode str))) 19 | (join (take (car len) (drop start (explode str)))))))) 20 | -------------------------------------------------------------------------------- /stdlib/stdlib/random.lisp: -------------------------------------------------------------------------------- 1 | ;;; random.lisp - Random things. 2 | 3 | 4 | ;; Choose a random character from a string, or a-z if unspecified 5 | (set! random:char (fn* (&x) 6 | "Return a random character by default from the set a-z. 7 | 8 | If an optional string is provided it will be used as a list of characters to choose from." 9 | (let* (chars (explode "abcdefghijklmnopqrstuvwxyz")) 10 | (if (list? x) 11 | (set! chars (explode (car x)))) 12 | (random:item chars)))) 13 | 14 | ;; random list item 15 | (set! random:item (fn* (lst:list) 16 | "Return a random element from the specified list." 17 | (nth lst (random (length lst))))) 18 | -------------------------------------------------------------------------------- /stdlib/stdlib/sort.lisp: -------------------------------------------------------------------------------- 1 | ;;; sort.lisp - Implementation of quick-sort with a user-defined comparison. 2 | 3 | (set! sort-by (fn* (cmp:function l:list) 4 | "sort-by is a generic quick-sort implementation, which makes use of a user-defined comparison method. 5 | 6 | The function specified will be called with two arguments, and should return true if the first is less than the second. 7 | 8 | See-also: sort" 9 | (if (nil? l) 10 | nil 11 | (let* (cur (car l)) 12 | (append (sort-by cmp (filter (cdr l) (lambda (n) (cmp n cur)))) 13 | (append (cons (car l) null) 14 | (sort-by cmp (filter (cdr l) (lambda (n) (! (cmp n cur))))))))))) 15 | -------------------------------------------------------------------------------- /examples/sentences.lisp: -------------------------------------------------------------------------------- 1 | ;;; sentences.yal -- Generate random sentences. 2 | 3 | ;; Adapted from Norvig, Paradigms of Artificial Intelligence 4 | ;; Programming, pp. 36-43 (MIT License). 5 | ;; 6 | ;; See worked example: 7 | ;; 8 | ;; https://github.com/norvig/paip-lisp/blob/main/docs/chapter2.md 9 | ;; 10 | 11 | 12 | ;; Sentence 13 | (set! sentence (fn* () (list (noun-phrase) (verb-phrase)))) 14 | 15 | ;; Parts 16 | (set! noun-phrase (fn* () (list (Article) (Noun)))) 17 | (set! verb-phrase (fn* () (list (Verb) (noun-phrase)))) 18 | 19 | ;; Words 20 | (set! Article (fn* () (random:item '(the a)))) 21 | (set! Noun (fn* () (random:item '(man ball woman table chair sofa)))) 22 | (set! Verb (fn* () (random:item '(hit took saw liked)))) 23 | 24 | ;; Show some random sentences 25 | (repeat 5 (lambda (n) (print "%s." (join (flatten (sentence)) " ")))) 26 | -------------------------------------------------------------------------------- /builtins/file_info_unix.go: -------------------------------------------------------------------------------- 1 | //go:build !windows 2 | 3 | package builtins 4 | 5 | import ( 6 | "os" 7 | "syscall" 8 | ) 9 | 10 | // getGID returns the group of the file, from the extended information 11 | // available after a stat - that is not portable to Windows though. 12 | // 13 | // This is in a separate file so that we use build-tags to build code 14 | // appropriately. 15 | func getGID(info os.FileInfo) (int, error) { 16 | 17 | stat, _ := info.Sys().(*syscall.Stat_t) 18 | return int(stat.Gid), nil 19 | } 20 | 21 | // getUID returns the owner of the file, from the extended information 22 | // available after a stat - that is not portable to Windows though. 23 | // 24 | // This is in a separate file so that we use build-tags to build code 25 | // appropriately. 26 | func getUID(info os.FileInfo) (int, error) { 27 | 28 | stat, _ := info.Sys().(*syscall.Stat_t) 29 | return int(stat.Uid), nil 30 | } 31 | -------------------------------------------------------------------------------- /stdlib/stdlib/string-pad.lisp: -------------------------------------------------------------------------------- 1 | ;;; string-pad.lisp - String padding, prefix and postfix, functions. 2 | 3 | ;; 4 | ;; This file contains functions for padding a string to a specified 5 | ;; length, using a supplied character-string to extend it. 6 | ;; 7 | 8 | 9 | (set! pad:left (fn* (str add len) 10 | "Pad the given string to a specified length, by pre-pending the given string to it. 11 | 12 | See also: pad:right" 13 | (if (>= (strlen str) len) 14 | str 15 | (pad:left (join (list add str)) add len)))) 16 | 17 | 18 | (set! pad:right (fn* (str add len) 19 | "Pad the given string to the specified length, by repeatedly appending the given char to the value. 20 | 21 | See also: pad:left" 22 | (if (>= (strlen str) len) 23 | str 24 | (pad:right (join (list str add)) add len)))) 25 | -------------------------------------------------------------------------------- /examples/fizzbuzz.lisp: -------------------------------------------------------------------------------- 1 | ;;; fizzbuzz2.lisp - Show the fizzbuzz up to 50. 2 | 3 | ;; Taking advantage of our (cond) primitive we can just return the 4 | ;; string to print for any given number. 5 | 6 | (set! fizzbuzz (fn* (n) 7 | "This function outputs the appropriate fizzbuzz-response 8 | for the specified number. 9 | 10 | 'fizz' when the number is divisible by three, 'buzz' when divisible by five, 11 | and 'fizzbuzz' when divisible by both." 12 | (print "%s" 13 | (cond 14 | (= 0 (% n 15)) "fizzbuzz" 15 | (= 0 (% n 3)) "fizz" 16 | (= 0 (% n 5)) "buzz" 17 | true (str n)) ))) 18 | 19 | 20 | ;; As you can see the function above contains some help-text, or overview. 21 | ;; we can output that like so: 22 | (print (help fizzbuzz)) 23 | 24 | ;; Apply the function to each number 1-50 25 | (apply (nat 51) fizzbuzz) 26 | -------------------------------------------------------------------------------- /primitive/number.go: -------------------------------------------------------------------------------- 1 | package primitive 2 | 3 | import "fmt" 4 | 5 | // Number type holds numbers. 6 | type Number float64 7 | 8 | // IsSimpleType is used to denote whether this object 9 | // is self-evaluating. 10 | func (n Number) IsSimpleType() bool { 11 | return true 12 | } 13 | 14 | // IsInt returns true if this number is an integer 15 | func (n Number) IsInt() bool { 16 | return float64(n) == float64(int(n)) 17 | } 18 | 19 | // ToInterface converts this object to a golang value 20 | func (n Number) ToInterface() any { 21 | 22 | // int? 23 | if n.IsInt() { 24 | return int(n) 25 | } 26 | 27 | // float 28 | return float64(n) 29 | } 30 | 31 | // ToString converts this object to a string. 32 | func (n Number) ToString() string { 33 | 34 | // Is this really an integer? 35 | if n.IsInt() { 36 | return fmt.Sprintf("%d", int(n)) 37 | } 38 | 39 | return fmt.Sprintf("%f", n) 40 | } 41 | 42 | // Type returns the type of this primitive object. 43 | func (n Number) Type() string { 44 | return "number" 45 | } 46 | -------------------------------------------------------------------------------- /builtins/file_info_windows.go: -------------------------------------------------------------------------------- 1 | //go:build windows 2 | 3 | package builtins 4 | 5 | import ( 6 | "fmt" 7 | "os" 8 | ) 9 | 10 | // getGID should return the group of the file, from the extended information 11 | // available after a stat, however on Windows platforms that doesn't work 12 | // in the obvious way. 13 | // 14 | // Here we just return an error to make that apparent to the caller. 15 | // 16 | // This is in a separate file so that we use build-tags to build code 17 | // appropriately. 18 | func getGID(info os.FileInfo) (int, error) { 19 | 20 | return 0, fmt.Errorf("not found") 21 | } 22 | 23 | // getUID should return the owner of the file, from the extended information 24 | // available after a stat, however on Windows platforms that doesn't work 25 | // in the obvious way. 26 | // 27 | // Here we just return an error to make that apparent to the caller. 28 | // 29 | // This is in a separate file so that we use build-tags to build code 30 | // appropriately. 31 | func getUID(info os.FileInfo) (int, error) { 32 | 33 | return 0, fmt.Errorf("not found") 34 | } 35 | -------------------------------------------------------------------------------- /stdlib/stdlib/date.lisp: -------------------------------------------------------------------------------- 1 | ;;; date.lisp - Date-related functions. 2 | 3 | ;; We have a built in function "date" to return the current date 4 | ;; as a list (XXXX DD MM YYYY). 5 | ;; 6 | ;; Here we create some helper functions for retrieving the various 7 | ;; parts of the date, as well as some aliases for ease of typing. 8 | (set! date:day (fn* () 9 | "Return the day of the current month, as an integer." 10 | (nth (date) 1))) 11 | 12 | (set! date:month (fn* () 13 | "Return the number of the current month, as an integer." 14 | (nth (date) 2))) 15 | 16 | 17 | (set! date:weekday (fn* () 18 | "Return a string containing the current day of the week." 19 | (nth (date) 0))) 20 | 21 | (set! date:year (fn* () 22 | "Return the current year, as an integer." 23 | (nth (date) 3))) 24 | 25 | 26 | ;; 27 | ;; define legacy aliases 28 | ;; 29 | (alias day date:day) 30 | (alias month date:month) 31 | (alias weekday date:weekday) 32 | (alias year date:year) 33 | -------------------------------------------------------------------------------- /primitive/error.go: -------------------------------------------------------------------------------- 1 | package primitive 2 | 3 | import "fmt" 4 | 5 | // Error holds an error message. 6 | type Error string 7 | 8 | // ArityError is the error raised when a function, or special form, 9 | // is invoked with the wrong number of arguments. 10 | func ArityError() Error { 11 | return Error("ArityError - Unexpected argument count") 12 | } 13 | 14 | // TypeError is an error raised when a function is called with invalid 15 | // typed argument 16 | func TypeError(msg string) Error { 17 | return Error("TypeError - " + msg) 18 | } 19 | 20 | // IsSimpleType is used to denote whether this object 21 | // is self-evaluating. 22 | func (e Error) IsSimpleType() bool { 23 | return true 24 | } 25 | 26 | // ToInterface converts this object to a golang value 27 | func (e Error) ToInterface() any { 28 | return fmt.Errorf("%s", string(e)) 29 | } 30 | 31 | // ToString converts this object to a string. 32 | func (e Error) ToString() string { 33 | return "ERROR{" + string(e) + "}" 34 | } 35 | 36 | // Type returns the type of this primitive object. 37 | func (e Error) Type() string { 38 | return "error" 39 | } 40 | -------------------------------------------------------------------------------- /go.mod: -------------------------------------------------------------------------------- 1 | module github.com/skx/yal 2 | 3 | go 1.23.0 4 | 5 | toolchain go1.23.2 6 | 7 | require ( 8 | github.com/chzyer/readline v1.5.1 9 | github.com/tliron/commonlog v0.2.19 10 | github.com/tliron/glsp v0.2.2 11 | go.lsp.dev/uri v0.3.0 12 | ) 13 | 14 | require ( 15 | github.com/aymanbagabas/go-osc52/v2 v2.0.1 // indirect 16 | github.com/gorilla/websocket v1.5.3 // indirect 17 | github.com/iancoleman/strcase v0.3.0 // indirect 18 | github.com/lucasb-eyer/go-colorful v1.2.0 // indirect 19 | github.com/mattn/go-isatty v0.0.20 // indirect 20 | github.com/muesli/termenv v0.16.0 // indirect 21 | github.com/petermattis/goid v0.0.0-20250211185408-f2b9d978cd7a // indirect 22 | github.com/pkg/errors v0.9.1 // indirect 23 | github.com/rivo/uniseg v0.4.7 // indirect 24 | github.com/sasha-s/go-deadlock v0.3.5 // indirect 25 | github.com/segmentio/ksuid v1.0.4 // indirect 26 | github.com/sourcegraph/jsonrpc2 v0.2.0 // indirect 27 | github.com/tliron/kutil v0.3.26 // indirect 28 | golang.org/x/crypto v0.34.0 // indirect 29 | golang.org/x/sys v0.30.0 // indirect 30 | golang.org/x/term v0.29.0 // indirect 31 | ) 32 | -------------------------------------------------------------------------------- /_misc/yal.el: -------------------------------------------------------------------------------- 1 | ;;; yal.el -- Sample configuration for using Emacs LSP-mode with YAL 2 | 3 | 4 | ;; Create a keyboard-map for use within YAL files 5 | (defvar yal-mode-map 6 | (let ((map (make-sparse-keymap))) 7 | (define-key map (kbd "C-c TAB") 'completion-at-point) 8 | map)) 9 | 10 | ;; Define a hook which will run when entering YAL mode. 11 | (add-hook 'yal-mode-hook 'lsp-deferred) 12 | 13 | ;; Now create a trivial "yal-mode" 14 | (define-derived-mode yal-mode 15 | lisp-mode "YAL" 16 | "Major mode for working with yet another lisp, YAL.") 17 | 18 | ;; yal-mode will be invoked for *.yal files 19 | (add-to-list 'auto-mode-alist '("\\.yal\\'" . yal-mode)) 20 | 21 | ;; Load the library 22 | (require 'lsp-mode) 23 | 24 | ;; Register an LSP helper 25 | (lsp-register-client 26 | (make-lsp-client :new-connection (lsp-stdio-connection '("yal" "-lsp")) 27 | :major-modes '(yal-mode) 28 | :priority -1 29 | :server-id 'yal-ls)) 30 | 31 | ;; Not sure what this does, but it seems to be necessary 32 | (add-to-list 'lsp-language-id-configuration '(yal-mode . "yal")) 33 | -------------------------------------------------------------------------------- /stdlib/stdlib/time.lisp: -------------------------------------------------------------------------------- 1 | ;;; time.lisp - Time related functions 2 | 3 | 4 | ;; We have a built in function "time" to return the current time 5 | ;; as a list (HH MM SS). 6 | ;; 7 | ;; Here we create some helper functions for retrieving the various 8 | ;; parts of the time, as well as some aliases for ease of typing. 9 | 10 | (set! time:hour (fn* () 11 | "Return the current hour, as an integer." 12 | (nth (time) 0))) 13 | 14 | (set! time:minute (fn* () 15 | "Return the current minute, as an integer." 16 | (nth (time) 1))) 17 | 18 | (set! time:second (fn* () 19 | "Return the current seconds, as an integer." 20 | (nth (time) 2))) 21 | 22 | ;; define legacy aliases 23 | (alias hour time:hour 24 | minute time:minute 25 | second time:second) 26 | 27 | 28 | (set! time:hms (fn* () 29 | "Return the current time as a string, formatted as 'HH:MM:SS'." 30 | (sprintf "%02d:%02d:%02d" 31 | (hour) 32 | (minute) 33 | (second)))) 34 | (alias hms time:hms) 35 | -------------------------------------------------------------------------------- /primitive/primitive.go: -------------------------------------------------------------------------------- 1 | // Package primitive contains the definitions of our primitive types, 2 | // which are "nil", "bool", "number", "string", and "list". 3 | package primitive 4 | 5 | // Primitive is the interface of all our types 6 | type Primitive interface { 7 | 8 | // IsSimpleType is used to denote whether this object 9 | // is self-evaluating. 10 | // 11 | // Simple types include strings, numbers, booleans, etc. 12 | // 13 | // However note that a list is NOT a simple type, as it 14 | // is used to denote a function-call. 15 | IsSimpleType() bool 16 | 17 | // ToString converts this primitive to a string representation. 18 | ToString() string 19 | 20 | // Type returns the type of this object. 21 | Type() string 22 | } 23 | 24 | // ToNative is an optional interface that some of our primitive 25 | // types might choose to implement. 26 | // 27 | // If available this allows a YAL object to be converted to a 28 | // suitable Golang equivalent type/value. 29 | type ToNative interface { 30 | 31 | // ToInterface converts to a native golang type. 32 | ToInterface() interface{} 33 | } 34 | 35 | // IsNil tests whether an expression is nil. 36 | func IsNil(e Primitive) bool { 37 | var n Nil 38 | return e == n 39 | } 40 | -------------------------------------------------------------------------------- /examples/README.md: -------------------------------------------------------------------------------- 1 | # Examples 2 | 3 | This directory contains some simple lisp examples, which can be executed via `yal`. 4 | 5 | 6 | * [adder.lisp](adder.lisp) 7 | * Demonstrate creating an adder with closures. 8 | * [dynamic.lisp](dynamic.lisp) 9 | * Execute code by name, via introspection. 10 | * [fibonacci.lisp](fibonacci.lisp) 11 | * Calculate the first 25 fibonacci numbers. 12 | * [fizzbuzz.lisp](fizzbuzz.lisp) 13 | * Show the fizzbuzz up to 50. 14 | * [fuzz.lisp](fuzz.lisp) 15 | * Generate random expressions and evaluate them, forever. 16 | * [hash.lisp](hash.lisp) 17 | * Demonstrate working with hashes. 18 | * [lisp-tests.lisp](lisp-tests.lisp) 19 | * A simple testing framework for our primitives. 20 | * [mtest.lisp](mtest.lisp) 21 | * Simple tests of our macro system. 22 | * [readme.lisp](readme.lisp) 23 | * Generate a README.md file, based on directory contents. 24 | * [sentences.lisp](sentences.lisp) 25 | * Generate random sentences. 26 | * [sorting.lisp](sorting.lisp) 27 | * Demonstrate generating random lists, and sorting them. 28 | * [test.lisp](test.lisp) 29 | * Simple feature-tests/demonstrations of our system. 30 | * [time.lisp](time.lisp) 31 | * Demonstrate our date/time functions. 32 | * [try.lisp](try.lisp) 33 | * Demonstrate our error-handling, with try/catch. 34 | -------------------------------------------------------------------------------- /stdlib/stdlib/stack.lisp: -------------------------------------------------------------------------------- 1 | ;;; stack.lisp - A simple stack implemented as a list. 2 | 3 | 4 | (defmacro! stack:push (fn* (val stck) 5 | "Push the given value to the top of the stack. 6 | 7 | This is a destructive operation. 8 | 9 | See-also: stack:empty? stack:pop stack:size 10 | " 11 | `(set! ~stck (cons ~val ~stck)))) 12 | 13 | 14 | (defmacro! stack:pop (fn* (stck) 15 | "Remove and return the item from the head of the stack. If the stack is empty nil is returned. 16 | 17 | This is a destructive operation. 18 | 19 | See-also: stack:empty? stack:push stack:size 20 | " 21 | `(let* (val (if (list? ~stck) (car ~stck) nil) 22 | rem (if (list? ~stck) (cdr ~stck) nil)) 23 | (set! ~stck rem t) ; note global set 24 | val))) 25 | 26 | (set! stack:empty? (fn* (stck) 27 | "Return true if the stack is empty, false otherwise. 28 | 29 | See-also: stack:pop stack:push stack:size" 30 | (if (zero? (count stck)) 31 | true 32 | false))) 33 | 34 | (set! stack:size (fn* (stck) 35 | "Return the number of entries present on the stack. 36 | 37 | See-also: stack:empty? stack:pop stack:push" 38 | (count stck))) 39 | -------------------------------------------------------------------------------- /.github/build: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # The basename of our binary 4 | BASE="yal" 5 | 6 | D=$(pwd) 7 | 8 | # I don't even .. 9 | go env -w GOFLAGS="-buildvcs=false" 10 | 11 | # 12 | # We build on multiple platforms/archs 13 | # 14 | BUILD_PLATFORMS="linux darwin freebsd windows" 15 | BUILD_ARCHS="amd64 386" 16 | 17 | # For each platform 18 | for OS in ${BUILD_PLATFORMS[@]}; do 19 | 20 | # For each arch 21 | for ARCH in ${BUILD_ARCHS[@]}; do 22 | 23 | cd ${D} 24 | 25 | # Setup a suffix for the binary 26 | SUFFIX="${OS}" 27 | 28 | # i386 is better than 386 29 | if [ "$ARCH" = "386" ]; then 30 | SUFFIX="${SUFFIX}-i386" 31 | else 32 | SUFFIX="${SUFFIX}-${ARCH}" 33 | fi 34 | 35 | # Windows binaries should end in .EXE 36 | if [ "$OS" = "windows" ]; then 37 | SUFFIX="${SUFFIX}.exe" 38 | fi 39 | 40 | echo "Building for ${OS} [${ARCH}] -> ${BASE}-${SUFFIX}" 41 | 42 | # Run the build 43 | export GOARCH=${ARCH} 44 | export GOOS=${OS} 45 | export CGO_ENABLED=0 46 | 47 | # Build the main-binary 48 | go build -ldflags "-X main.version=$(git describe --tags 2>/dev/null || echo 'master') -X main.sha1sum=$(git rev-parse HEAD)" -o "${BASE}-${SUFFIX}" 49 | 50 | done 51 | done 52 | -------------------------------------------------------------------------------- /primitive/hash_test.go: -------------------------------------------------------------------------------- 1 | package primitive 2 | 3 | import "testing" 4 | 5 | func TestHash(t *testing.T) { 6 | 7 | // Create a hash 8 | h := NewHash() 9 | 10 | out := h.Get("NAME") 11 | _, ok := out.(Nil) 12 | if !ok { 13 | t.Fatalf("expected nil getting hash value that is absent") 14 | } 15 | 16 | h.Set("NAME", String("ME")) 17 | valid := h.Get("NAME") 18 | if valid.ToString() != "ME" { 19 | t.Fatalf("got wrong value") 20 | } 21 | 22 | if !h.IsSimpleType() { 23 | t.Fatalf("expected has to be a simple type") 24 | } 25 | 26 | if h.Type() != "hash" { 27 | t.Fatalf("Wrong type for hash") 28 | } 29 | 30 | if h.ToString() != "{\n\tNAME => ME\n}" { 31 | t.Fatalf("string value of hash was wrong") 32 | } 33 | } 34 | 35 | func TestHashStruct(t *testing.T) { 36 | 37 | // Create a hash 38 | h := NewHash() 39 | 40 | // mark it as a struct 41 | h.SetStruct("pie") 42 | 43 | out := h.Get("NAME") 44 | _, ok := out.(Nil) 45 | if !ok { 46 | t.Fatalf("expected nil getting hash value that is absent") 47 | } 48 | 49 | h.Set("NAME", String("ME")) 50 | valid := h.Get("NAME") 51 | if valid.ToString() != "ME" { 52 | t.Fatalf("got wrong value") 53 | } 54 | 55 | if h.Type() != "pie" { 56 | t.Fatalf("Wrong type for struct") 57 | } 58 | 59 | if h.GetStruct() != "pie" { 60 | t.Fatalf("Wrong struct-type for struct") 61 | } 62 | 63 | } 64 | -------------------------------------------------------------------------------- /.github/run-tests.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # I don't even .. 4 | go env -w GOFLAGS="-buildvcs=false" 5 | 6 | 7 | # Install the tools we use to test our code-quality. 8 | # 9 | # Here we setup the tools to install only if the "CI" environmental variable 10 | # is not empty. This is because locally I have them installed. 11 | # 12 | # NOTE: Github Actions always set CI=true 13 | # 14 | if [ ! -z "${CI}" ] ; then 15 | go install golang.org/x/lint/golint@latest 16 | go install golang.org/x/tools/go/analysis/passes/shadow/cmd/shadow@latest 17 | go install honnef.co/go/tools/cmd/staticcheck@latest 18 | fi 19 | 20 | # Run the static-check tool - we ignore errors in goserver/static.go 21 | t=$(mktemp) 22 | staticcheck -checks all ./... | grep -v "is deprecated"> $t 23 | if [ -s $t ]; then 24 | echo "Found errors via 'staticcheck'" 25 | cat $t 26 | rm $t 27 | exit 1 28 | fi 29 | rm $t 30 | 31 | # At this point failures cause aborts 32 | set -e 33 | 34 | # Run the linter 35 | echo "Launching linter .." 36 | golint -set_exit_status ./... 37 | echo "Completed linter .." 38 | 39 | # Run the shadow-checker 40 | echo "Launching shadowed-variable check .." 41 | go vet -vettool=$(which shadow) ./... 42 | echo "Completed shadowed-variable check .." 43 | 44 | # Run golang tests 45 | go test ./... 46 | 47 | # Run the lisp tests 48 | go build . 49 | ./yal examples/lisp-tests.lisp | _misc/tapview 50 | -------------------------------------------------------------------------------- /examples/readme.lisp: -------------------------------------------------------------------------------- 1 | ;;; readme.lisp - Generate a README.md file, based on directory contents. 2 | 3 | ;; 4 | ;; This directory contains *.lisp, echo of which has a header-line prefixed 5 | ;; with three semi-colons: 6 | ;; 7 | ;; ;;; foo.lisp - Information 8 | ;; 9 | ;; This script reads those files and outputs a simple index, of the filename 10 | ;; and the information. 11 | ;; 12 | 13 | (set! lisp:files (fn* () 14 | "Return a list of all the lisp files in the current directory" 15 | (sort (glob "*.lisp")))) 16 | 17 | 18 | (set! lisp:info (fn* (file) 19 | "Output a brief overview of the given file" 20 | (let* ( 21 | text (file:lines file) 22 | line (nth text 0) 23 | info (match "^(.*)-+[ ]+(.*)$" line)) 24 | (when (list? info) 25 | (print "* [%s](%s)" file file) 26 | (print " * %s" (nth info 2)))))) 27 | 28 | 29 | (set! lisp:index (fn* () 30 | "Generate a README.md snippet" 31 | (let* (files (lisp:files)) 32 | (apply files lisp:info())))) 33 | 34 | (print "# Examples\n") 35 | (print "This directory contains some simple lisp examples, which can be executed via `yal`.\n\n") 36 | 37 | (lisp:index) 38 | -------------------------------------------------------------------------------- /examples/adder.lisp: -------------------------------------------------------------------------------- 1 | ;;; adder.lisp - Demonstrate creating an adder with closures. 2 | 3 | 4 | ;; Generate a function that adds two numbers. 5 | ;; 6 | ;; The first number is a constant, which is set when 7 | ;; the function is called. 8 | ;; 9 | (set! make-adder (fn* (n) 10 | (fn* (m) (+ n m)))) 11 | 12 | (set! doubler (fn* (f) (lambda (x) (f x x)))) 13 | (print ((doubler *) 4)) 14 | 15 | ;; 16 | ;; Here's a function which uses a closure to keep 17 | ;; returning an incremented value each time it is called 18 | ;; 19 | (set! counter (fn* (m) 20 | (fn* () 21 | (do 22 | (set! m (+ m 1) true) 23 | m)))) 24 | 25 | 26 | ;; Now create two adders. 27 | ;; 28 | ;; Here we see how the first value, N, is set. 29 | ;; 30 | ;; The second value in the definition above, M, is 31 | ;; set when the generated function is called. 32 | (set! addFive (make-adder 5)) 33 | (set! addTen (make-adder 10)) 34 | 35 | 36 | ;; 37 | ;; Finally we can invoke our generated functions, 38 | ;; which work as you'd expect: 39 | ;; 40 | (print "(+ 10 5) => %d" (addFive 10)) 41 | (print "(+ 10 3) => %d" (addTen 3)) 42 | 43 | 44 | ;; We can create a counter using the counter function 45 | ;; we defined above too: 46 | (set! count (counter 0)) 47 | 48 | ;; Now call that ten times 49 | (repeat 10 (lambda (n) 50 | (print "Counter shows: %d" (count)))) 51 | 52 | ;; And a final run 53 | (print "Last counter returned: %d" (count)) 54 | -------------------------------------------------------------------------------- /.yalrc: -------------------------------------------------------------------------------- 1 | 2 | ;; Get our hostname. 3 | ;; 4 | ;; 1. If /etc/hostname exists, then read that. 5 | ;; 6 | ;; 2. If "hostname" is a binary on the PATH execute it, and return the output 7 | ;; 8 | ;; 3. Otherwise give up. 9 | ;; 10 | (set! hostname (fn* () 11 | (cond 12 | (file? "/etc/hostname") (slurp "/etc/hostname") 13 | (file:which "hostname") (car (shell (list (file:which "hostname")))) 14 | true "unknown.host.name"))) 15 | 16 | ;; 17 | ;; Trim leading/trailing whichspace from a given string 18 | ;; 19 | (set! trim (fn* (str) 20 | "Trim all leading/trailing whitespace from the given string." 21 | (let* (res (match "^[ \t\r\n]*([^ \t\r\n]+)[ \t\r\n]*" str)) 22 | (if (list? res) 23 | (car (cdr res)) 24 | str)))) 25 | 26 | 27 | ;; (print) returns the value it prints, which is annoying in the REPL 28 | ;; environment, as you'd see repeated output: 29 | ;; 30 | ;; > (print 3) 31 | ;; 3 32 | ;; 3 33 | ;; > 34 | ;; 35 | ;; To avoid this we create a trivial wrapper function that returns nil 36 | ;; 37 | (set! puts (fn* (x) 38 | (do 39 | (print x) 40 | nil))) 41 | 42 | 43 | ;; 44 | ;; OK now we're done, show a banner and launch the REPL 45 | ;; 46 | (print "YAL version %s" (version)) 47 | (print "This is ~/.yalrc on %s - %s %s" (trim (hostname)) (os) (arch) ) 48 | -------------------------------------------------------------------------------- /examples/fibonacci.lisp: -------------------------------------------------------------------------------- 1 | ;;; fibonacci.lisp - Calculate the first 25 fibonacci numbers. 2 | 3 | ;; 4 | ;; This is a sample input file for our minimal lisp interpreter. 5 | ;; 6 | ;; We use it to demonstrate and test some basic features. 7 | ;; 8 | ;; Here we use "while" from our standard library, and have defined a 9 | ;; function to turn "1" into "1st", etc, as appropriate. This uses our 10 | ;; "match" primitive, which is implemented in golang. 11 | ;; 12 | 13 | 14 | ;; Add a suitable suffix to a number. 15 | ;; 16 | ;; e.g. 1 -> 1st 17 | ;; 11 -> 11th 18 | ;; 21 -> 21st 19 | ;; 333 -> 333rd 20 | (set! add-numeric-suffix (fn* (n) 21 | "Add a trailing suffix to make a number readable." 22 | (cond 23 | (match "(^|[^1]+)1$" n) (sprintf "%dst" n) 24 | (match "(^|[^1]+)2$" n) (sprintf "%dnd" n) 25 | (match "(^|[^1]+)3$" n) (sprintf "%drd" n) 26 | true (sprintf "%dth" n) 27 | ))) 28 | 29 | ;; Fibonacci function 30 | (set! fibonacci (fn* (n) 31 | "Calculate the Nth fibonacci number." 32 | (if (<= n 1) 33 | n 34 | (+ (fibonacci (- n 1)) (fibonacci (- n 2)))))) 35 | 36 | 37 | ;; Now call our function in a loop, twenty times. 38 | (let* (n 1) 39 | (while (<= n 25) 40 | (print "%s fibonacci number is %d" (add-numeric-suffix n) (fibonacci n)) 41 | (set! n (+ n 1) true))) 42 | -------------------------------------------------------------------------------- /stdlib/stdlib_test.go: -------------------------------------------------------------------------------- 1 | package stdlib 2 | 3 | import ( 4 | "fmt" 5 | "os" 6 | "strings" 7 | "testing" 8 | ) 9 | 10 | // Test we can exclude all 11 | func TestStdlibExcludeAll(t *testing.T) { 12 | 13 | // By default we get "stuff" 14 | x := Contents() 15 | 16 | if len(x) < 1 { 17 | t.Fatalf("Failed to get contents of stdlib") 18 | } 19 | 20 | // Excluding everything should return nothing 21 | os.Setenv("YAL_STDLIB_EXCLUDE_ALL", "yes") 22 | 23 | x = Contents() 24 | fmt.Printf("%s\n", x) 25 | if len(x) > 0 { 26 | t.Fatalf("We expected no content, but got something, despite $YAL_STDLIB_EXCLUDE_ALL") 27 | } 28 | 29 | // restore 30 | os.Setenv("YAL_STDLIB_EXCLUDE_ALL", "") 31 | } 32 | 33 | // Test we can exclude time.lisp 34 | func TestStdlibExcludeTime(t *testing.T) { 35 | 36 | // By default we get "stuff" 37 | x := Contents() 38 | 39 | if len(x) < 1 { 40 | t.Fatalf("Failed to get contents of stdlib") 41 | } 42 | 43 | // ensure we have "hms" function defined 44 | expected := "(set! time:hms" 45 | 46 | content := string(x) 47 | if !strings.Contains(content, expected) { 48 | t.Fatalf("failed to find expected function: %s", expected) 49 | } 50 | 51 | // Now exclude "time" 52 | os.Setenv("YAL_STDLIB_EXCLUDE", "time") 53 | 54 | // Re-read content 55 | x = Contents() 56 | if len(x) < 1 { 57 | t.Fatalf("Failed to get contents of stdlib") 58 | } 59 | 60 | content = string(x) 61 | if strings.Contains(content, expected) { 62 | t.Fatalf("we shouldn't find the excluded function, but we did: %s", expected) 63 | } 64 | 65 | // restore 66 | os.Setenv("YAL_STDLIB_EXCLUDE", "") 67 | } 68 | -------------------------------------------------------------------------------- /examples/dynamic.lisp: -------------------------------------------------------------------------------- 1 | ;;; dynamic.lisp - Execute code by name, via introspection. 2 | 3 | ;; 4 | ;; I'm not sure whether to be pleased with this or not. 5 | ;; 6 | ;; Given the (string) name of a function to be called, and some 7 | ;; arguments .. call it. 8 | ;; 9 | ;; (env) returns a lists of hashes, so we can find the function with 10 | ;; a given name via `filter`. Assuming only one response then we're 11 | ;; able to find it by name, and execute it. 12 | ;; 13 | (set! call-by-name 14 | (fn* (name:string &args) 15 | (let* (out nil ; out is the result of the filter 16 | nm nil ; nm is the name of the result == name 17 | fn nil) ; fn is the function of the result 18 | 19 | ;; find the entry in the list with the right name 20 | (set! out (filter (env) (lambda (x) (eq (get x :name) name)))) 21 | 22 | ;; If we have a list of arguments, which we will, then 23 | ;; take the first one. 24 | (if (list? args) 25 | (set! args (car args))) 26 | 27 | ;; there should be only one matching entry 28 | (if (= (length out) 1) 29 | (do 30 | (set! nm (get (car out) :name)) ;; nm == name 31 | (set! fn (get (car out) :value)) ;; fn is the function to call 32 | (if fn (fn args))))))) ;; if we got it, invoke it 33 | 34 | 35 | ;; Print a string 36 | (call-by-name "print" "Hello, world!") 37 | 38 | ;; Get an environmental variable 39 | (print (call-by-name "getenv" "HOME")) 40 | 41 | ;; Call print with no arguments 42 | (call-by-name "print") 43 | 44 | ;; The other way to do dynamic calls 45 | (eval "(print (+ 34 43))") 46 | -------------------------------------------------------------------------------- /env/env_test.go: -------------------------------------------------------------------------------- 1 | package env 2 | 3 | import "testing" 4 | 5 | // TestGetSet tests get/set on a variable 6 | func TestGetSet(t *testing.T) { 7 | 8 | e := New() 9 | 10 | // by default the environment is empty 11 | _, ok := e.Get("FOO") 12 | if ok { 13 | t.Fatalf("fetching missing variable shouldn't work") 14 | } 15 | 16 | // Now set 17 | e.Set("FOO", "BAR") 18 | out, ok2 := e.Get("FOO") 19 | if !ok2 { 20 | t.Fatalf("fetching variable shouldn't fail") 21 | } 22 | if out.(string) != "BAR" { 23 | t.Fatalf("variable had wrong value") 24 | } 25 | 26 | } 27 | 28 | func TestItems(t *testing.T) { 29 | 30 | // parent 31 | p := New() 32 | p.Set("FOO", "BAR") 33 | 34 | // child 35 | c := NewEnvironment(p) 36 | 37 | items := c.Items() 38 | if len(items) != 1 { 39 | t.Fatalf("wrong number of items found") 40 | } 41 | 42 | // set in the child 43 | c.Set("FOO", "BART") 44 | items = c.Items() 45 | if len(items) != 1 { 46 | t.Fatalf("wrong number of items found") 47 | } 48 | 49 | if items["FOO"] != "BART" { 50 | t.Fatalf("wrong value in items") 51 | } 52 | 53 | // set in parent 54 | p.Set("NAME", "STEVE") 55 | 56 | items = c.Items() 57 | if len(items) != 2 { 58 | t.Fatalf("wrong item count") 59 | } 60 | } 61 | 62 | func TestScopedSet(t *testing.T) { 63 | 64 | // parent 65 | p := New() 66 | p.Set("FOO", "BAR") 67 | 68 | // child 69 | c := NewEnvironment(p) 70 | 71 | // Child should be able to reach parent variable 72 | val, ok := c.Get("FOO") 73 | if !ok { 74 | t.Fatalf("failed to get variable in parent scope") 75 | } 76 | if val.(string) != "BAR" { 77 | t.Fatalf("got variable; wrong value") 78 | } 79 | 80 | } 81 | -------------------------------------------------------------------------------- /.github/test-ordering.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # 3 | # Trivial script to find *.go files, and ensure their 4 | # functions are all defined in alphabetical order. 5 | # 6 | # Ignore "init" and any "BenchmarkXXX" functions. 7 | # 8 | 9 | use strict; 10 | use warnings; 11 | 12 | use File::Find; 13 | 14 | # Failure count 15 | my $failed = 0; 16 | 17 | # Find all files beneath the current directory 18 | find( { wanted => \&process, no_chdir => 1, follow => 0 }, '.' ); 19 | 20 | # Return the result as an exit code 21 | exit $failed; 22 | 23 | 24 | # Process a file 25 | sub process 26 | { 27 | # Get the filename, and make sure it is a file. 28 | my $file = $File::Find::name; 29 | return unless ( $file =~ /.go$/ ); 30 | 31 | print "$file\n"; 32 | 33 | open( my $handle, "<", $file ) or 34 | die "Failed to read $file: $!"; 35 | 36 | my @subs; 37 | 38 | foreach my $line (<$handle>) 39 | { 40 | if ( $line =~ /^func\s+([^(]+)\(/ ) 41 | { 42 | my $func = $1; 43 | 44 | # Skip init 45 | next if $func eq "init"; 46 | 47 | # Skip BenchmarkXXX 48 | next if $func =~ /^Benchmark/; 49 | 50 | # Record the function now. 51 | push( @subs, $func ); 52 | } 53 | } 54 | close $handle; 55 | 56 | # Is the list of functions sorted? 57 | my @sorted = sort @subs; 58 | my $len = $#sorted; 59 | 60 | my $i = 0; 61 | while ( $i < $len ) 62 | { 63 | if ( $sorted[$i] ne $subs[$i] ) 64 | { 65 | print "$sorted[$i] ne $subs[$i]\n"; 66 | $failed++; 67 | } 68 | $i++; 69 | 70 | } 71 | } 72 | -------------------------------------------------------------------------------- /primitive/procedure_test.go: -------------------------------------------------------------------------------- 1 | package primitive 2 | 3 | import ( 4 | "testing" 5 | 6 | "github.com/skx/yal/env" 7 | ) 8 | 9 | func TestProcedure(t *testing.T) { 10 | 11 | // built-in 12 | b := Procedure{ 13 | F: func(e *env.Environment, args []Primitive) Primitive { 14 | return Nil{} 15 | }, 16 | } 17 | 18 | // lisp 19 | l := Procedure{ 20 | Args: []Symbol{ 21 | Symbol("A"), 22 | Symbol("B"), 23 | }, 24 | Body: List{ 25 | Symbol("+"), 26 | Symbol("A"), 27 | Symbol("B"), 28 | }, 29 | } 30 | 31 | // macro 32 | m := Procedure{ 33 | Macro: true, 34 | Args: []Symbol{ 35 | Symbol("A"), 36 | Symbol("B"), 37 | }, 38 | Body: List{ 39 | Symbol("+"), 40 | Symbol("A"), 41 | Symbol("B"), 42 | }, 43 | } 44 | 45 | if b.IsSimpleType() { 46 | t.Fatalf("did not expect built-in to be a simple type") 47 | } 48 | 49 | if b.Type() != "procedure(golang)" { 50 | t.Fatalf("wrong type for builtin") 51 | } 52 | if b.ToString() != "#built-in-function" { 53 | t.Fatalf("wrong string-type for builtin, got %s", b.ToString()) 54 | } 55 | 56 | if l.Type() != "procedure(lisp)" { 57 | t.Fatalf("wrong type for lisp proc") 58 | } 59 | if l.ToString() != "(lambda (A B) (+ A B))" { 60 | t.Fatalf("wrong string-type for lisp-proc, got %s", l.ToString()) 61 | } 62 | if l.IsSimpleType() { 63 | t.Fatalf("did not expect proc to be a simple type") 64 | } 65 | 66 | if m.Type() != "macro" { 67 | t.Fatalf("wrong type for lisp macro") 68 | } 69 | if m.ToString() != "(macro (A B) (+ A B))" { 70 | t.Fatalf("wrong string-type for macro, got %s", m.ToString()) 71 | } 72 | if m.IsSimpleType() { 73 | t.Fatalf("did not expect macro to be a simple type") 74 | } 75 | } 76 | -------------------------------------------------------------------------------- /config/config.go: -------------------------------------------------------------------------------- 1 | // Package config provides an I/O abstraction for our interpreter, 2 | // allowing it to be embedded and used in places where STDIN and STDOUT 3 | // are not necessarily terminal-based. 4 | // 5 | // All input-reading uses the level of indirection provided here, and 6 | // similarly output goes via the writer we hold here. There is also a 7 | // STDERR stream which is used for (optional) debugging output by our 8 | // main driver. 9 | // 10 | // The I/O abstraction allows a host program to setup different streams 11 | // prior to initializing the interpreter. 12 | package config 13 | 14 | import ( 15 | "io" 16 | "os" 17 | ) 18 | 19 | // Config is a holder for configuration which is used for interfacing 20 | // the interpreter with the outside world. 21 | type Config struct { 22 | 23 | // STDERR is the writer for debug output, by default output 24 | // sent here is discarded. 25 | STDERR io.Writer 26 | 27 | // STDIN is an input-reader used for the (read) function, when 28 | // called with no arguments. 29 | STDIN io.Reader 30 | 31 | // STDOUT is the writer which is used for "(print)". 32 | STDOUT io.Writer 33 | } 34 | 35 | // New returns a new configuration object 36 | func New() *Config { 37 | 38 | e := new(Config) 39 | return e 40 | } 41 | 42 | // DefaultIO returns a configuration which uses the default 43 | // input and output streams - i.e. STDIN and STDOUT work as 44 | // expected. 45 | // 46 | // The STDERR writer is configured to discard output by default. 47 | func DefaultIO() *Config { 48 | e := New() 49 | 50 | // Setup useful input/output streams for default usage. 51 | e.STDIN = os.Stdin 52 | e.STDOUT = os.Stdout 53 | 54 | // STDERR is only used when debugging. 55 | // 56 | // So we can discard output here by default. 57 | e.STDERR = io.Discard 58 | 59 | return e 60 | } 61 | -------------------------------------------------------------------------------- /examples/hash.lisp: -------------------------------------------------------------------------------- 1 | ;;; hash.lisp - Demonstrate working with hashes. 2 | 3 | 4 | 5 | ;; Create a hash, with some details 6 | (set! person { :name "Steve" 7 | :age (- 2022 1976) 8 | :location "Helsinki" 9 | }) 10 | 11 | (print "Keys of person: %s" (keys person)) 12 | (print "Values of person: %s" (vals person)) 13 | 14 | 15 | (if (contains? person :age) 16 | (print "\tThe person has an age attribute")) 17 | (if (contains? person ":location") 18 | (print "\tThe person has an location attribute")) 19 | (if (contains? person :cake) 20 | (print "\tThe person has a cake preference")) 21 | 22 | 23 | ;; This function is used as a callback by apply-hash. 24 | (set! hash-element (fn* (key val) 25 | (print "KEY:%s VAL:%s" key (str val)))) 26 | 27 | ;; The `apply-hash` function will trigger a callback for each key and value 28 | ;; within a hash. 29 | ;; 30 | ;; It is similar to the `apply` function which will apply a function to every 31 | ;; element of a lisp. 32 | (apply-hash person hash-element) 33 | 34 | 35 | ;; Here we see a type-restriction, the following function can only be 36 | ;; invoked with a hash-argument. 37 | (set! blah (fn* (h:hash) (print "Got argument of type %s" (type h)))) 38 | 39 | ;; Call it 40 | (blah person) 41 | 42 | ;; Use get/set to update the hash properties 43 | (print "Original name: %s" (get person :name)) 44 | (set person :name "Bobby") 45 | (print "Updated name: %s" (get person :name)) 46 | 47 | ;; The (env) function returns a list of hashes, one for each value in 48 | ;; the environment. 49 | ;; 50 | ;; Here we filter the output to find any functions that match the 51 | ;; regular expression /int/ 52 | (set! out (filter (env) (lambda (x) (match "int" (get x :name))))) 53 | 54 | ;; Show the results 55 | (print "Values in the environment matching the regexp /int/\n%s" out) 56 | 57 | ;; 58 | (print "Function in env. matching regexp /int/:") 59 | (apply out (lambda (x) (print "\t%s" (get x :name)))) 60 | -------------------------------------------------------------------------------- /main_test.go: -------------------------------------------------------------------------------- 1 | package main 2 | 3 | import ( 4 | "fmt" 5 | "testing" 6 | 7 | "github.com/skx/yal/builtins" 8 | "github.com/skx/yal/env" 9 | "github.com/skx/yal/eval" 10 | "github.com/skx/yal/primitive" 11 | "github.com/skx/yal/stdlib" 12 | ) 13 | 14 | // The interpreter we're going to execute with. 15 | var interpreter *eval.Eval 16 | 17 | // The environment contains the primitives the interpreter uses. 18 | var environment *env.Environment 19 | 20 | // Create the interpreter, and parse the source of our benchmark script. 21 | // 22 | // Only do this once, at startup. 23 | func init() { 24 | // Create a new environment 25 | environment = env.New() 26 | 27 | // Populate with the default primitives 28 | builtins.PopulateEnvironment(environment) 29 | 30 | // The script we're going to run 31 | content := ` 32 | (define fact (lambda (n) 33 | (if (<= n 1) 34 | 1 35 | (* n (fact (- n 1)))))) 36 | 37 | (fact 100) 38 | ` 39 | 40 | // Read the standard library 41 | pre := stdlib.Contents() 42 | 43 | // Prepend that to the users' script 44 | src := string(pre) + "\n" + string(content) 45 | 46 | // Create a new interpreter with that source 47 | interpreter = eval.New(src) 48 | } 49 | 50 | // BenchmarkGoFactorial allows running the golang benchmark. 51 | func BenchmarkGoFactorial(b *testing.B) { 52 | for i := 0; i < b.N; i++ { 53 | fact(100) 54 | } 55 | } 56 | 57 | // BenchmarkYALFactorial allows running the lisp benchmark. 58 | func BenchmarkYALFactorial(b *testing.B) { 59 | var out primitive.Primitive 60 | 61 | for i := 0; i < b.N; i++ { 62 | 63 | // Run 100! 64 | out = interpreter.Evaluate(environment) 65 | } 66 | 67 | // Did we get an error? Then show it. 68 | if _, ok := out.(primitive.Error); ok { 69 | fmt.Printf("Error running: %v\n", out) 70 | } 71 | 72 | } 73 | 74 | // fact is a benchmark implementation in pure-go for comparison purposes. 75 | func fact(n int64) int64 { 76 | if n == 0 { 77 | return 1 78 | } 79 | return n * fact(n-1) 80 | } 81 | -------------------------------------------------------------------------------- /stdlib/stdlib/type-checks.lisp: -------------------------------------------------------------------------------- 1 | ;;; type-checks.lisp - Type-comparisons for given objects 2 | 3 | ;; There is a built in `type` function which returns the type of an object. 4 | ;; 5 | ;; Use this to define some simple methods to test argument-types 6 | (set! boolean? (fn* (x) 7 | "Returns true if the argument specified is a boolean value." 8 | (eq (type x) "boolean"))) 9 | 10 | (set! error? (fn* (x) 11 | "Returns true if the argument specified is an error-value." 12 | (eq (type x) "error"))) 13 | 14 | (set! function? (fn* (x) "Returns true if the argument specified is a function, either a built-in function, or a user-written one." 15 | (or 16 | (list 17 | (eq (type x) "procedure(lisp)") 18 | (eq (type x) "procedure(golang)"))))) 19 | 20 | (set! hash? (fn* (x) 21 | "Returns true if the argument specified is a hash." 22 | (eq (type x) "hash"))) 23 | 24 | (set! macro? (fn* (x) 25 | "Returns true if the argument specified is a macro." 26 | (eq (type x) "macro"))) 27 | 28 | (set! list? (fn* (x) 29 | "Returns true if the argument specified is a list." 30 | (eq (type x) "list"))) 31 | 32 | (set! number? (fn* (x) 33 | "Returns true if the argument specified is a number." 34 | (eq (type x) "number"))) 35 | 36 | (set! string? (fn* (x) 37 | "Returns true if the argument specified is a string." 38 | (eq (type x) "string"))) 39 | 40 | (set! character? (fn* (x) 41 | "Returns true if the argument specified is a character." 42 | (eq (type x) "character"))) 43 | 44 | (set! symbol? (fn* (x) 45 | "Returns true if the argument specified is a symbol." 46 | (eq (type x) "symbol"))) 47 | -------------------------------------------------------------------------------- /stdlib/stdlib/string-case.lisp: -------------------------------------------------------------------------------- 1 | ;;; string-case.lisp - Convert a string to upper/lower case 2 | 3 | ;; 4 | ;; This is either gross or cool. 5 | ;; 6 | ;; Define a hash which has literal characters and their upper-case, and 7 | ;; lower-cased versions 8 | ;; 9 | (set! upper-table { 10 | a "A" 11 | b "B" 12 | c "C" 13 | d "D" 14 | e "E" 15 | f "F" 16 | g "G" 17 | h "H" 18 | i "I" 19 | j "J" 20 | k "K" 21 | l "L" 22 | m "M" 23 | n "N" 24 | o "O" 25 | p "P" 26 | q "Q" 27 | r "R" 28 | s "S" 29 | t "T" 30 | u "U" 31 | v "V" 32 | w "W" 33 | x "X" 34 | y "Y" 35 | z "Z" 36 | } ) 37 | 38 | (set! lower-table { 39 | A "a" 40 | B "b" 41 | C "c" 42 | D "d" 43 | E "e" 44 | F "f" 45 | G "g" 46 | H "h" 47 | I "i" 48 | J "j" 49 | K "k" 50 | L "l" 51 | M "m" 52 | N "n" 53 | O "o" 54 | P "p" 55 | Q "q" 56 | R "r" 57 | S "s" 58 | T "t" 59 | U "u" 60 | V "v" 61 | W "w" 62 | X "x" 63 | Y "y" 64 | Z "z" 65 | } ) 66 | 67 | 68 | ;; Translate the elements of the string using the specified hash 69 | (set! translate (fn* (x:string hsh:hash) 70 | "Translate each character in the given string, via the means of the supplied lookup-table. 71 | 72 | This is used by both 'upper' and 'lower'." 73 | (let* (chrs (split x "")) 74 | (join (map chrs (lambda (x) 75 | (if (get hsh x) 76 | (get hsh x) 77 | x))))))) 78 | 79 | ;; Convert the given string to upper-case, via the lookup table. 80 | (set! upper (fn* (x:string) 81 | "Convert each character from the supplied string to upper-case, and return that string." 82 | (translate x upper-table))) 83 | 84 | ;; Convert the given string to upper-case, via the lookup table. 85 | (set! lower (fn* (x:string) 86 | "Convert each character from the supplied string to lower-case, and return that string." 87 | (translate x lower-table))) 88 | -------------------------------------------------------------------------------- /stdlib/stdlib/logical.lisp: -------------------------------------------------------------------------------- 1 | ;;; logical.lisp - Logical functions. 2 | 3 | 4 | ;; Not is useful 5 | (set! not (fn* (x) 6 | "Return the inverse of the given boolean value." 7 | (if x #f #t))) 8 | 9 | (alias ! not) 10 | 11 | 12 | ;; This is a bit sneaky. NOTE there is no short-circuiting here. 13 | ;; 14 | ;; Given a list use `filter` to return those items which are "true". 15 | ;; 16 | ;: If the length of the input list, and the length of the filtered list 17 | ;; are the same then EVERY element was true so our AND result is true. 18 | (set! and (fn* (xs:list) 19 | "Return true if every item in the specified list is true. 20 | 21 | NOTE: This is not a macro, so all arguments are evaluated." 22 | (let* (res nil) 23 | (set! res (filter xs (lambda (x) (if x true false)))) 24 | (if (= (length res) (length xs)) 25 | true 26 | false)))) 27 | 28 | (alias && and) 29 | 30 | ;; This is also a bit sneaky. NOTE there is no short-circuiting here. 31 | ;; 32 | ;; Given a list use `filter` to return those items which are "true". 33 | ;; 34 | ;; If the output list has at least one element that was true then the 35 | ;; OR result is true. 36 | (set! or (fn* (xs:list) 37 | "Return true if any value in the specified list contains a true value. 38 | 39 | NOTE: This is not a macro, so all arguments are evaluated." 40 | (let* (res nil) 41 | (set! res (filter xs (lambda (x) (if x true false)))) 42 | (if (> (length res) 0) 43 | true 44 | false)))) 45 | 46 | (alias || or) 47 | 48 | 49 | ;; every is useful and almost a logical operation 50 | (set! every (fn* (xs:list fun:function) 51 | "Return true if applying every element of the list through the specified function resulted in a true result. 52 | 53 | NOTE: This is not a macro, so all arguments are evaluated." 54 | (let* (res (map xs fun)) 55 | (if (and res) 56 | true 57 | false)))) 58 | -------------------------------------------------------------------------------- /primitive/procedure.go: -------------------------------------------------------------------------------- 1 | package primitive 2 | 3 | import "github.com/skx/yal/env" 4 | 5 | // GolangPrimitiveFn is the type which represents a function signature for 6 | // a lisp-usable function implemented in golang. 7 | type GolangPrimitiveFn func(e *env.Environment, args []Primitive) Primitive 8 | 9 | // Procedure holds a user-defined function. 10 | // 11 | // This structure is used to hold both the built-in functions, implemented in 12 | // golang and those which are written in lisp - either as functions or macros. 13 | type Procedure struct { 14 | 15 | // Arguments to this procedure. 16 | Args []Symbol 17 | 18 | // Defaults supplied when the procedure was defined 19 | Defaults map[Symbol]Primitive 20 | 21 | // Body is the body to execute, in the case where F is nil. 22 | Body Primitive 23 | 24 | // Env contains the environment within which this procedure is executed. 25 | Env *env.Environment 26 | 27 | // F contains a pointer to the golang implementation of this procedure, 28 | // if it is a native one. 29 | F GolangPrimitiveFn 30 | 31 | // Help contains some function-specific help text, ideally with 32 | // an example usage of the function. 33 | Help string 34 | 35 | // Macro is true is this function should have arguments passed literally, and 36 | // not evaluated. 37 | Macro bool 38 | } 39 | 40 | // IsSimpleType is used to denote whether this object 41 | // is self-evaluating. 42 | func (p *Procedure) IsSimpleType() bool { 43 | return false 44 | } 45 | 46 | // ToString converts this object to a string. 47 | func (p *Procedure) ToString() string { 48 | if p.F != nil { 49 | return "#built-in-function" 50 | } 51 | args := List{} 52 | for _, x := range p.Args { 53 | args = append(args, x) 54 | } 55 | 56 | // might be a macro 57 | first := "lambda" 58 | if p.Macro { 59 | first = "macro" 60 | } 61 | 62 | return "(" + first + " " + args.ToString() + " " + p.Body.ToString() + ")" 63 | } 64 | 65 | // Type returns the type of this primitive object. 66 | func (p *Procedure) Type() string { 67 | if p.Macro { 68 | return "macro" 69 | } 70 | if p.F != nil { 71 | return "procedure(golang)" 72 | } 73 | return "procedure(lisp)" 74 | } 75 | -------------------------------------------------------------------------------- /stdlib/stdlib.go: -------------------------------------------------------------------------------- 1 | // Package stdlib contains a simple/small standard-library, which is written in lisp itself. 2 | // 3 | // By default our standard library is loaded prior to the execution of any user-supplied 4 | // code, however parts of it can be selectively ignored, or the whole thing. 5 | // 6 | // If the environmental varialbe "YAL_STDLIB_EXCLUDE_ALL" contains non-empty content then 7 | // all of our standard-library is disabled. 8 | // 9 | // Otherwise if YAL_STDLIB_EXCLUDE is set to a non-empty string it will be assumed to be 10 | // a comma-separated list of filename substrings to exclude. 11 | package stdlib 12 | 13 | import ( 14 | "embed" // embedded-resource magic 15 | "fmt" 16 | "os" 17 | "path/filepath" 18 | "strings" 19 | ) 20 | 21 | //go:embed stdlib/*.lisp 22 | var stdlib embed.FS 23 | 24 | // Contents returns the embedded contents of our Lisp standard-library. 25 | // 26 | // We embed "*.lisp" when we build our binary 27 | func Contents() []byte { 28 | 29 | // We can allow disabling the stdlib - if that is the case 30 | // we return nothing. 31 | if os.Getenv("YAL_STDLIB_EXCLUDE_ALL") != "" { 32 | return []byte{} 33 | } 34 | 35 | // Result we'll return, start by ensuring we're loading 36 | // our standard library 37 | result := []byte("(stdlib-start)\n") 38 | 39 | // We might exclude only one/two files 40 | exclude := []string{} 41 | if os.Getenv("YAL_STDLIB_EXCLUDE") != "" { 42 | exclude = strings.Split(os.Getenv("YAL_STDLIB_EXCLUDE"), ",") 43 | } 44 | 45 | // Read the list of entries - can't fail 46 | entries, _ := stdlib.ReadDir("stdlib") 47 | 48 | // For each entry 49 | for _, entry := range entries { 50 | 51 | // Get the filename 52 | fp := filepath.Join("stdlib", entry.Name()) 53 | 54 | // Does this match an excluded value? 55 | skip := false 56 | 57 | for _, tmp := range exclude { 58 | if strings.Contains(fp, tmp) { 59 | skip = true 60 | } 61 | } 62 | 63 | if skip { 64 | fmt.Printf("Skipping %s\n", fp) 65 | continue 66 | } 67 | 68 | // Read the content - can't fail 69 | data, _ := stdlib.ReadFile(fp) 70 | 71 | // Append to our result 72 | result = append(result, data...) 73 | } 74 | 75 | // Ensure we're finished with our standard library now. 76 | suffix := "\n(stdlib-end)\n" 77 | result = append(result, suffix...) 78 | 79 | return result 80 | } 81 | -------------------------------------------------------------------------------- /primitive/hash.go: -------------------------------------------------------------------------------- 1 | package primitive 2 | 3 | import "sort" 4 | 5 | // Hash holds a collection of other types, indexed by string 6 | type Hash struct { 7 | 8 | // Entries contains the key/value pairs this object holds. 9 | Entries map[string]Primitive 10 | 11 | // StructType contains the name of this struct, if it is being 12 | // being used to implement a Struct, rather than a Hash 13 | StructType string 14 | } 15 | 16 | // Get returns the value of a given index 17 | func (h Hash) Get(key string) Primitive { 18 | x, ok := h.Entries[key] 19 | if ok { 20 | return x 21 | } 22 | return Nil{} 23 | } 24 | 25 | // GetStruct returns the name of the structure this object contains, if any 26 | func (h *Hash) GetStruct() string { 27 | return h.StructType 28 | } 29 | 30 | // IsSimpleType is used to denote whether this object 31 | // is self-evaluating. 32 | func (h Hash) IsSimpleType() bool { 33 | return true 34 | } 35 | 36 | // NewHash creates a new hash, and ensures that the storage-space 37 | // is initialized. 38 | func NewHash() Hash { 39 | h := Hash{} 40 | h.Entries = make(map[string]Primitive) 41 | return h 42 | } 43 | 44 | // Set stores a value in the hash 45 | func (h Hash) Set(key string, val Primitive) { 46 | h.Entries[key] = val 47 | } 48 | 49 | // SetStruct marks this as a "struct" type instead of a "hash type", 50 | // when queried by lisp 51 | func (h *Hash) SetStruct(name string) { 52 | h.StructType = name 53 | } 54 | 55 | // ToString converts this object to a string. 56 | // 57 | // Note that we sort the keys before returning the stringified object, 58 | // which allows us to use the "eq" test on hashes with identical key/values, 59 | // regardless of their ordering. 60 | func (h Hash) ToString() string { 61 | 62 | // Output prefix. 63 | out := "{\n" 64 | 65 | // Get the keys in our hash. 66 | keys := []string{} 67 | 68 | for x := range h.Entries { 69 | keys = append(keys, x) 70 | } 71 | 72 | // Sort the list of keys 73 | sort.Strings(keys) 74 | 75 | // Now we can get a consistent ordering for our 76 | // hash keys/value pairs. 77 | for _, key := range keys { 78 | out += "\t" + key + " => " + h.Entries[key].ToString() + "\n" 79 | } 80 | 81 | // Terminate the string representation and return. 82 | out += "}" 83 | return out 84 | } 85 | 86 | // Type returns the type of this primitive object. 87 | func (h Hash) Type() string { 88 | if h.StructType == "" { 89 | return "hash" 90 | } 91 | return h.StructType 92 | } 93 | -------------------------------------------------------------------------------- /stdlib/stdlib/comparisons.lisp: -------------------------------------------------------------------------------- 1 | ;;; comparisons.lisp - boolean, character, and numerical comparison functions. 2 | 3 | 4 | ;; We've defined "<" in natively, in golang. 5 | ;; 6 | ;; We can define the other numerical relational comparisons in terms of that. 7 | (set! > (fn* (a b) 8 | "Return true if a is greater than b." 9 | (< b a))) 10 | 11 | (set! >= (fn* (a b) 12 | "Return true if a is greater than, or equal to b." 13 | (! (< a b)))) 14 | (set! <= (fn* (a b) 15 | "Return true if a is less than, or equal to, b." 16 | (! (> a b)))) 17 | 18 | 19 | ;; We've defined "char<" in natively, in golang. 20 | ;; 21 | ;; We can define the other relational comparisons in terms of that. 22 | (set! char> (fn* (a b) 23 | "Return true if a is greater than b." 24 | (char< b a))) 25 | 26 | (set! char>= (fn* (a b) 27 | "Return true if a is greater than, or equal to b." 28 | (! (char< a b)))) 29 | (set! char<= (fn* (a b) 30 | "Return true if a is less than, or equal to, b." 31 | (! (char> a b)))) 32 | 33 | 34 | ;; We've defined "string<" in natively, in golang. 35 | ;; 36 | ;; We can define the other relational comparisons in terms of that. 37 | (set! string> (fn* (a b) 38 | "Return true if a is greater than b." 39 | (string< b a))) 40 | 41 | (set! string>= (fn* (a b) 42 | "Return true if a is greater than, or equal to b." 43 | (! (string< a b)))) 44 | (set! string<= (fn* (a b) 45 | "Return true if a is less than, or equal to, b." 46 | (! (string> a b)))) 47 | 48 | 49 | ;; 50 | ;; Some simple tests of specific numbers. 51 | ;; 52 | (set! zero? (fn* (n) 53 | "Return true if the number supplied as the first argument to this function is equal to zero." 54 | (= n 0))) 55 | 56 | (set! one? (fn* (n) 57 | "Return true if the number supplied as the argument to this function is equal to one." 58 | (= n 1))) 59 | 60 | (set! even? (fn* (n) 61 | "Return true if the number supplied as the argument to this function is even." 62 | (zero? (% n 2)))) 63 | 64 | (set! odd? (fn* (n) 65 | "Return true if the number supplied as the argument to this function is odd." 66 | (! (even? n)))) 67 | 68 | ;; 69 | ;; Some simple tests of specific boolean results 70 | ;; 71 | (def! true? (fn* (arg) 72 | "Return true if the argument supplied to this function is true." 73 | (if (eq #t arg) true false))) 74 | 75 | (def! false? (fn* (arg) 76 | "Return true if the argument supplied to this function is false." 77 | (if (eq #f arg) true false))) 78 | -------------------------------------------------------------------------------- /stdlib/stdlib/maths.lisp: -------------------------------------------------------------------------------- 1 | ;;; maths.lisp - Some simple maths-related primitives 2 | 3 | ;; inc/dec are useful primitives to have 4 | (set! inc (fn* (n:number (by 1)) 5 | "inc will add one to the supplied value, and return the result. 6 | 7 | If the optional second value is supplied it will be used instead of one." 8 | (+ n by))) 9 | 10 | (set! dec (fn* (n:number (by 1)) 11 | "dec will subtract one from the supplied value, and return the result. 12 | 13 | If the optional second value is supplied it will be used instead of one." 14 | (- n by))) 15 | 16 | ;; PI 17 | (set! pi (fn* () 18 | "Return the value of PI, calculated via arctan, as per https://en.m.wikibooks.org/wiki/Trigonometry/Calculating_Pi" 19 | (* 4 (+ (* 6 (atan (/ 1 8))) (* 2 (atan (/ 1 57))) (atan (/ 1 239)))) 20 | )) 21 | 22 | ;; Square root 23 | (set! sqrt (fn* (x:number) 24 | "Calculate the square root of the given value." 25 | (# x 0.5))) 26 | 27 | ;; More mathematical functions relating to negative numbers. 28 | (set! neg (fn* (n:number) 29 | "Negate the supplied number, and return it." 30 | (- 0 n))) 31 | 32 | (set! neg? (fn* (n:number) 33 | "Return true if the supplied number is negative." 34 | (< n 0))) 35 | 36 | (set! pos? (fn* (n:number) 37 | "Return true if the supplied number is positive." 38 | (> n 0))) 39 | 40 | (set! abs (fn* (n:number) 41 | "Return the absolute value of the supplied number." 42 | (if (neg? n) (neg n) n))) 43 | 44 | (set! sign (fn* (n:number) 45 | "Return 1 if the specified number is positive, and -1 if it is negative." 46 | (if (neg? n) (neg 1) 1))) 47 | 48 | ;; Now define min/max using reduce 49 | (set! min (fn* (xs:list) 50 | "Return the smallest integer from the list of numbers supplied." 51 | (if (nil? xs) 52 | () 53 | (reduce xs 54 | (lambda (a b) 55 | (if (< a b) a b)) 56 | (car xs))))) 57 | 58 | (set! max (fn* (xs:list) 59 | "Return the maximum integer from the list of numbers supplied." 60 | (if (nil? xs) 61 | () 62 | (reduce xs 63 | (lambda (a b) 64 | (if (< a b) b a)) 65 | (car xs))))) 66 | 67 | 68 | (set! sum (fn* (xs:list) 69 | "Return the sum of numbers in the specified list" 70 | (reduce xs 71 | (lambda (a b) 72 | (+ a b)) 73 | 0))) 74 | 75 | (set! mean (fn* (xs:list) 76 | "Return the average (mean) of the numbers in the given list" 77 | (/ (sum xs) (count xs)))) 78 | -------------------------------------------------------------------------------- /builtins/builtins_shell_test.go: -------------------------------------------------------------------------------- 1 | //go:build !windows 2 | // +build !windows 3 | 4 | package builtins 5 | 6 | import ( 7 | "os" 8 | "strings" 9 | "testing" 10 | 11 | "github.com/skx/yal/primitive" 12 | ) 13 | 14 | // TestShell tests shell - but only on Linux/Unix 15 | func TestShell(t *testing.T) { 16 | 17 | // calling with no argument 18 | out := shellFn(ENV, []primitive.Primitive{}) 19 | 20 | // Will lead to an error 21 | _, ok := out.(primitive.Error) 22 | if !ok { 23 | t.Fatalf("expected error, got %v", out) 24 | } 25 | 26 | // One argument, but the wrong type 27 | out = shellFn(ENV, []primitive.Primitive{ 28 | primitive.Number(3), 29 | }) 30 | 31 | var e primitive.Primitive 32 | e, ok = out.(primitive.Error) 33 | if !ok { 34 | t.Fatalf("expected error, got %v", out) 35 | } 36 | if !strings.Contains(e.ToString(), "not a list") { 37 | t.Fatalf("got error, but wrong one %v", out) 38 | } 39 | 40 | // One argument, but an empty list, not a valid one. 41 | out = shellFn(ENV, []primitive.Primitive{ 42 | primitive.List{}, 43 | }) 44 | 45 | e, ok = out.(primitive.Error) 46 | if !ok { 47 | t.Fatalf("expected error, got %v", out) 48 | } 49 | if !strings.Contains(e.ToString(), "must be non-empty") { 50 | t.Fatalf("got error, but wrong one %v", out) 51 | } 52 | 53 | // Echo command to execute. 54 | cmd := primitive.List{} 55 | cmd = append(cmd, primitive.String("echo")) 56 | cmd = append(cmd, primitive.String("foo")) 57 | cmd = append(cmd, primitive.String("bar")) 58 | 59 | // Run the command 60 | res := shellFn(ENV, []primitive.Primitive{cmd}) 61 | 62 | // Response should be a list 63 | lst, ok2 := res.(primitive.List) 64 | if !ok2 { 65 | t.Fatalf("expected (shell) to return a list, got %v", res) 66 | } 67 | 68 | // with two entries 69 | if len(lst) != 2 { 70 | t.Fatalf("expected (shell) result to have two entries, got %v", lst) 71 | } 72 | 73 | // 74 | // Now: run a command that will fail 75 | // 76 | fail := primitive.List{} 77 | fail = append(fail, primitive.String("/fdsf/fdsf/-path-not/exists")) 78 | 79 | // Run the command 80 | out = shellFn(ENV, []primitive.Primitive{fail}) 81 | 82 | // Will lead to an error 83 | _, ok = out.(primitive.Error) 84 | if !ok { 85 | t.Fatalf("expected error, got %v", out) 86 | } 87 | 88 | // 89 | // Now: Pretend we're running under a fuzzer 90 | // 91 | // Preserve any previous content of $FUZZ 92 | // 93 | old := os.Getenv("FUZZ") 94 | os.Setenv("FUZZ", "FUZZ") 95 | res = shellFn(ENV, []primitive.Primitive{cmd}) 96 | os.Setenv("FUZZ", old) 97 | 98 | // Response should still be a list 99 | lst, ok2 = res.(primitive.List) 100 | if !ok2 { 101 | t.Fatalf("expected (shell) to return a list, got %v", res) 102 | } 103 | 104 | // with zero entries 105 | if len(lst) > 0 { 106 | t.Fatalf("expected (shell) result to have zero entries, got %v", lst) 107 | } 108 | 109 | } 110 | -------------------------------------------------------------------------------- /stdlib/stdlib/file.lisp: -------------------------------------------------------------------------------- 1 | ;;; file.lisp - File-related primitives 2 | 3 | 4 | ;; Wrappers for accessing results of (file:stat) 5 | (set! file:stat:size (fn* (path) 6 | "Return the size of the given file, return -1 on error." 7 | (let* (info (file:stat path)) 8 | (cond 9 | (nil? info) -1 10 | true (nth info 1))))) 11 | 12 | (set! file:stat:uid (fn* (path) 13 | "Return the UID of the given file owner, return '' on error." 14 | (let* (info (file:stat path)) 15 | (cond 16 | (nil? info) "" 17 | true (nth info 2))))) 18 | 19 | 20 | (set! file:stat:gid (fn* (path) 21 | "Return the GID of the given file owner, return '' on error." 22 | (let* (info (file:stat path)) 23 | (cond 24 | (nil? info) "" 25 | true (nth info 3))))) 26 | 27 | (set! file:stat:mode (fn* (path) 28 | "Return the mode of the given file, return '' on error." 29 | (let* (info (file:stat path)) 30 | (cond 31 | (nil? info) "" 32 | true (nth info 4))))) 33 | 34 | (set! file:which (fn* (binary) 35 | "Return the complete path to the specified binary, found via the users' PATH setting. 36 | 37 | If the binary does not exist in a directory located upon the PATH nil will be returned. 38 | 39 | NOTE: This is a non-portable function! 40 | 41 | 1. It assumes that the environmental variable PATH exists. 42 | 2. It assumes $PATH can be split by ':' 43 | 3. It assumes '/' works as a directory separator. 44 | " 45 | (let* (path (split (getenv "PATH") ":") 46 | res (filter path (lambda (dir) (exists? (join (list dir "/" binary)))))) 47 | (if res 48 | (join (list (car res) "/" binary)))))) 49 | 50 | 51 | ;; Define a legacy alias 52 | (alias slurp file:read) 53 | 54 | ;; Read a file, and execute the contents 55 | (def! load-file (fn* (filename) 56 | "Load and execute the contents of the supplied filename." 57 | (eval (join (list "(do " (slurp filename) "\nnil)"))))) 58 | 59 | 60 | ;; Similar to load-file, but with automatic suffix addition and error-testing. 61 | (def! require (fn* (name) 62 | "Load and execute the given file, adding a .yal suffix. 63 | 64 | To load and execute foo.yal, returning nil if that doesn't exist: 65 | 66 | Example: (require 'foo)" 67 | (let* (fname (sprintf "%s%s" name ".yal")) 68 | (if (file:stat fname) 69 | (load-file fname) 70 | nil)))) 71 | -------------------------------------------------------------------------------- /_misc/init.lua: -------------------------------------------------------------------------------- 1 | -- 2 | -- ~/.config/nvim/init.lua 3 | -- 4 | ---- 5 | 6 | -- 7 | -- I used two references to build up this "solution": 8 | -- 9 | -- https://vonheikemen.github.io/devlog/tools/manage-neovim-lsp-client-without-plugins/ 10 | -- 11 | -- Then for the completion I added the "config.on_attach" section, via this comment: 12 | -- 13 | -- https://www.reddit.com/r/neovim/comments/rs47cx/tsserver_and_vimlspomnifunc/ 14 | -- 15 | -- I'm sure there are better approaches. 16 | 17 | 18 | -- 19 | -- When *.yal files are loaded then set the filetype to be lisp 20 | -- 21 | vim.filetype.add { 22 | pattern = { 23 | ['.*.yal'] = 'lisp', 24 | } 25 | } 26 | 27 | -- 28 | -- Define a helper function which will associate our LSP 29 | -- magic with the appropriate filenames. 30 | -- 31 | -- It'll setup completion too. 32 | -- 33 | local launch_yal_server = function() 34 | local autocmd 35 | 36 | 37 | local filetypes = { 38 | 'lisp', 39 | } 40 | 41 | local config = { 42 | cmd = {'yal', '-lsp'}, 43 | name = 'yal', 44 | root_dir = vim.fn.getcwd(), 45 | capabilities = vim.lsp.protocol.make_client_capabilities(), 46 | } 47 | 48 | -- This gives completion. 49 | config.on_attach = function(client, bufnr) 50 | vim.api.nvim_buf_set_option(bufnr, 'omnifunc', 'v:lua.vim.lsp.omnifunc') 51 | end 52 | 53 | config.on_init = function(client, results) 54 | local buf_attach = function() 55 | vim.lsp.buf_attach_client(0, client.id) 56 | end 57 | 58 | autocmd = vim.api.nvim_create_autocmd('FileType', { 59 | desc = string.format('Attach LSP: %s', client.name), 60 | pattern = filetypes, 61 | callback = buf_attach 62 | }) 63 | 64 | if vim.v.vim_did_enter == 1 and 65 | vim.tbl_contains(filetypes, vim.bo.filetype) 66 | then 67 | buf_attach() 68 | end 69 | end 70 | 71 | config.on_exit = vim.schedule_wrap(function(code, signal, client_id) 72 | vim.api.nvim_del_autocmd(autocmd) 73 | end) 74 | 75 | vim.lsp.start_client(config) 76 | end 77 | 78 | 79 | -- 80 | -- When an LSP attachment happens then ensure we bind 81 | -- a key for hover-information 82 | -- 83 | vim.api.nvim_create_autocmd('LspAttach', { 84 | desc = 'LSP actions', 85 | callback = function() 86 | local bufmap = function(mode, lhs, rhs) 87 | local opts = {buffer = true} 88 | vim.keymap.set(mode, lhs, rhs, opts) 89 | end 90 | 91 | -- Displays hover information about the symbol 92 | -- under the cursor when you press "K". 93 | bufmap('n', 'K', 'lua vim.lsp.buf.hover()') 94 | 95 | end }) 96 | 97 | 98 | -- 99 | -- Invoke our helper function to start the server. 100 | -- 101 | -- NOTE: This runs every time you launch neovim, even if you're not opening 102 | -- a yal/lisp file. 103 | -- 104 | launch_yal_server() 105 | -------------------------------------------------------------------------------- /stdlib/stdlib/lists.lisp: -------------------------------------------------------------------------------- 1 | ;;; lists.lisp - Some list-utility functions 2 | 3 | ;; Some of these functions were adapted from Rob Pike's lisp 4 | ;; 5 | ;; https://github.com/robpike/lisp 6 | ;; 7 | ;; which in turn were derived from code in "LISP 1.5 Programmer's Manual" 8 | ;; by McCarthy, Abrahams, Edwards, Hart, and Levin, from MIT in 1962. 9 | ;; 10 | 11 | 12 | 13 | (set! find (fn* (item lst) 14 | "Return the offsets of any occurrence of the item in the given list, nil on failure. 15 | 16 | See-also: intersection, member, occurrences, union." 17 | (let* (len (length lst) 18 | res (list )) 19 | (repeat len (lambda (n) 20 | (if (eq (nth lst (- n 1)) item) 21 | (set! res (cons (- n 1) res) true)))) 22 | (if (= 0 (length res)) nil res )))) 23 | 24 | 25 | (set! member? (fn* (item lst:list) 26 | "Return true if the item is a member of the list" 27 | (if (find item lst) 28 | true 29 | false))) 30 | 31 | (set! flatten (fn* (L) 32 | "Converts a list of nested lists to a single list, flattening it." 33 | (if (nil? L) 34 | nil 35 | (if (! (list? (first L))) 36 | (cons (first L) (flatten (rest L))) 37 | (append (flatten (first L)) (flatten (rest L))))))) 38 | 39 | 40 | (set! intersection (fn* (x y) 41 | "Return the values common to the two specified lists. 42 | 43 | See-also: find, member, occurrences, union." 44 | (cond 45 | (nil? x) nil 46 | (member (car x) y) (cons (car x) (intersection (cdr x) y)) 47 | true (intersection (cdr x) y)))) 48 | 49 | (set! member (fn* (item lst) 50 | "Return true if the specified item is found within the given list. 51 | 52 | See-also: find, intersection, occurrences, union." 53 | 54 | (cond 55 | (nil? lst) false 56 | (eq item (car lst)) true 57 | true (member item (cdr lst))))) 58 | 59 | 60 | ;; 61 | ;; NOTE: This could be implemented as follows: 62 | ;; 63 | ;; (set! occurrences (fn* (item lst) (length (find item lst)))) 64 | ;; 65 | (set! occurrences (fn* (item lst) 66 | "Count the number of times the given item is found in the specified list. 67 | 68 | See-also: find, intersection, member, union" 69 | (if lst 70 | (+ 71 | (if (eq item (car lst)) 1 0) 72 | (occurrences item (cdr lst))) 73 | 0))) 74 | 75 | (set! union (fn* (x y) 76 | "Return the union of the two specified lists. 77 | 78 | See-also: find, intersection, member, occurrences." 79 | (cond 80 | (nil? x) y 81 | (member (car x) y) (union (cdr x) y) 82 | true (cons (car x) (union (cdr x) y)) 83 | ))) 84 | 85 | 86 | (set! replace (fn* (lst:list before after) 87 | "Given a list replace any item matching before with after." 88 | (if (nil? lst) 89 | () 90 | (if (eq (car lst) before) 91 | (cons after (replace (cdr lst) before after)) 92 | (cons (car lst) (replace (cdr lst) before after)))))) 93 | -------------------------------------------------------------------------------- /LSP.md: -------------------------------------------------------------------------------- 1 | 2 | * [Language Server Provider](#language-server-provider) 3 | * [Our LSP Features](#our-lsp-features) 4 | * [Configuration](#configuration) 5 | * [Emacs](#configuration-emacs) 6 | * [NeoVim](#configuration-neovim) 7 | * [Screenshots](#screenshots) 8 | * [Notes](#notes) 9 | * [See Also](#see-also) 10 | 11 | 12 | # Language Server Provider 13 | 14 | Adding features like auto complete, go to definition, or documentation 15 | on hover for a programming language takes significant effort. Traditionally 16 | this work had to be repeated for each development tool, as each tool 17 | provides different APIs for implementing the same feature. 18 | 19 | A Language Server is meant to provide the language-specific smarts and 20 | communicate with development tools over a protocol that enables 21 | inter-process communication. 22 | 23 | The idea behind the Language Server Protocol (LSP) is to standardize 24 | the protocol for how such servers and development tools communicate. 25 | This way, a single Language Server can be re-used in multiple 26 | development tools, which in turn can support multiple languages with 27 | minimal effort. 28 | 29 | 30 | ## Our LSP Features 31 | 32 | We only support the bare minimum LSP features: 33 | 34 | * Provide completion for the names of all standard-library functions. 35 | * Shows information on standard-library functions, on hover. 36 | 37 | 38 | 39 | 40 | # Configuration 41 | 42 | To use our LSP implementation you'll need to configure your editor, IDE, or environment appropriately. Configuration will vary depending on what you're using. 43 | 44 | Typically configuration will involve at least: 45 | 46 | * Specifying the type of files that hould use LSP (i.e. a filename suffixes). 47 | * Specifying the name/arguments to use for the LSP server. 48 | 49 | For our implementation you'll need to launch "`yal -lsp`" to startup the LSP-process. 50 | 51 | 52 | ## Configuration: Emacs 53 | 54 | For GNU Emacs the following file should provide all the help you need: 55 | 56 | * [_misc/yal.el](_misc/yal.el) 57 | 58 | 59 | ## Configuration: neovim 60 | 61 | Create the file `~/.config/nvim/init.lua` with contents as below: 62 | 63 | * [_misc/init.lua](_misc/init.lua) 64 | 65 | 66 | 67 | # Screenshots 68 | 69 | Here we see what completion might look like: 70 | 71 | ![Completion](_misc/complete.png?raw=true "Completion") 72 | 73 | Here's our help-text being displayed on-hover: 74 | 75 | ![Help](_misc/help.png?raw=true "Help") 76 | 77 | Here's the same again, using neovim: 78 | 79 | ![Neovim Completion](_misc/neovim-complete.png?raw=true "Completion") 80 | 81 | ![Neovim Help](_misc/neovim-help.png?raw=true "Help") 82 | 83 | 84 | 85 | 86 | # Notes 87 | 88 | As stated above we only support hover-text, and completion, from the 89 | standard library. Supporting the users' own code is harder because that 90 | would involve evaluating it - and that might cause side-effects. 91 | 92 | It should be noted that our completion-support is very naive - it literally 93 | returns the names of __all__ available methods, and relies upon the editor 94 | to narrow down the selection - that seems to work though. 95 | 96 | 97 | 98 | # See Also 99 | 100 | * [README.md](README.md) 101 | * More details of the project. 102 | * [PRIMITIVES.md](PRIMITIVES.md) 103 | * The list of built-in functions, whether implemented in Golang or YAL. 104 | * [INTRODUCTION.md](INTRODUCTION.md) 105 | * Getting started setting variables, defining functions, etc. 106 | -------------------------------------------------------------------------------- /env/env.go: -------------------------------------------------------------------------------- 1 | // Package env contains the key=value store, which is used to implement 2 | // the environment. 3 | // 4 | // We need to avoid circular references, so this package will store "any" 5 | // values rather than "Primitive" values which is actually what we interact 6 | // with. 7 | // 8 | // Typically you'd create an Environment with New, but to allow scopes, 9 | // or call-frames, you can create a nested environment via NewEnvironment. 10 | package env 11 | 12 | import ( 13 | "github.com/skx/yal/config" 14 | ) 15 | 16 | // Environment holds our state 17 | type Environment struct { 18 | 19 | // parent contains the parent scope, if any. 20 | parent *Environment 21 | 22 | // values holds the actual values 23 | values map[string]any 24 | 25 | // ioconfig holds the interface to the outside world, 26 | // which is used for I/O 27 | ioconfig *config.Config 28 | } 29 | 30 | // Get retrieves a value from the environment. 31 | // 32 | // If the value isn't found in the current scope, and a parent is present, 33 | // then that parent will be used. 34 | func (env *Environment) Get(key string) (any, bool) { 35 | if v, ok := env.values[key]; ok { 36 | return v, ok 37 | } 38 | if env.parent == nil { 39 | return nil, false 40 | } 41 | return env.parent.Get(key) 42 | } 43 | 44 | // Items returns all the items contained within our environment. 45 | func (env *Environment) Items() map[string]any { 46 | 47 | // The return value 48 | x := make(map[string]any) 49 | 50 | // If we have a parent scope then set the values from that. 51 | if env.parent != nil { 52 | for pk, pv := range env.parent.Items() { 53 | x[pk] = pv 54 | } 55 | } 56 | 57 | // Add the items in our scope after those of the parent, 58 | // in case we have a shadowed/more-specific value. 59 | for k, v := range env.values { 60 | x[k] = v 61 | } 62 | 63 | // all done 64 | return x 65 | } 66 | 67 | // New creates a new environment, with no parent. 68 | func New() *Environment { 69 | return &Environment{ 70 | values: make(map[string]any), 71 | ioconfig: config.New(), 72 | } 73 | } 74 | 75 | // NewEnvironment creates a new environment, which will use the specified 76 | // parent environment for values in a higher level. 77 | func NewEnvironment(parent *Environment) *Environment { 78 | return &Environment{ 79 | parent: parent, 80 | values: make(map[string]any), 81 | ioconfig: parent.ioconfig, 82 | } 83 | } 84 | 85 | // Set updates the contents of the current environment. 86 | func (env *Environment) Set(key string, value any) { 87 | env.values[key] = value 88 | } 89 | 90 | // SetInDefinition sets the variable where it is defined, and returns true. 91 | // If the value is not defined anywhere then we return false. 92 | func (env *Environment) SetInDefinition(key string, value any) bool { 93 | 94 | // Is it set in this scope? 95 | if _, ok := env.values[key]; ok { 96 | 97 | // Then update and return success 98 | env.values[key] = value 99 | return true 100 | } 101 | if env.parent != nil { 102 | if env.parent.SetInDefinition(key, value) { 103 | return true 104 | } 105 | } 106 | return false 107 | } 108 | 109 | // SetIOConfig updates the configuration object which is stored 110 | // in our environment 111 | func (env *Environment) SetIOConfig(cfg *config.Config) { 112 | env.ioconfig = cfg 113 | } 114 | 115 | // GetIOConfig returns the configuration object which is stored in 116 | // our environment. 117 | func (env *Environment) GetIOConfig() *config.Config { 118 | return env.ioconfig 119 | } 120 | -------------------------------------------------------------------------------- /examples/fuzz.lisp: -------------------------------------------------------------------------------- 1 | ;;; fuzz.lisp - Generate random expressions and evaluate them, forever. 2 | 3 | 4 | ;; 5 | ;; Cache of functions that the fuzzer can evaluate. 6 | ;; 7 | (set! functions nil) 8 | 9 | ;; 10 | ;; Retrieve the values of functions that can be executed, using the 11 | ;; cache, or calculating as appropriate. 12 | ;; 13 | (set! get_fns (fn* () 14 | "Get the functions we can fuzz-eval with a cache." 15 | (if (nil? functions) 16 | (do 17 | (set! functions (fns) true) 18 | functions 19 | ) 20 | functions))) 21 | 22 | ;; 23 | ;; Actually look over our builtins, stdlib, and specials, to return the list 24 | ;; of functions that are safe for execution, 25 | ;; 26 | ;; Specifically we want to rule out functions that never terminate. 27 | ;; 28 | (set! fns (fn* () 29 | "Return specials/builtins/stdlib functions that are safe for evaluation. 30 | 31 | We remove exit to avoid termination, forever to avoid infinite loops, and while for the same reason." 32 | (flatten (map (append (append (specials) (builtins)) (stdlib)) 33 | (lambda (x) 34 | (cond 35 | (eq (str x) "exit") nil 36 | (eq (str x) "while") nil 37 | (eq (str x) "forever") nil 38 | true x)))))) 39 | 40 | 41 | ;; 42 | ;; Generate a random argument. 43 | ;; 44 | (set! arg (fn* () 45 | "Generate a random argument; a number, a list, a string, etc." 46 | (let* (c (random:item '(1 2 3 4))) 47 | (cond 48 | (= 1 c) (random:item '("foo" 0 nil true false 1 2 3 4 5 6 7 8 9 10 '( 1 2 3 ))) 49 | (= 2 c) (random:item '(0 1 2 3 4 5 6 7 8 9)) 50 | (= 3 c) nil 51 | (= 4 c) (flatten (args)))))) 52 | 53 | ;; 54 | ;; Generate a random list of arguments, of random length. 55 | ;; 56 | (set! args (fn* () 57 | "Generate a random number of arguments, and return as a list" 58 | (let* (c (random:item '(0 1 2 3 4 5 6 7 8 9 10)) 59 | r (list)) 60 | (repeat c (lambda (n) 61 | (set! r (list r (random:item '("foo" 0 nil true false 1 2 3 4 '( 1 2 3 )))) true) 62 | )) 63 | (list 'list r)))) 64 | 65 | 66 | 67 | ;; 68 | ;; Real core - generate a random function, with up to three arguments. 69 | ;; 70 | ;; Output it, and execute it. 71 | ;; 72 | (set! gen (fn* () 73 | "Generate a random sexp, with 1-3 arguments. 74 | Show the expression and evaluate it." 75 | (let* ( 76 | name (random:item (get_fns)) 77 | param1 (arg) 78 | param2 (arg) 79 | param3 (arg) 80 | ) 81 | (let* (c (random:item '(1 2 3))) 82 | (cond 83 | (= 1 c) 84 | (do 85 | (print (list name param1)) 86 | (eval (list name param1))) 87 | (= 2 c) 88 | (do 89 | (print (list name param1 param2)) 90 | (eval (list name param1 param2))) 91 | (= 3 c) 92 | (do 93 | (print (list name param1 param2 param3)) 94 | (eval (list name param1 param2 param3)))))))) 95 | 96 | 97 | 98 | ;; 99 | ;; Invoke a single fuzz iteration, catching any/all errors which are produced. 100 | ;; 101 | (set! invoke (fn* () 102 | "Invoke a generated function once, catching any errors." 103 | (try 104 | (gen) 105 | (catch e 106 | (print "\t%s" e))))) 107 | 108 | 109 | ;; 110 | ;; Now we fuzz, forever .. 111 | ;; 112 | (forever (invoke)) 113 | -------------------------------------------------------------------------------- /go.sum: -------------------------------------------------------------------------------- 1 | github.com/aymanbagabas/go-osc52/v2 v2.0.1 h1:HwpRHbFMcZLEVr42D4p7XBqjyuxQH5SMiErDT4WkJ2k= 2 | github.com/aymanbagabas/go-osc52/v2 v2.0.1/go.mod h1:uYgXzlJ7ZpABp8OJ+exZzJJhRNQ2ASbcXHWsFqH8hp8= 3 | github.com/chzyer/logex v1.2.1 h1:XHDu3E6q+gdHgsdTPH6ImJMIp436vR6MPtH8gP05QzM= 4 | github.com/chzyer/logex v1.2.1/go.mod h1:JLbx6lG2kDbNRFnfkgvh4eRJRPX1QCoOIWomwysCBrQ= 5 | github.com/chzyer/readline v1.5.1 h1:upd/6fQk4src78LMRzh5vItIt361/o4uq553V8B5sGI= 6 | github.com/chzyer/readline v1.5.1/go.mod h1:Eh+b79XXUwfKfcPLepksvw2tcLE/Ct21YObkaSkeBlk= 7 | github.com/chzyer/test v1.0.0 h1:p3BQDXSxOhOG0P9z6/hGnII4LGiEPOYBhs8asl/fC04= 8 | github.com/chzyer/test v1.0.0/go.mod h1:2JlltgoNkt4TW/z9V/IzDdFaMTM2JPIi26O1pF38GC8= 9 | github.com/google/go-cmp v0.4.0/go.mod h1:v8dTdLbMG2kIc/vJvl+f65V22dbkXbowE6jgT/gNBxE= 10 | github.com/google/go-cmp v0.6.0 h1:ofyhxvXcZhMsU5ulbFiLKl/XBFqE1GSq7atu8tAmTRI= 11 | github.com/google/go-cmp v0.6.0/go.mod h1:17dUlkBOakJ0+DkrSSNjCkIjxS6bF9zb3elmeNGIjoY= 12 | github.com/gorilla/websocket v1.4.1/go.mod h1:YR8l580nyteQvAITg2hZ9XVh4b55+EU/adAjf1fMHhE= 13 | github.com/gorilla/websocket v1.5.3 h1:saDtZ6Pbx/0u+bgYQ3q96pZgCzfhKXGPqt7kZ72aNNg= 14 | github.com/gorilla/websocket v1.5.3/go.mod h1:YR8l580nyteQvAITg2hZ9XVh4b55+EU/adAjf1fMHhE= 15 | github.com/iancoleman/strcase v0.3.0 h1:nTXanmYxhfFAMjZL34Ov6gkzEsSJZ5DbhxWjvSASxEI= 16 | github.com/iancoleman/strcase v0.3.0/go.mod h1:iwCmte+B7n89clKwxIoIXy/HfoL7AsD47ZCWhYzw7ho= 17 | github.com/lucasb-eyer/go-colorful v1.2.0 h1:1nnpGOrhyZZuNyfu1QjKiUICQ74+3FNCN69Aj6K7nkY= 18 | github.com/lucasb-eyer/go-colorful v1.2.0/go.mod h1:R4dSotOR9KMtayYi1e77YzuveK+i7ruzyGqttikkLy0= 19 | github.com/mattn/go-isatty v0.0.20 h1:xfD0iDuEKnDkl03q4limB+vH+GxLEtL/jb4xVJSWWEY= 20 | github.com/mattn/go-isatty v0.0.20/go.mod h1:W+V8PltTTMOvKvAeJH7IuucS94S2C6jfK/D7dTCTo3Y= 21 | github.com/muesli/termenv v0.16.0 h1:S5AlUN9dENB57rsbnkPyfdGuWIlkmzJjbFf0Tf5FWUc= 22 | github.com/muesli/termenv v0.16.0/go.mod h1:ZRfOIKPFDYQoDFF4Olj7/QJbW60Ol/kL1pU3VfY/Cnk= 23 | github.com/petermattis/goid v0.0.0-20240813172612-4fcff4a6cae7/go.mod h1:pxMtw7cyUw6B2bRH0ZBANSPg+AoSud1I1iyJHI69jH4= 24 | github.com/petermattis/goid v0.0.0-20250211185408-f2b9d978cd7a h1:ckxP/kGzsxvxXo8jO6E/0QJ8MMmwI7IRj4Fys9QbAZA= 25 | github.com/petermattis/goid v0.0.0-20250211185408-f2b9d978cd7a/go.mod h1:pxMtw7cyUw6B2bRH0ZBANSPg+AoSud1I1iyJHI69jH4= 26 | github.com/pkg/errors v0.9.1 h1:FEBLx1zS214owpjy7qsBeixbURkuhQAwrK5UwLGTwt4= 27 | github.com/pkg/errors v0.9.1/go.mod h1:bwawxfHBFNV+L2hUp1rHADufV3IMtnDRdf1r5NINEl0= 28 | github.com/rivo/uniseg v0.4.7 h1:WUdvkW8uEhrYfLC4ZzdpI2ztxP1I582+49Oc5Mq64VQ= 29 | github.com/rivo/uniseg v0.4.7/go.mod h1:FN3SvrM+Zdj16jyLfmOkMNblXMcoc8DfTHruCPUcx88= 30 | github.com/sasha-s/go-deadlock v0.3.5 h1:tNCOEEDG6tBqrNDOX35j/7hL5FcFViG6awUGROb2NsU= 31 | github.com/sasha-s/go-deadlock v0.3.5/go.mod h1:bugP6EGbdGYObIlx7pUZtWqlvo8k9H6vCBBsiChJQ5U= 32 | github.com/segmentio/ksuid v1.0.4 h1:sBo2BdShXjmcugAMwjugoGUdUV0pcxY5mW4xKRn3v4c= 33 | github.com/segmentio/ksuid v1.0.4/go.mod h1:/XUiZBD3kVx5SmUOl55voK5yeAbBNNIed+2O73XgrPE= 34 | github.com/sourcegraph/jsonrpc2 v0.2.0 h1:KjN/dC4fP6aN9030MZCJs9WQbTOjWHhrtKVpzzSrr/U= 35 | github.com/sourcegraph/jsonrpc2 v0.2.0/go.mod h1:ZafdZgk/axhT1cvZAPOhw+95nz2I/Ra5qMlU4gTRwIo= 36 | github.com/tliron/commonlog v0.2.19 h1:v1mOH1TyzFLqkshR03khw7ENAZPjAyZTQBQrqN+vX9c= 37 | github.com/tliron/commonlog v0.2.19/go.mod h1:AcdhfcUqlAWukDrzTGyaPhUgYiNdZhS4dKzD/e0tjcY= 38 | github.com/tliron/glsp v0.2.2 h1:IKPfwpE8Lu8yB6Dayta+IyRMAbTVunudeauEgjXBt+c= 39 | github.com/tliron/glsp v0.2.2/go.mod h1:GMVWDNeODxHzmDPvYbYTCs7yHVaEATfYtXiYJ9w1nBg= 40 | github.com/tliron/kutil v0.3.26 h1:G+dicQLvzm3zdOMrrQFLBfHJXtk57fEu2kf1IFNyJxw= 41 | github.com/tliron/kutil v0.3.26/go.mod h1:1/HRVAb+fnRIRnzmhu0FPP+ZJKobrpwHStDVMuaXDzY= 42 | go.lsp.dev/uri v0.3.0 h1:KcZJmh6nFIBeJzTugn5JTU6OOyG0lDOo3R9KwTxTYbo= 43 | go.lsp.dev/uri v0.3.0/go.mod h1:P5sbO1IQR+qySTWOCnhnK7phBx+W3zbLqSMDJNTw88I= 44 | golang.org/x/crypto v0.34.0 h1:+/C6tk6rf/+t5DhUketUbD1aNGqiSX3j15Z6xuIDlBA= 45 | golang.org/x/crypto v0.34.0/go.mod h1:dy7dXNW32cAb/6/PRuTNsix8T+vJAqvuIy5Bli/x0YQ= 46 | golang.org/x/sys v0.0.0-20220310020820-b874c991c1a5/go.mod h1:oPkhp1MJrh7nUepCBck5+mAzfO9JrbApNNgaTdGDITg= 47 | golang.org/x/sys v0.6.0/go.mod h1:oPkhp1MJrh7nUepCBck5+mAzfO9JrbApNNgaTdGDITg= 48 | golang.org/x/sys v0.30.0 h1:QjkSwP/36a20jFYWkSue1YwXzLmsV5Gfq7Eiy72C1uc= 49 | golang.org/x/sys v0.30.0/go.mod h1:/VUhepiaJMQUp4+oa/7Zr1D23ma6VTLIYjOOTFZPUcA= 50 | golang.org/x/term v0.29.0 h1:L6pJp37ocefwRRtYPKSWOWzOtWSxVajvz2ldH/xi3iU= 51 | golang.org/x/term v0.29.0/go.mod h1:6bl4lRlvVuDgSf3179VpIxBF0o10JUpXWOnI7nErv7s= 52 | golang.org/x/xerrors v0.0.0-20191204190536-9bdfabe68543/go.mod h1:I/5z698sn9Ka8TeJc9MKroUUfqBBauWjQqLJ2OPfmY0= 53 | -------------------------------------------------------------------------------- /examples/sorting.lisp: -------------------------------------------------------------------------------- 1 | ;;; sorting.lisp - Demonstrate generating random lists, and sorting them. 2 | 3 | ;; 4 | ;; This example demonstrates creating lists of random (integer) 5 | ;; numbers, and then sorting them. 6 | ;; 7 | ;; We have three sorting methods to test: 8 | ;; 9 | ;; 1. insert-sort, implemented in lisp. 10 | ;; 11 | ;; 2. quick-sort, implemented in lisp. 12 | ;; 13 | ;; 3. sort, implemented in golang 14 | ;; 15 | ;; 16 | ;; See-also the "sorting.lisp" file in our standard-library, which is 17 | ;; an unfolded version of this quicksort - with the use of a user-defined 18 | ;; comparison function. 19 | ;; 20 | 21 | (set! random:list (fn* (n max) 22 | "Return a list of random numbers, of the length n, ranging from -max to +max." 23 | (map (nat n) (lambda (n) 24 | (let* (sign 1) 25 | ; optionally this might be negative 26 | (if (= 0 (random 2)) 27 | (set! sign -1)) 28 | (* sign (random max))))))) 29 | 30 | 31 | 32 | ;; 33 | ;; insertion-sort 34 | ;; 35 | 36 | (set! insert (fn* (item lst) 37 | "Insert the specified item into the given list, in the correct (sorted) order." 38 | (if (nil? lst) 39 | (cons item lst) 40 | (if (> item (car lst)) 41 | (cons (car lst) (insert item (cdr lst))) 42 | (cons item lst))))) 43 | 44 | (set! insertsort (fn* (lst) 45 | "An insert-sort implementation. For each item in the given list, use insert to place it into the list in the correct order." 46 | (if (nil? lst) 47 | nil 48 | (insert (car lst) (insertsort (cdr lst)))))) 49 | 50 | 51 | 52 | ;; 53 | ;; quick-sort 54 | ;; 55 | 56 | (set! append3 (fn* (a b c) 57 | "Like append, but with three items, not two." 58 | (append a (append b c)))) 59 | 60 | (set! list>= (fn* (m list) 61 | "Return all items of the given list which are greater than, or equal to, the specified item." 62 | (filter list (lambda (n) (! (< n m)))))) 63 | 64 | 65 | (set! list< (fn* (m list) 66 | "Return all items of the given list which are less than the specified item." 67 | (filter list (lambda (n) (< n m))))) 68 | 69 | (set! qsort (fn* (l) 70 | "A recursive quick-sort implementation." 71 | (if (nil? l) 72 | nil 73 | (append3 (qsort (list< (car l) (cdr l))) 74 | (cons (car l) null) 75 | (qsort (list>= (car l) (cdr l))))))) 76 | 77 | 78 | 79 | 80 | ;; 81 | ;; Now we have defined functions to generate a list of random integers, 82 | ;; and we also have our two sorting methods, so we can test things :) 83 | ;; 84 | ;; Spoiler qsort is the faster lisp sort, but the native golang sort 85 | ;; is significantly faster - due to lack of recursion & etc. 86 | ;; 87 | (let* ( 88 | count 512 ; how many items to work with 89 | lst (random:list count 4096) ; create a random list of integers 90 | ; between -4096 and +4096. 91 | 92 | bis (ms) ; before-insert-sort take a timestamp 93 | isrt (insertsort lst) ; run insert-sort 94 | ais (ms) ; after insert-sort take a timestamp 95 | 96 | bqs (ms) ; before-quick-sort take a timestamp 97 | qsrt (qsort lst) ; run the quick-sort 98 | aqs (ms) ; after-quick-sort take a timestamp 99 | 100 | bgs (ms) ; before-go-sort take a timestamp 101 | gsrt (sort lst) ; run the go sort 102 | ags (ms) ; after-go-sort take a timestamp 103 | ) 104 | (print "insert sort took %d ms " (- ais bis)) 105 | (print "quick sort took %d ms " (- aqs bqs)) 106 | (print "go sort took %d ms " (- ags bgs)) 107 | 108 | ; a simple sanity-check of the results 109 | (print "Testing results, to ensure each sort produced identical results.") 110 | (print "offset,insert-sort,quick-sort,go-sort") 111 | (apply (seq count) 112 | (lambda (x) 113 | (let* (a (nth isrt x) 114 | b (nth qsrt x) 115 | c (nth gsrt x)) 116 | 117 | (if (! (eq a b)) 118 | (print "List element %d differs!" x)) 119 | (if (! (eq b c)) 120 | (print "List element %d differs!" x)) 121 | (print "offset %d had identical values: %d,%d,%d" x a b c)))) 122 | (print "All done!") 123 | ) 124 | -------------------------------------------------------------------------------- /_misc/tapview: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | # tapview - a TAP (Test Anything Protocol) viewer in pure POSIX shell 3 | # 4 | # Copyright by Eric S. Raymond 5 | # 6 | # This code is intended to be embedded in your project. The author 7 | # grants permission for it to be distributed under the prevailing 8 | # license of your project if you choose, provided that license is 9 | # OSD-compliant; otherwise the following SPDX tag incorporates a 10 | # license by reference. 11 | # 12 | # SPDX-License-Identifier: BSD-2-Clause 13 | # 14 | # This is version 1.3 15 | # A newer version may be available at https://gitlab.com/esr/tapview 16 | # 17 | # POSIX allows but does not mandate that -n suppresses emission of a 18 | # trailing newline in echo. Thus, some shell builtin echos don't do 19 | # that. Cope gracefully. 20 | # shellcheck disable=SC2039 21 | if [ "$(echo -n "a"; echo "b")" = "ab" ] 22 | then 23 | ECHO="echo" 24 | elif [ "$(/bin/echo -n "a"; /bin/echo "b")" = "ab" ] 25 | then 26 | ECHO="/bin/echo" 27 | else 28 | echo "tapview: bailing out, your echo lacks -n support." 29 | exit 3 30 | fi 31 | 32 | OK="." 33 | FAIL="F" 34 | SKIP="s" 35 | TODO_NOT_OK="x" 36 | TODO_OK="u" 37 | 38 | ship_char() { 39 | # shellcheck disable=SC2039 40 | "${ECHO}" -n "$1" 41 | } 42 | 43 | ship_line() { 44 | report="${report}${1}\n" 45 | } 46 | 47 | testcount=0 48 | failcount=0 49 | skipcount=0 50 | todocount=0 51 | test_before_plan=no 52 | test_after_plan=no 53 | expect="" 54 | status=0 55 | 56 | report="" 57 | IFS="" 58 | state=start 59 | while read -r line 60 | do 61 | if expr "$line" : "Bail out!" >/dev/null 62 | then 63 | ship_line "$line" 64 | status=2 65 | break 66 | fi 67 | # Process a plan line 68 | if expr "$line" : '1\.\.[0-9][0-9]*' >/dev/null 69 | then 70 | if [ "$expect" != "" ] 71 | then 72 | if [ "${testcount}" -gt 0 ] 73 | then 74 | echo "" 75 | fi 76 | ship_line "tapview: cannot have more than one plan line." 77 | echo "${report}" 78 | exit 1 79 | fi 80 | if expr "$line" : ".* *SKIP" >/dev/null || expr "$line" : ".* *skip" >/dev/null 81 | then 82 | ship_line "$line" 83 | echo "${report}" 84 | exit 1 # Not specified in the standard whether this should exit 1 or 0 85 | fi 86 | expect=$(expr "$line" : '1\.\.\([0-9][0-9]*\)') 87 | continue 88 | fi 89 | # Process an ok line 90 | if expr "$line" : "ok" >/dev/null 91 | then 92 | testcount=$((testcount + 1)) 93 | if [ "$expect" = "" ] 94 | then 95 | test_before_plan=yes 96 | else 97 | test_after_plan=yes 98 | fi 99 | if expr "$line" : ".*# *TODO" >/dev/null || expr "$line" : ".*# *todo" >/dev/null 100 | then 101 | ship_char ${TODO_OK} 102 | ship_line "$line" 103 | todocount=$((todocount + 1)) 104 | elif expr "$line" : ".*# *SKIP" >/dev/null || expr "$line" : ".*# *skip" >/dev/null 105 | then 106 | ship_char ${SKIP} 107 | ship_line "$line" 108 | skipcount=$((skipcount + 1)) 109 | else 110 | ship_char ${OK} 111 | fi 112 | state=ok 113 | continue 114 | fi 115 | # Process a not-ok line 116 | if expr "$line" : "not ok" >/dev/null 117 | then 118 | testcount=$((testcount + 1)) 119 | if [ "$expect" = "" ] 120 | then 121 | test_before_plan=yes 122 | else 123 | test_after_plan=yes 124 | fi 125 | if expr "$line" : ".*# *SKIP" >/dev/null || expr "$line" : ".*# *skip" >/dev/null 126 | then 127 | ship_char "${SKIP}" 128 | state=ok 129 | skipcount=$((skipcount + 1)) 130 | continue 131 | fi 132 | if expr "$line" : ".*# *TODO" >/dev/null || expr "$line" : ".*# *todo" >/dev/null 133 | then 134 | ship_char ${TODO_NOT_OK} 135 | state=ok 136 | todocount=$((todocount + 1)) 137 | continue 138 | fi 139 | ship_char "${FAIL}" 140 | ship_line "$line" 141 | state=not_ok 142 | failcount=$((failcount + 1)) 143 | status=1 144 | continue 145 | fi 146 | # shellcheck disable=SC2166 147 | if [ "${state}" = "yaml" ] 148 | then 149 | ship_line "$line" 150 | if expr "$line" : '[ ]*\.\.\.' >/dev/null 151 | then 152 | state=ok 153 | fi 154 | elif expr "$line" : "[ ]*---" >/dev/null 155 | then 156 | ship_line "$line" 157 | state=yaml 158 | fi 159 | done 160 | 161 | /bin/echo "" 162 | 163 | if [ -z "$expect" ] 164 | then 165 | ship_line "Missing a plan." 166 | status=1 167 | elif [ "$test_before_plan" = "yes" ] && [ "$test_after_plan" = "yes" ] 168 | then 169 | ship_line "A plan line may only be placed before or after all tests." 170 | status=1 171 | elif [ "${expect}" -gt "${testcount}" ] 172 | then 173 | ship_line "Expected ${expect} tests but only ${testcount} ran." 174 | status=1 175 | elif [ "${expect}" -lt "${testcount}" ] 176 | then 177 | ship_line "Expected ${expect} tests but ${testcount} ran." 178 | status=1 179 | fi 180 | 181 | report="${report}${testcount} tests, ${failcount} failures" 182 | if [ "$todocount" != 0 ] 183 | then 184 | report="${report}, ${todocount} TODOs" 185 | fi 186 | if [ "$skipcount" != 0 ] 187 | then 188 | report="${report}, ${skipcount} SKIPs" 189 | fi 190 | 191 | echo "${report}." 192 | 193 | exit "${status}" 194 | 195 | # end 196 | -------------------------------------------------------------------------------- /INTRODUCTION.md: -------------------------------------------------------------------------------- 1 | * [Brief Yal Introduction](#brief-yal-introduction) 2 | * [See Also](#see-also) 3 | 4 | 5 | 6 | 7 | # Brief Yal Introduction 8 | 9 | Yal is a typical toy lisp with support for numbers, strings, characters, hashes and structures. 10 | 11 | 12 | 13 | ## Primitive Types 14 | 15 | Primitive types work as you would expect: 16 | 17 | * Numbers can be written as integers in decimal, binary, or hex: 18 | * `(print 3)` 19 | * `(print 0xff)` 20 | * `(print 0b1010)` 21 | * Floating point numbers are also supported: 22 | * `(print 3.4)` 23 | * Strings are just encoded literally, and escaped characters are honored: 24 | * `(print "Hello, world\n")` 25 | * Characters are written with a `#\` prefix: 26 | * `(print #\*)` 27 | * Lists are written using parenthesis to group them: 28 | * `(print (list 1 2 3))` 29 | 30 | 31 | 32 | ## Other Types 33 | 34 | We support hashes, which are key/value pairs, written between `{` and `}` pairs: 35 | 36 | ```lisp 37 | (print { name "Steve" age (- 2022 1976) } ) 38 | ``` 39 | 40 | Functions exist for getting/setting fields by name, and for iterating over the keys, values, or key/value pairs, contained in a given hash. 41 | 42 | We also support structures, which are syntactical sugar for hashes, along with the autogeneration of some simple helper methods. 43 | 44 | To define a "person" with three fields you'd write: 45 | 46 | ```lisp 47 | (struct person name age address) 48 | ``` 49 | 50 | Once this `struct` has been defined it can be populated via the constructor: 51 | 52 | ```lisp 53 | (person "Steve" "18" "123 Fake Street") 54 | ``` 55 | 56 | Values which are not supplied will default to `nil`: 57 | 58 | ```lisp 59 | (person "Steve" "18") 60 | ``` 61 | 62 | The structure's fields can be accessed, and updated via generated methods, named after the type of the object, and the field involved: 63 | 64 | ``` 65 | ; Set the variable "me" to be a new instance of the person-structure. 66 | (set! me (person "Steve" "18" "123 Fake Street")) 67 | 68 | ; Change the adddress 69 | (person.address me "999 Fake Lane") 70 | 71 | ; Confirm it worked 72 | (print (person.address me)) 73 | ``` 74 | 75 | 76 | 77 | ## IF 78 | 79 | `if` is a standard of lisp, and we support it. We also implement `cond` - as a macro - and other functions for looping, ranging, and calling functions against lists. 80 | 81 | The handling of `if` has been enhanced to allow **multiple** expressions to be executed in the "else" branch. A standard `if` would look like this: 82 | 83 | (if true 84 | (print "This is executed") 85 | (print "This is not")) 86 | 87 | We also allow: 88 | 89 | (if false 90 | (print "This is not executed") 91 | (print "This is executed") 92 | (print "This is executed too") 93 | (print "This is also executed") 94 | (print "This is executed as well ..") 95 | ) 96 | 97 | Here you see _multiple_ else-expressions are executed. Only one expression is executed if the test succeeds, but the alternates have no limit - the return value of the expression is the return value of the last executed expression. 98 | 99 | 100 | 101 | ## Variables 102 | 103 | To set the contents of a variable use `set!` which we saw above: 104 | 105 | (set! foo "bar") 106 | 107 | To start a new scope, with local variables, use `let*`: 108 | 109 | (let* (foo "bar" 110 | baz "bart") 111 | (print "foo is %s" foo) 112 | (print "baz is %s" baz) 113 | ;... 114 | ) 115 | 116 | 117 | 118 | ## Functions 119 | 120 | To define a function use `set!` with `fn*`: 121 | 122 | (set! fact (fn* (n) 123 | (if (<= n 1) 124 | 1 125 | (* n (fact (- n 1)))))) 126 | 127 | Optionally you may write some help/usage information in your definition: 128 | 129 | (def! gcd (fn* (m n) 130 | "Return the greatest common divisor between the two arguments." 131 | (if (= (% m n) 0) n (gcd n (% m n))))) 132 | 133 | Help information can be retrieved at runtime, for usage: 134 | 135 | (print (help print)) 136 | 137 | As shown in the examples above parameters are named, rather than specifying 138 | them as distinct symbols it is also possible to specify a default value by 139 | expressing the parameters as a list (of two items only): 140 | 141 | (set! greet (fn* ( (name "World") ) 142 | "Greet the supplied name, use the default if a name is not supplied." 143 | (print "Hello, %s" name))) 144 | 145 | That would operate like so: 146 | 147 | (greet "Steve") ; "Hello, Steve" 148 | (greet) ; "Hello, World" 149 | 150 | 151 | 152 | ## Macros 153 | To define a macro use `defmacro!`: 154 | 155 | (defmacro! debug (fn* (x) `(print "Variable '%s' has value %s" '~x ~x))) 156 | 157 | You might use this macro like so: 158 | 159 | (set! foo "steve") 160 | (debug foo) 161 | 162 | That concludes the brief overview, note that `lambda` can be used as a synonym for `fn*`, and other synonyms exist. In the interests of simplicity they're not covered here. 163 | 164 | 165 | 166 | ## See Also 167 | 168 | * [LSP.md](LSP.md) 169 | * LSP support. 170 | * [README.md](README.md) 171 | * More details of the project. 172 | * [PRIMITIVES.md](PRIMITIVES.md) 173 | * The list of built-in functions, whether implemented in Golang or YAL. 174 | -------------------------------------------------------------------------------- /stdlib/stdlib/stdlib.lisp: -------------------------------------------------------------------------------- 1 | ;;; stdlib.lisp - Standard library as implemented in lisp. 2 | 3 | 4 | ;; Convert a number to a binary string. 5 | (set! dec2bin (fn* (n:number) 6 | "Convert the given number to a binary string representation of that number. 7 | 8 | See also: dec2hex" 9 | (base n 2))) 10 | 11 | ;; Convert a number to a hexadecimal string. 12 | (set! dec2hex (fn* (n:number) 13 | "Convert the given number to a hexadecimal string representation. 14 | 15 | See also: dec2bin" 16 | (base n 16))) 17 | 18 | ;; Useful for creating a list of numbers 19 | (set! repeated (fn* (n:number x) 20 | "Return a list of length n whose elements are all x." 21 | (when (pos? n) 22 | (cons x (repeated (dec n) x))))) 23 | 24 | ;; Return the last element of a list 25 | ;; 26 | ;; NOTE: This could be written more simply, for example: 27 | ;; 28 | ;; (set! last (fn* (lst:list) "Return the last element of the given list" (car (reverse lst)))) 29 | ;; 30 | (set! last (fn* (lst:list) 31 | "Return the last item in the specified list, it is the inverse of (butlast) and the logical opposite of (car)." 32 | (let* (c (cdr lst)) 33 | (if (! (nil? c)) 34 | (last c) 35 | (car lst))))) 36 | 37 | ;; Setup a simple function to run a loop N times 38 | ;; 39 | (set! repeat (fn* (n body) 40 | "Execute the supplied body of code N times." 41 | (if (> n 0) 42 | (do 43 | (body n) 44 | (repeat (- n 1) body))))) 45 | 46 | ;; A helper to apply a function to each key/value pair of a hash 47 | (set! apply-hash (fn* (hs:hash fun:function) 48 | "Call the given function to every key in the specified hash. 49 | 50 | See-also: apply, apply-pairs" 51 | (let* (lst (keys hs)) 52 | (apply lst (lambda (x) (fun x (get hs x))))))) 53 | 54 | 55 | ;; Count the length of a string 56 | (set! strlen (fn* (str:string) 57 | "Calculate and return the length of the supplied string." 58 | (length (split str "")))) 59 | 60 | 61 | ;; Create ranges of numbers in a list 62 | (set! range (fn* (start:number end:number step:number) 63 | "Create a list of numbers between the start and end bounds, inclusive, incrementing by the given offset each time." 64 | (if (zero? step) 65 | (error "step must be non-zero") 66 | (if (<= start end) 67 | (cons start (range (+ start step) end step)) 68 | ())))) 69 | 70 | ;; Create sequences from 0/1 to N 71 | (set! seq (fn* (n:number) 72 | "Create, and return, list of number ranging from 0-N, inclusive." 73 | (range 0 n 1))) 74 | (set! nat (fn* (n:number) 75 | "Create, and return, a list of numbers ranging from 1-N, inclusive." 76 | (range 1 n 1))) 77 | 78 | 79 | ;; Remove items from a list where the predicate function is not T 80 | (set! filter (fn* (xs:list f:function) 81 | "Remove any items from the specified list, if the result of calling the provided function on that item is not true." 82 | (if (nil? xs) 83 | () 84 | (if (f (car xs)) 85 | (cons (car xs)(filter (cdr xs) f)) 86 | (filter (cdr xs) f))))) 87 | 88 | 89 | 90 | 91 | ;; reduce function 92 | (set! reduce (fn* (xs f acc) 93 | "This is our reduce function, which uses a list, a function, and the accumulator." 94 | (if (nil? xs) 95 | acc 96 | (reduce (cdr xs) f (f acc (car xs)))))) 97 | 98 | (set! append (fn* (lst item) 99 | "Append the given value to the specified list. If the list is empty just return the specified item." 100 | (if (nil? lst) 101 | item 102 | (cons (car lst) (append (cdr lst) item))))) 103 | 104 | 105 | (set! reverse (fn* (l) 106 | "Reverse the contents of the specified list." 107 | (if (nil? l) 108 | nil 109 | (append (reverse (cdr l)) (list (car l)))))) 110 | 111 | 112 | ;; Get the first N items from a list. 113 | (set! take (fn* (n l) 114 | "Return the first N items from the specified list." 115 | (cond (zero? n) nil 116 | (nil? l) nil 117 | true (cons (car l) (take (- n 1) (cdr l)))))) 118 | 119 | ;; Remove the first N items from a list. 120 | (set! drop (fn* (n l) 121 | "Remove the first N items from the specified list." 122 | (cond (zero? n) l 123 | (nil? l) nil 124 | true (drop (- n 1) (cdr l))))) 125 | 126 | ;; Return everything but the last element. 127 | (set! butlast (fn* (l) 128 | "Return everything but the last element from the specified list." 129 | 130 | (take (dec (length l)) l))) 131 | -------------------------------------------------------------------------------- /examples/mtest.lisp: -------------------------------------------------------------------------------- 1 | ;;; mtest.lisp - Simple tests of our macro system. 2 | 3 | ;; 4 | ;; Handy reference 5 | ;; 6 | ;; https://lisp-journey.gitlab.io/blog/common-lisp-macros-by-example-tutorial/ 7 | ;; 8 | ;; https://lispcookbook.github.io/cl-cookbook/macros.html 9 | ;; 10 | 11 | 12 | ;; Define a simple list for testing-purposes. 13 | (set! lst (quote (b c))) 14 | 15 | ;; 16 | ;; Here is our first macro, given a variable-name show both the 17 | ;; name and the current value. 18 | ;; 19 | (defmacro! debug (fn* (x) `(print "Variable '%s' has value %s" '~x ~x))) 20 | (debug lst) 21 | 22 | ;; 23 | ;; Here's a similar example, which asserts a condition is true. 24 | ;; 25 | ;; The working is similar to the above, we get given a condition and 26 | ;; we both evaluate it, and show it literally (in the case where things 27 | ;; failed). 28 | ;; 29 | (defmacro! assert (fn* (exp) 30 | `(if ~exp 31 | () 32 | (print "Assertion failed: %s" `~exp)))) 33 | 34 | 35 | 36 | ;; Suppose you want a version of setq that sets two variables to the 37 | ;; same value. So if you write: 38 | ;; 39 | ;; (set2! x y (+ z 3)) 40 | ;; 41 | ;; When z=8 then both x and y are set to 11. 42 | ;; 43 | ;; When you (the Lisp system) see: 44 | ;; 45 | ;; (set2! v1 v2 e) 46 | ;; 47 | ;; We want to treat it as: 48 | ;: 49 | ;; (do 50 | ;; (set! v1 e) 51 | ;; (set! v2 e) 52 | ;; ) 53 | ;: 54 | ;; Something like this should work: 55 | ;; 56 | ;; NOTE: This has a short-coming, that the "e" parameter is executed 57 | ;; or evaluated twice. 58 | ;; 59 | ;; We'll refine to fix this. 60 | ;; 61 | (defmacro! set2! (fn* (v1 v2 e) 62 | `(do 63 | (set! ~v1 ~e) 64 | (set! ~v2 ~e)))) 65 | 66 | 67 | ;; 68 | ;; You can see this in the following code: 69 | ;; 70 | ;; (set2! a c (do (print "EXECUTED TWICE!") (+ 32 23))) 71 | 72 | ;; 73 | ;; The second attempt would use a temporary variable to store the new 74 | ;; value, so that the evaluation of the argument only occurs once. 75 | ;; 76 | ;; This looks like it should work: 77 | ;; 78 | ;; NOTE: This does not work. 79 | ;; 80 | ;; The "(set!..)" calls operate in a new scope. So they can't modify 81 | ;; the global environment. 82 | ;; 83 | (defmacro! set2! (fn* (v1 v2 e) 84 | (let* (tmp (gensym)) 85 | `(do (let* (~tmp ~e) 86 | (set! ~v1 ~tmp) 87 | (set! ~v2 ~tmp)))))) 88 | 89 | 90 | ;; 91 | ;; The third/final attempt uses a temporary variable to store the new 92 | ;; value, so that the evaluation of the argument only occurs once. 93 | ;; 94 | ;; The difference here is we use the three-argument form of the (set!..) 95 | ;; form, to update the global/parent scope. 96 | ;; 97 | (defmacro! set2! (fn* (v1 v2 e) 98 | (let* (tmp (gensym)) 99 | `(do (let* (~tmp ~e) 100 | (set! ~v1 ~tmp true) 101 | (set! ~v2 ~tmp true)))))) 102 | 103 | ;; 104 | ;; Lets test it out. 105 | ;; 106 | ;; Define three variables A, B, & C 107 | ;; 108 | (set! a 1) 109 | (set! b 2) 110 | (set! c 3) 111 | 112 | ;; 113 | ;; Confirm they have expected values 114 | ;; 115 | (assert (= a 1)) 116 | (assert (= b 2)) 117 | (assert (= c 3)) 118 | 119 | ;; 120 | ;; Update A + B, leaving C alone. 121 | ;; 122 | (set2! a b 33) 123 | 124 | ;; 125 | ;; Confirm the values are changed, as expected. 126 | ;; 127 | (assert (= a 33)) 128 | (assert (= b 33)) 129 | (assert (= c 3)) 130 | 131 | 132 | ;; Confirm it works with an expression too. 133 | ;; 134 | ;; NOTE This expression is only evaluated once, which is what we wanted. 135 | ;; 136 | (set2! a c (do (print "ONLY EXECUTED ONCE!") (+ 32 23))) 137 | 138 | ;; 139 | ;; So the values will be changed, again. 140 | ;; 141 | (assert (= a 55)) 142 | (assert (= b 33)) 143 | (assert (= c 55)) 144 | 145 | 146 | ;; 147 | ;; That's a very simple macro. 148 | ;; 149 | ;; Lets add some more simple ones. 150 | ;; 151 | 152 | 153 | 154 | ;; 155 | ;; if2 is a simple macro which allows you to run two actions if an 156 | ;; (if ..) test succeeds. 157 | ;; 158 | ;; This means you can write: 159 | ;; 160 | ;; (if2 true (print "1") (print "2")) 161 | ;; 162 | ;; Instead of having to add (do: 163 | ;; 164 | ;; (if true (do (print "1") (print "2"))) 165 | ;; 166 | ;; The downside here is that you don't get a negative branch, but running 167 | ;; two things is very common - see for example the "(while)" and "(repeat)" 168 | ;; macros in our standard library. 169 | ;; 170 | ;; See also "(when) in the standard-library, which allows a list of operations 171 | ;; when a condition is true rather than two, and only two. 172 | ;; 173 | (defmacro! if2 (fn* (pred one two) 174 | `(if ~pred (do ~one ~two)))) 175 | 176 | 177 | ;; 178 | ;; Increment the given variable by one. 179 | ;; 180 | (defmacro! incr (fn* (x) `(set! ~x (+ ~x 1)))) 181 | 182 | ;; 183 | ;; Show macro expansion 184 | ;; 185 | (print "The (incr a) macro expands to %s" (macroexpand (incr a))) 186 | 187 | ;; 188 | ;; Use the if2 macro to run two increment options 189 | ;; 190 | (set! a 32) 191 | (if2 true (incr a) (incr a)) 192 | (assert (= a 34)) 193 | 194 | 195 | ;; 196 | ;; Finally we'll ensure that our type-checking understands what a macro is, 197 | ;; and that it is different from a (user) function or a builtin function. 198 | ;; 199 | 200 | 201 | ;; Type of a macro is "macro" 202 | (defmacro! truthy (fn* () true)) 203 | (print "The type of a macro is (type truthy):%s" (type truthy)) 204 | 205 | ;; The macro? predicate will recognize one too. 206 | (if (macro? truthy) 207 | (print "(macro? truthy) -> true")) 208 | -------------------------------------------------------------------------------- /lsp.go: -------------------------------------------------------------------------------- 1 | // This file provides our LSP support. 2 | // 3 | // When yal is invoked with the "-lsp" flag we call lspStart(), 4 | // which provides simple completion and hover support. 5 | // 6 | 7 | package main 8 | 9 | import ( 10 | "fmt" 11 | "os" 12 | "sort" 13 | "strings" 14 | 15 | "github.com/skx/yal/primitive" 16 | "github.com/tliron/glsp" 17 | 18 | protocol "github.com/tliron/glsp/protocol_3_16" 19 | "github.com/tliron/glsp/server" 20 | "go.lsp.dev/uri" 21 | 22 | // Must include a backend implementation 23 | // See CommonLog for other options: https://github.com/tliron/commonlog 24 | "github.com/tliron/commonlog" 25 | _ "github.com/tliron/commonlog/simple" 26 | ) 27 | 28 | // lsName contains the name of our LSP handler 29 | const lsName = "yal" 30 | 31 | // handler contains the pointer to our handler 32 | var handler protocol.Handler 33 | 34 | // completions are the completion things we can support. 35 | // 36 | // Since we only support completion of the functions within our 37 | // standard-library they will not change, and we can calculate 38 | // the complete list once and reuse it. 39 | var completions []protocol.CompletionItem 40 | 41 | // initialize is called to setup a new buffer. 42 | func initialize(context *glsp.Context, params *protocol.InitializeParams) (any, error) { 43 | capabilities := handler.CreateServerCapabilities() 44 | 45 | return protocol.InitializeResult{ 46 | Capabilities: capabilities, 47 | ServerInfo: &protocol.InitializeResultServerInfo{ 48 | Name: lsName, 49 | Version: &version, 50 | }, 51 | }, nil 52 | } 53 | 54 | // lspStart launches our LSP server in the foreground, and doesn't return. 55 | func lspStart() { 56 | commonlog.Configure(1, nil) 57 | 58 | handler = protocol.Handler{ 59 | // generic 60 | Initialize: initialize, 61 | 62 | // Yal Specific 63 | TextDocumentCompletion: textDocumentCompletion, 64 | TextDocumentHover: textDocumentHover, 65 | } 66 | 67 | server := server.NewServer(&handler, lsName, false) 68 | 69 | err := server.RunStdio() 70 | if err != nil { 71 | fmt.Printf("Internal Error Running LSP Process\n%s", err) 72 | os.Exit(1) 73 | } 74 | } 75 | 76 | // textDocumentCompletion should return available completions. 77 | // 78 | // Since we only offer completion of the functions defined within 79 | // our standard library we only calculate the (sorted) list once, 80 | // and reuse it thereafter. 81 | func textDocumentCompletion(context *glsp.Context, params *protocol.CompletionParams) (interface{}, error) { 82 | 83 | // If we've already discovered our completions then return them. 84 | if len(completions) > 0 { 85 | return completions, nil 86 | } 87 | 88 | // Build up a list of all things known in the environment 89 | keys := []string{} 90 | 91 | // Save the known "things", because we want show them in sorted-order. 92 | items := ENV.Items() 93 | for k := range items { 94 | keys = append(keys, k) 95 | } 96 | 97 | // sort the known-things (i.e. environment keys) 98 | sort.Strings(keys) 99 | 100 | // Create the return value 101 | completions = make([]protocol.CompletionItem, len(keys)) 102 | 103 | // We're only going to provide completion of things 104 | // which are functions. 105 | kind := protocol.CompletionItemKindFunction 106 | 107 | // Now we have a list of sorted things. 108 | for i, key := range keys { 109 | 110 | // Save the details in our global completions-array 111 | completions[i] = protocol.CompletionItem{ 112 | Label: key, 113 | Kind: &kind, 114 | Detail: &key, 115 | } 116 | } 117 | 118 | // And return them. 119 | return completions, nil 120 | } 121 | 122 | // textDocumentHover is called when the client hovers over a token. 123 | // 124 | // We need to find out what text is being hovered over, and return 125 | // something "useful" to the client. 126 | func textDocumentHover(context *glsp.Context, params *protocol.HoverParams) (*protocol.Hover, error) { 127 | 128 | // Get the file the user is visiting. 129 | _uri, err := uri.Parse(params.TextDocument.URI) 130 | if err != nil { 131 | return nil, err 132 | } 133 | 134 | // open the file, and read the content 135 | var content []byte 136 | content, err = os.ReadFile(_uri.Filename()) 137 | if err != nil { 138 | return nil, err 139 | } 140 | 141 | // We'll build up the current line, being hovered on here 142 | var curLine uint32 143 | line := "" 144 | 145 | // count the newlines to get the current line. 146 | for _, chr := range content { 147 | if chr == '\n' { 148 | curLine++ 149 | continue 150 | } 151 | if curLine == params.Position.Line { 152 | line += string(chr) 153 | } 154 | } 155 | 156 | // current line is empty? Then abort 157 | if line == "" { 158 | return nil, nil 159 | } 160 | 161 | // Right now we have the line we want the token 162 | // 163 | // Assume we have a line like "(this is (cake))" 164 | // and position points to the "c" we want to have the 165 | // whole token 166 | // 167 | token := "" 168 | 169 | for i, chr := range line { 170 | if chr == rune(' ') || chr == rune('(') || chr == rune(')') || chr == rune('\t') { 171 | if uint32(i) > params.Position.Character { 172 | break 173 | } 174 | token = "" 175 | continue 176 | } 177 | token += string(chr) 178 | } 179 | 180 | // Find the details of the function, if we can 181 | info, ok := ENV.Get(token) 182 | if !ok { 183 | return nil, nil 184 | } 185 | 186 | // Is it a procedure? 187 | prc, ok2 := info.(*primitive.Procedure) 188 | if !ok2 { 189 | return nil, nil 190 | } 191 | 192 | // Build up the arguments to the procedure. 193 | args := "" 194 | 195 | if len(prc.Args) > 0 { 196 | 197 | for _, arg := range prc.Args { 198 | args += " " + arg.ToString() 199 | } 200 | args = strings.TrimSpace(args) 201 | args = " (" + args + ")" 202 | } 203 | 204 | // The text we'll show - name args, and help. 205 | help := fmt.Sprintf("**%s%s**\n%s", token, args, prc.Help) 206 | 207 | return &protocol.Hover{ 208 | Contents: protocol.MarkupContent{ 209 | Kind: protocol.MarkupKindMarkdown, 210 | Value: help, 211 | }, 212 | }, nil 213 | } 214 | -------------------------------------------------------------------------------- /primitive/primitive_test.go: -------------------------------------------------------------------------------- 1 | package primitive 2 | 3 | import ( 4 | "fmt" 5 | "strings" 6 | "testing" 7 | ) 8 | 9 | func TestBool(t *testing.T) { 10 | 11 | true := Bool(true) 12 | false := Bool(false) 13 | 14 | if !true.IsSimpleType() { 15 | t.Fatalf("expected boolean to be a simple type") 16 | } 17 | 18 | if true.Type() != "boolean" { 19 | t.Fatalf("wrong type") 20 | } 21 | if true.ToString() != "#t" { 22 | t.Fatalf("bool->String had wrong result") 23 | } 24 | if false.ToString() != "#f" { 25 | t.Fatalf("bool->String had wrong result") 26 | } 27 | 28 | ti := true.ToInterface() 29 | fi := false.ToInterface() 30 | 31 | bTrue, bOK := ti.(bool) 32 | if !bOK { 33 | t.Fatalf("bool.ToInterface did not result in a bool") 34 | } 35 | if !bTrue { 36 | t.Fatalf("ToInterface resulted in the wrong result") 37 | } 38 | 39 | bFalse, bOK2 := fi.(bool) 40 | if !bOK2 { 41 | t.Fatalf("bool.ToInterface did not result in a bool") 42 | } 43 | if bFalse { 44 | t.Fatalf("ToInterface resulted in the wrong result") 45 | } 46 | 47 | } 48 | 49 | func TestCharacter(t *testing.T) { 50 | 51 | nl := Character("\n") 52 | ok := Character("o") 53 | empty := Character("") 54 | 55 | if !nl.IsSimpleType() { 56 | t.Fatalf("expected character to be a simple type") 57 | } 58 | 59 | if nl.Type() != "character" { 60 | t.Fatalf("wrong type") 61 | } 62 | if nl.ToString() != "\n" { 63 | t.Fatalf("char->String had wrong result") 64 | } 65 | if ok.ToString() != "o" { 66 | t.Fatalf("char->String had wrong result") 67 | } 68 | 69 | nli := nl.ToInterface() 70 | emptyi := empty.ToInterface() 71 | 72 | nliGo, nliOK := nli.(uint8) 73 | if !nliOK { 74 | t.Fatalf("character.ToInterface gave wrong type %T", nli) 75 | } 76 | if nliGo != '\n' { 77 | t.Fatalf("ToInterface resulted in the wrong result") 78 | } 79 | 80 | emptyGo, emptyOK := emptyi.(string) 81 | if !emptyOK { 82 | t.Fatalf("character.ToInterface gave wrong type %T", emptyi) 83 | } 84 | if emptyGo != "" { 85 | t.Fatalf("ToInterface resulted in the wrong result") 86 | } 87 | } 88 | 89 | func TestError(t *testing.T) { 90 | 91 | error := Error("no-cheese") 92 | 93 | if !error.IsSimpleType() { 94 | t.Fatalf("expected error to be a simple type") 95 | } 96 | 97 | if error.Type() != "error" { 98 | t.Fatalf("wrong type") 99 | } 100 | if error.ToString() != "ERROR{no-cheese}" { 101 | t.Fatalf("error->String had wrong result") 102 | } 103 | 104 | if !strings.Contains(ArityError().ToString(), "Arity") { 105 | t.Fatalf("arity-error is non-obvious") 106 | } 107 | 108 | if !strings.Contains(TypeError("xx").ToString(), "TypeError") { 109 | t.Fatalf("TypeError is non-obvious") 110 | } 111 | 112 | // 113 | // TODO: This is horrid 114 | // 115 | errGo := error.ToInterface() 116 | if !strings.Contains(fmt.Sprintf("%s", errGo), "cheese") { 117 | t.Fatalf("error.ToInterface is non-obvious") 118 | } 119 | 120 | } 121 | 122 | func TestIsNil(t *testing.T) { 123 | 124 | var n Nil 125 | 126 | if !n.IsSimpleType() { 127 | t.Fatalf("expected nil to be a simple type") 128 | } 129 | 130 | if n.Type() != "nil" { 131 | t.Fatalf("nil -> wrong type") 132 | } 133 | if n.ToString() != "nil" { 134 | t.Fatalf("nil->string wrong result") 135 | } 136 | 137 | i := n.ToInterface() 138 | if i != nil { 139 | t.Fatalf("nil.ToInterface gave wrong type") 140 | } 141 | 142 | var s String 143 | var f Number 144 | var b Bool 145 | 146 | if !IsNil(n) { 147 | t.Fatalf("nil is supposed to be nil") 148 | } 149 | if IsNil(s) { 150 | t.Fatalf("a string is not nil") 151 | } 152 | if IsNil(f) { 153 | t.Fatalf("a number is not nil") 154 | } 155 | if IsNil(b) { 156 | t.Fatalf("a bool is not nil") 157 | } 158 | } 159 | 160 | func TestList(t *testing.T) { 161 | 162 | lst := List([]Primitive{ 163 | Error("no-cheese"), 164 | Number(3), 165 | }) 166 | 167 | if lst.IsSimpleType() { 168 | t.Fatalf("Did not expect list to be a simple type") 169 | } 170 | 171 | if lst.Type() != "list" { 172 | t.Fatalf("wrong type") 173 | } 174 | if lst.ToString() != "(ERROR{no-cheese} 3)" { 175 | t.Fatalf("list->String had wrong result:%s", lst.ToString()) 176 | } 177 | } 178 | 179 | func TestNumber(t *testing.T) { 180 | 181 | i := Number(3) 182 | f := Number(1.0 / 9) 183 | 184 | if !i.IsSimpleType() { 185 | t.Fatalf("expected number to be a simple type") 186 | } 187 | 188 | if i.Type() != "number" { 189 | t.Fatalf("wrong type") 190 | } 191 | if i.ToString() != "3" { 192 | t.Fatalf("number->String had wrong result") 193 | } 194 | if !(strings.Contains(f.ToString(), "0.111")) { 195 | t.Fatalf("number->String (float) had wrong result:%s", f.ToString()) 196 | } 197 | 198 | ii := i.ToInterface() 199 | fi := f.ToInterface() 200 | 201 | iGo, iOK := ii.(int) 202 | if !iOK { 203 | t.Fatalf("Int.ToInterface gave wrong type %T", ii) 204 | } 205 | if iGo != 3 { 206 | t.Fatalf("ToInterface resulted in the wrong result") 207 | } 208 | 209 | fGo, fOK := fi.(float64) 210 | if !fOK { 211 | t.Fatalf("Int.ToInterface gave wrong type") 212 | } 213 | if !(strings.Contains(fmt.Sprintf("%f", fGo), "0.111")) { 214 | t.Fatalf("ToInterface resulted in the wrong result") 215 | } 216 | 217 | } 218 | 219 | func TestString(t *testing.T) { 220 | 221 | str := String("i like cake") 222 | 223 | if !str.IsSimpleType() { 224 | t.Fatalf("expected string to be a simple type") 225 | } 226 | 227 | if str.Type() != "string" { 228 | t.Fatalf("wrong type") 229 | } 230 | if str.ToString() != "i like cake" { 231 | t.Fatalf("string->String had wrong result") 232 | } 233 | } 234 | 235 | func TestSymbol(t *testing.T) { 236 | 237 | sym := Symbol("pi") 238 | 239 | if sym.IsSimpleType() { 240 | t.Fatalf("did not expected symbol to be a simple type") 241 | } 242 | if sym.Type() != "symbol" { 243 | t.Fatalf("wrong type") 244 | } 245 | if sym.ToString() != "pi" { 246 | t.Fatalf("symbol->String had wrong result") 247 | } 248 | 249 | si := sym.ToInterface() 250 | 251 | sGo, sOK := si.(string) 252 | if !sOK { 253 | t.Fatalf("String.ToInterface gave wrong type") 254 | } 255 | if sGo != "pi" { 256 | t.Fatalf("ToInterface resulted in the wrong result") 257 | } 258 | 259 | } 260 | -------------------------------------------------------------------------------- /fuzz_test.go: -------------------------------------------------------------------------------- 1 | //go:build go1.18 2 | // +build go1.18 3 | 4 | package main 5 | 6 | import ( 7 | "context" 8 | "os" 9 | "path" 10 | "strings" 11 | "testing" 12 | "time" 13 | 14 | "github.com/skx/yal/builtins" 15 | "github.com/skx/yal/config" 16 | "github.com/skx/yal/env" 17 | "github.com/skx/yal/eval" 18 | "github.com/skx/yal/primitive" 19 | "github.com/skx/yal/stdlib" 20 | ) 21 | 22 | func FuzzYAL(f *testing.F) { 23 | 24 | // We're running fuzzing, and that means we need 25 | // to disable "shell". That is done via the use 26 | // of an environmental variable 27 | os.Setenv("FUZZ", "FUZZ") 28 | 29 | // empty string 30 | f.Add([]byte("")) 31 | 32 | // simple entries 33 | f.Add([]byte("(/ 1 30)")) 34 | f.Add([]byte("(print (+ 3 2))")) 35 | f.Add([]byte("()")) 36 | f.Add([]byte("; This is a comment")) 37 | f.Add([]byte("(list 3 4 5)")) 38 | 39 | // bigger entries 40 | f.Add([]byte(` 41 | (print "Our mathematical functions allow 2+ arguments, e.g: %s = %s" 42 | (quote (+ 1 2 3 4 5 6)) (+ 1 2 3 4 5 6)) 43 | `)) 44 | f.Add([]byte(` 45 | ;; Define a function, 'fact', to calculate factorials. 46 | (define fact (lambda (n) 47 | (if (<= n 1) 48 | 1 49 | (* n (fact (- n 1)))))) 50 | 51 | ;; Invoke the factorial function, using apply 52 | (apply (list 1 2 3 4 5 6 7 8 9 10) 53 | (lambda (x) 54 | (print "%s! => %s" x (fact x)))) 55 | `)) 56 | 57 | f.Add([]byte(` 58 | ; Split a string into a list, reverse it, and join it 59 | (let* (input "Steve Kemp") 60 | (do 61 | (print "Starting string: %s" input) 62 | (print "Reversed string: %s" (join (reverse (split "Steve Kemp" "")))))) 63 | `)) 64 | 65 | f.Add([]byte(` 66 | ;; Now create a utility function to square a number 67 | (define sq (lambda (x) (* x x))) 68 | 69 | ;; For each item in the range 1-10, print it, and the associated square. 70 | ;; Awesome! Much Wow! 71 | (apply (nat 11) 72 | (lambda (x) 73 | (print "%s\tsquared is %s" x (sq x)))) 74 | `)) 75 | 76 | f.Add([]byte(` 77 | ;; 78 | ;; Setup a list of integers, and do a few things with it. 79 | ;; 80 | (let* (vals '(32 92 109 903 31 3 -93 -31 -17 -3)) 81 | (print "Working with the list: %s " vals) 82 | (print "\tBiggest item is %s" (max vals)) 83 | (print "\tSmallest item is %s" (min vals)) 84 | (print "\tReversed list is %s " (reverse vals)) 85 | (print "\tSorted list is %s " (sort vals)) 86 | (print "\tFirst item is %s " (first vals)) 87 | (print "\tRemaining items %s " (rest vals)) 88 | ) 89 | `)) 90 | 91 | f.Add([]byte(` 92 | ;; We have a built-in eval function, which operates upon symbols, or strings. 93 | (define e "(+ 3 4)") 94 | (print "Eval of '%s' resulted in %s" e (eval e)) 95 | `)) 96 | 97 | // Recurse forever 98 | f.Add([]byte(` 99 | (define r (lambda () (r))) (r)`)) 100 | 101 | // Macros 102 | f.Add([]byte(` 103 | (defmacro! unless (fn* (pred a &b) ` + "`" + `(if (! ~pred) ~a ~b))) 104 | (unless false (print "OK") 105 | `)) 106 | 107 | // Type checking 108 | f.Add([]byte(`define blah (lambda (a:list) (print "I received the list %s" a)))`)) 109 | f.Add([]byte(`define blah (lambda (a:string) (print "I received the string %s" a)))`)) 110 | f.Add([]byte(`define blah (lambda (a:number) (print "I received the number %s" a)))`)) 111 | f.Add([]byte(`define blah (lambda (a:any) (print "I received the arg %s" a)))`)) 112 | f.Add([]byte(`define blah (lambda (a) (print "I received the arg %s" a)))`)) 113 | 114 | // Find each of our examples, as these are valid code samples 115 | files, err := os.ReadDir("examples") 116 | if err != nil { 117 | f.Fatalf("failed to read examples/ directory %s", err) 118 | } 119 | 120 | // Load each example as a fuzz-source 121 | for _, file := range files { 122 | 123 | // skip fuzz.lisp, which would never return. 124 | if strings.Contains(file.Name(), "fuzz") { 125 | continue 126 | } 127 | 128 | path := path.Join("examples", file.Name()) 129 | 130 | data, err := os.ReadFile(path) 131 | if err != nil { 132 | f.Fatalf("Failed to load %s %s", path, err) 133 | } 134 | f.Add(data) 135 | } 136 | 137 | // Known errors are listed here. 138 | // 139 | // The purpose of fuzzing is to find panics, or unexpected errors. 140 | // Some programs are obviously invalid though, and we don't want to 141 | // report those known-bad things. 142 | // 143 | known := []string{ 144 | "arityerror", 145 | "catch list should begin with 'catch'", // try/catch 146 | "deadline exceeded", // context timeout 147 | "division by zero", 148 | "error expanding argument", 149 | "expected a function body", 150 | "expected a list", 151 | "expected a hash", 152 | "expected a symbol", 153 | "failed to compile regexp", 154 | "failed to open", // file:lines 155 | "invalid character literal", 156 | "is not a symbol", 157 | "list should have three elements", // try 158 | "must be greater than zero", // random 159 | "must have even length", 160 | "not a character", 161 | "not a function", 162 | "not a hash", 163 | "not a list", 164 | "not a number", 165 | "not a procedure", 166 | "not a string", 167 | "out of bounds", // nth 168 | "recursion limit", 169 | "syntax error in pattern", // glob 170 | "tried to set a non-symbol", 171 | "typeerror - ", 172 | "unexpected type", 173 | } 174 | 175 | // Read the standard library only once. 176 | std := string(stdlib.Contents()) + "\n" 177 | 178 | f.Fuzz(func(t *testing.T, input []byte) { 179 | 180 | // Avoid pathological cases with numerous backticks 181 | bc := 0 182 | for _, c := range input { 183 | if c == '`' { 184 | bc++ 185 | } 186 | } 187 | if bc > 15 { 188 | return 189 | } 190 | 191 | // Timeout after a second 192 | ctx, cancel := context.WithTimeout(context.Background(), 1000*time.Millisecond) 193 | defer cancel() 194 | 195 | // Create a new environment 196 | environment := env.New() 197 | 198 | // Environment will have a config 199 | environment.SetIOConfig(config.DefaultIO()) 200 | 201 | // Populate the default primitives 202 | builtins.PopulateEnvironment(environment) 203 | 204 | // Prepend the standard-library to the users' script 205 | src := std + string(input) 206 | 207 | // Create a new interpreter with the combined source 208 | interpreter := eval.New(src) 209 | 210 | // Ensure we timeout after 1 second 211 | interpreter.SetContext(ctx) 212 | 213 | // Now evaluate the input using the specified environment 214 | out := interpreter.Evaluate(environment) 215 | 216 | switch out.(type) { 217 | case *primitive.Error, primitive.Error: 218 | str := strings.ToLower(out.ToString()) 219 | 220 | // does it look familiar? 221 | for _, v := range known { 222 | if strings.Contains(str, v) { 223 | return 224 | } 225 | } 226 | t.Fatalf("error processing input %s:%v", input, out) 227 | } 228 | }) 229 | } 230 | -------------------------------------------------------------------------------- /stdlib/stdlib/mal.lisp: -------------------------------------------------------------------------------- 1 | ;;; mal.lisp - Compatibility with MAL, implemented in lisp. 2 | 3 | 4 | ;; Traditionally we use `car` and `cdr` for accessing the first and rest 5 | ;; elements of a list. For readability it might be nice to vary that 6 | (alias first car) 7 | (alias rest cdr) 8 | 9 | 10 | 11 | ;; Run an arbitrary series of statements, if the given condition is true. 12 | ;; 13 | ;; This is the more general/useful version of the "if2" macro, which 14 | ;; we demonstrate in mtest.lisp. 15 | ;; 16 | ;; Sample usage: 17 | ;; 18 | ;; (when (= 1 1) (print "OK") (print "Still OK") (print "final statement")) 19 | ;; 20 | (defmacro! when (fn* (pred &rest) 21 | "when is a macro which runs the specified body, providing the specified predicate is true. 22 | 23 | It is similar to an if-statement, however there is no provision for an 'else' clause, and the body specified may contain more than once expression to be evaluated." 24 | `(if ~pred (do ~@rest)))) 25 | 26 | 27 | 28 | ;; A simple looping primitive, allowing the value of a named 29 | ;; variable to be set to every member of the given list in turn, 30 | ;; and then running the body. 31 | ;; 32 | ;; We define an anonymous function which we then invoke to 33 | ;; setup our scoping, and avoid leaking the variable which 34 | ;; should be used for only the body. 35 | ;; 36 | ;; Sample usage: 37 | ;; 38 | ;; (loop n '(2 4 6 8) 39 | ;; (do 40 | ;; (print "I got %d" n) 41 | ;; (foo n))) 42 | ;; 43 | (defmacro! loop (fn* (vr xs bdy) 44 | "loop allows executing a block of code with a single variable bound to an item from the supplied list." 45 | (let* (inner-sym (gensym)) 46 | `(list 47 | (let* (~inner-sym (fn* (~vr) (~@bdy))) 48 | (if (> (length ~xs) 0) 49 | (do 50 | (~inner-sym (car ~xs)) 51 | (loop ~vr (cdr ~xs) ~bdy ) 52 | ))))))) 53 | 54 | 55 | ;; 56 | ;; If the specified predicate is true, then run the body. 57 | ;; 58 | ;; NOTE: This recurses, so it will eventually explode the stack. 59 | ;; 60 | (defmacro! while (fn* (condition &body) 61 | "while is a macro which repeatedly runs the specified body, while the condition returns a true-result." 62 | (let* (inner-sym (gensym)) 63 | `(let* (~inner-sym (fn* () 64 | (if ~condition 65 | (do 66 | ~@body 67 | (~inner-sym))))) 68 | (~inner-sym))))) 69 | 70 | 71 | ;; 72 | ;; cond is a useful thing to have. 73 | ;; 74 | (defmacro! cond (fn* (&xs) 75 | "cond is a macro which accepts a list of conditions and results, and returns the value of the first matching condition. It is similar in functionality to a C case-statement." 76 | (if (> (length xs) 0) 77 | (list 'if (first xs) 78 | (if (> (length xs) 1) 79 | (nth xs 1) 80 | (error "An odd number of forms to (cond..)")) 81 | (cons 'cond (rest (rest xs))))))) 82 | 83 | ;; A useful helper to apply a given function to each element of a list. 84 | (set! apply (fn* (lst:list fun:function) 85 | "Call the specified function on every element in the given list. 86 | 87 | See-also: apply-pairs, apply-hash" 88 | (if (nil? lst) 89 | () 90 | (do 91 | (fun (car lst)) 92 | (apply (cdr lst) fun))))) 93 | 94 | ;; Apply, but walking the list in pairs. 95 | (set! apply-pairs (fn* (lst:list fun:function) 96 | "Calling the specified function with two items on the specified list. 97 | 98 | This is similar to apply, but apply apply invokes the callback with a single list-item, and here we apply in pairs. 99 | 100 | Note: The list-length must be even, and if not that will raise an error. 101 | 102 | See-also: apply apply-hash 103 | Example: (apply-pairs (list 1 2 3 4) (lambda (a b) (print \"Called with %s %s\" a b))) 104 | " 105 | (if (! (nil? lst)) 106 | (if (= (% (length lst) 2) 0) 107 | (let* (a (car lst) 108 | b (car (cdr lst))) 109 | (fun a b) 110 | (apply-pairs (cdr (cdr lst) ) fun)) 111 | (error "The list passed to (apply-pairs..) should have an even length"))))) 112 | 113 | ;; Return the length of the given list. 114 | (set! length (fn* (arg) 115 | "Return the length of the supplied list. See-also strlen." 116 | (if (list? arg) 117 | (do 118 | (if (nil? arg) 0 119 | (inc (length (cdr arg))))) 120 | 0 121 | ))) 122 | 123 | (alias count length) 124 | 125 | 126 | (set! map (fn* (lst:list fun:function) 127 | "Return a list with the contents of evaluating the given function on every item of the supplied list. 128 | 129 | See-also: map-pairs" 130 | (if (nil? lst) 131 | () 132 | (cons (fun (car lst)) (map (cdr lst) fun))))) 133 | 134 | (set! map-pairs (fn* (lst:list fun:function) 135 | "Return a list with the contents of evaluating the given function on every pair of items in the supplied list. 136 | 137 | See-also: map" 138 | (if (! (nil? lst)) 139 | (if (= (% (length lst) 2) 0) 140 | (let* (a (car lst) 141 | b (car (cdr lst))) 142 | (cons (fun a b) (map-pairs (cdr (cdr lst)) fun))) 143 | (error "The list passed should have an even length")) 144 | ()))) 145 | 146 | 147 | ;; This is required for our quote/quasiquote/unquote/splice-unquote handling 148 | ;; 149 | ;; Testing is hard, but 150 | ;; 151 | ;; (define lst (quote (b c))) ; b c 152 | ;; (print (quasiquote (a lst d))) ; (a lst d) 153 | ;; (print (quasiquote (a (unquote lst) d))) ; (a (b c) d) 154 | ;; (print (quasiquote (a (splice-unquote lst) d))) ; (a b c d) 155 | ;; 156 | (set! concat (fn* (seq1 seq2) 157 | "Join two lists" 158 | (if (nil? seq1) 159 | seq2 160 | (cons (car seq1) (concat (cdr seq1) seq2))))) 161 | -------------------------------------------------------------------------------- /examples/test.lisp: -------------------------------------------------------------------------------- 1 | ;;; test.lisp - Simple feature-tests/demonstrations of our system. 2 | 3 | ;; 4 | ;; This is a sample input file for our minimal lisp interpreter. 5 | ;; 6 | ;; We use it to demonstrate and test some basic features. 7 | ;; 8 | ;; NOTE: A lot of the things called here are defined in the standard 9 | ;; library, which is pre-pended to all loaded-scripts. 10 | 11 | 12 | ;; Instead of just (+ 1 2) we allow multiple args 13 | (print "Our mathematical functions allow 2+ arguments, e.g: %s = %d" 14 | (quote (+ 1 2 3 4 5 6)) (+ 1 2 3 4 5 6)) 15 | 16 | 17 | ;; 18 | ;; Use our "repeat" function, from the standard library, to run a block 19 | ;; N/10 times. The number of the attempt is given as a parameter. 20 | ;; 21 | (repeat 10 (lambda (n) (print "I'm in a loop %d" n))) 22 | 23 | ;; 24 | ;; Use our "while" function, from the standard library, to run a block 25 | ;; of code N/5 times. 26 | ;; 27 | (let* (a 5) 28 | (while (> a 0) 29 | (do 30 | (print "(while) loop - iteration %d" a) 31 | (set! a (- a 1) true)))) 32 | 33 | 34 | ;; Define a function, `fact`, to calculate factorials. 35 | (set! fact (fn* (n) 36 | (if (<= n 1) 37 | 1 38 | (* n (fact (- n 1)))))) 39 | 40 | 41 | 42 | 43 | ;; Return the number of ms a function invokation took. 44 | (set! benchmark (fn* (fn) 45 | "Run the specified function, while recording the time 46 | it took to execute. Return that time, in ms." 47 | (let* (start-ms (ms) 48 | _ (fn) 49 | end-ms (ms)) 50 | (- end-ms start-ms)))) 51 | 52 | ;; Invoke the factorial function, using apply 53 | ;; 54 | ;; Calculate the factorial of "big numbers" mostly as a test of the 55 | ;; `now` function which times how long it took. 56 | (apply (list 1 10 100 1000 10000 50000 100000) 57 | (lambda (x) 58 | (print "Calculating %d factorial took %dms" 59 | x 60 | (benchmark (lambda () (fact x)))))) 61 | 62 | 63 | ; Split a string into a list, reverse it, and join it 64 | (let* (input "Steve Kemp") 65 | (print "Starting string: %s" input) 66 | (print "Reversed string: %s" (join (reverse (split "Steve Kemp" ""))))) 67 | 68 | 69 | ;; Define a variable "foo => 0" 70 | ;; but then change it, and show that result 71 | (let* (foo 0) 72 | (print "foo is set to %d" foo) 73 | (set! foo 3) 74 | (print "foo is now set to %d" foo)) 75 | 76 | ;;Now we're outside the scope of the `let` so `foo` is nil 77 | (if foo 78 | (print "something weird happened!") 79 | (print "foo is unset now, outside the scope of the `let`")) 80 | 81 | 82 | ;; Define another function, and invoke it 83 | (set! sum2 (fn* (n acc) (if (= n 0) acc (sum2 (- n 1) (+ n acc))))) 84 | (print "Sum of 1-100: %d" (sum2 100 0)) 85 | 86 | ;; Now create a utility function to square a number 87 | (set! sq (fn* (x) (* x x))) 88 | 89 | ;; For each item in the range 1-10, print it, and the associated square. 90 | ;; Awesome! Much Wow! 91 | (apply (nat 10) 92 | (lambda (x) 93 | (print "%d\tsquared is %d" x (sq x)))) 94 | 95 | ;; Test our some of our earlier functions against a range of numbers 96 | (apply (list -2 -1 0 1 2 3 4 5) 97 | (lambda (x) 98 | (do 99 | (if (neg? x) (print "%d is negative" x)) 100 | (if (zero? x) (print "%d is ZERO" x)) 101 | (if (even? x) (print "%d is EVEN" x)) 102 | (if (odd? x) (print "%d is ODD" x))))) 103 | 104 | ;; Test that we can get the correct type of each of our primitives 105 | (apply (list 1 "steve" (list 1 2 3) true #t false #f nil boolean? print) 106 | (lambda (x) 107 | (print "'%s' has type '%s'" (str x) (type x)))) 108 | 109 | 110 | ;; 111 | ;; Show even numbers via the filter-function. 112 | ;; 113 | (print "Even numbers from 0-10: %s" (filter (nat 11) even?)) 114 | 115 | ;; 116 | ;; And again with square numbers. 117 | ;; 118 | (print "Squared numbers from 0-10: %s" (map (nat 11) sq)) 119 | 120 | 121 | ;; 122 | ;; Setup a list of integers, and do a few things with it. 123 | ;; 124 | (let* (vals '(32 92 109 903 31 3 -93 -31 -17 -3)) 125 | (print "Working with the list: %s " vals) 126 | (print "\tBiggest item is %d" (max vals)) 127 | (print "\tSmallest item is %d" (min vals)) 128 | (print "\tReversed list is %s " (reverse vals)) 129 | (print "\tSorted list is %s " (sort vals)) 130 | (print "\tFirst item is %d " (first vals)) 131 | (print "\tRemaining items %s " (rest vals))) 132 | 133 | 134 | ;; 135 | ;; A simple assertion function 136 | ;; 137 | (set! assert (fn* (result msg) 138 | (if result () 139 | (print "ASSERT failed - %s" msg)))) 140 | 141 | ;; 142 | ;; Make some basic tests using our assert function. 143 | ;; 144 | (assert (function? print) "(function? print) failed") 145 | (assert (function? assert) "(function? assert) failed") 146 | 147 | (assert (eq 6 (+ 1 2 3)) "1+2+3 != 6") 148 | (assert (eq 24 (* 2 3 4)) "2*3*4 != 24") 149 | (assert (eq 70 (- 100 10 20)) "100-10-20 != 70") 150 | 151 | (assert (eq (type type) "procedure(golang)") "(type type)") 152 | (assert (eq (type assert) "procedure(lisp)") "(type assert)") 153 | (assert (eq (type 1) "number") "(type number)") 154 | (assert (eq (type "me") "string") "(type string)") 155 | (assert (eq (type (list 1 2)) "list") "(type list)") 156 | 157 | (assert (neg? -3) "negative number detected") 158 | (assert (! (neg? 0) ) "zero is not negative") 159 | (assert (! (neg? 30) ) "a positive number is not negative") 160 | (assert (= (abs -3) (abs 3)) "abs(-3) == 3") 161 | 162 | (assert (= (fact 1) 1) "1! = 1") 163 | (assert (= (fact 2) 2) "2! = 2") 164 | (assert (= (fact 3) 6) "3! = 6") 165 | 166 | (assert (< 3 30) "3 < 30") 167 | (assert (! (< 30 30)) "30 < 30") 168 | (assert (<= 30 30) "30 < 30") 169 | (assert (> 30 20) "30 > 20") 170 | 171 | ;; nth starts counting at zero which is perhaps surprising. 172 | (assert (= (nth (list 10 20 30) 0) 10) "Got the first item of the list.") 173 | (assert (= (nth (list 10 20 30) 1) 20) "Got the second item of the list.") 174 | 175 | 176 | ;; We have a built-in eval function, which operates upon symbols, or strings. 177 | (set! e "(+ 3 4)") 178 | (print "Eval of '%s' resulted in %d" e (eval e)) 179 | (print "Eval of '%s' resulted in %d" "(+ 40 2)" (eval "(+ 40 2)")) 180 | 181 | ;; Simple test of `cond` 182 | (set! a 6) 183 | (cond 184 | (> a 20) (print "A > 20") 185 | (> a 15) (print "A > 15") 186 | true (print "A is %d" a) 187 | ) 188 | 189 | ;; 190 | ;; Trivial Read/Eval pair 191 | ;; 192 | (print "The answer to life, the universe, and everything is %d!\n" 193 | (eval (read "(* 6 7)"))) 194 | 195 | ;; Upper-case and lower-casing of strings 196 | (print "%s" (upper "hello, world")) 197 | (print "%s" (lower "Hello, World; in LOWER-case.")) 198 | 199 | ;; All done! -> In red :) 200 | (set! red (fn* (msg) (sprintf "\e[0;31m%s\e[0m" msg))) 201 | (print (red "All done!")) 202 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![GoDoc](https://img.shields.io/static/v1?label=godoc&message=reference&color=blue)](https://pkg.go.dev/github.com/skx/yal) 2 | [![Go Report Card](https://goreportcard.com/badge/github.com/skx/yal)](https://goreportcard.com/report/github.com/skx/yal) 3 | [![license](https://img.shields.io/github/license/skx/yal.svg)](https://github.com/skx/yal/blob/master/LICENSE) 4 | 5 | * [yet another lisp](#yet-another-lisp) 6 | * [Building / Installing](#building--installing) 7 | * [Standard Library](#standard-library) 8 | * [Usage](#usage) 9 | * [Integrated Help](#integrated-help) 10 | * [REPL Helper](#repl-helper) 11 | * [Examples](#examples) 12 | * [Fuzz Testing](#fuzz-testing) 13 | * [Benchmark](#benchmark) 14 | * [See Also](#see-also) 15 | 16 | 17 | # yet another lisp 18 | 19 | 20 | * [A brief introduction to using this lisp](INTRODUCTION.md). 21 | * Getting started setting variables, defining functions, etc. 22 | * This includes documentation on enhanced features such as 23 | * Hashes. 24 | * Structures. 25 | * [A list of primitives we have implemented](PRIMITIVES.md). 26 | * This describes the functions we support, whether implemented in lisp or golang. 27 | * For example `(car)`, `(cdr)`, `(file:lines)`, `(shell)`, etc. 28 | * Notes on our [LSP](LSP.md) support. 29 | 30 | 31 | ## Building / Installing 32 | 33 | If you have [the yal repository](https://github.com/skx/yal) cloned locally then 34 | you should be able to build and install in the standard way: 35 | 36 | ```sh 37 | $ go build . 38 | $ go install . 39 | ``` 40 | 41 | If you don't have the repository installed, but you have a working golang toolset then installation should be as simple as: 42 | 43 | ```sh 44 | $ go install github.com/skx/yal@latest 45 | ``` 46 | 47 | If neither of those options suit, you may download the most recent binary from our [release page](https://github.com/skx/yal/releases). 48 | 49 | Remember that if you're running a Mac you'll need to remove the quarantine flag which _protects you_ from unsigned binaries, for example: 50 | 51 | ```sh 52 | % xattr -d com.apple.quarantine yal-darwin-amd64 53 | % chmod 755 com.apple.quarantine yal-darwin-amd64 54 | ``` 55 | 56 | 57 | 58 | ## Usage 59 | 60 | Once installed there are three ways to execute code: 61 | 62 | * By specifying an expression to execute upon the command-line: 63 | * `yal -e '(print (os))'` 64 | * By passing the name of a file containing lisp code to read and execute: 65 | * `yal examples/test.lisp` 66 | * By launching the interpreter with zero arguments, which will start the interactive REPL mode. 67 | * If present the file `~/.yalrc` is loaded before the REPL starts. 68 | * Here is a sample [.yalrc](.yalrc) file which shows the kind of thing you might wish to do. 69 | 70 | When running with the `-debug` flag any output from the `(error)` primitive will be shown to STDERR, along with some internal logging. 71 | 72 | Finally if you've downloaded a binary release from [our release page](https://github.com/skx/yal/releases) the `-v` flag will show you what version you're running: 73 | 74 | ```sh 75 | % yal-darwin-amd64 -v 76 | v0.11.0 f21d032e812ee6eadad5eac23f079a11f5e1041a 77 | ``` 78 | 79 | 80 | ### Integrated Help 81 | 82 | The yal interpreter allows (optional) documentation to be attached to functions, both those implemented in the core, and those which are added in lisp. 83 | 84 | You can view the help output by launching with the `-h` flag: 85 | 86 | $ yal -h 87 | 88 | By default all the help-text contained within the standard-library, and our built-in primitives, will be shown. You may limit the display to specific function(s) by supplying an arbitrary number of regular expression, for example: 89 | 90 | $ yal -h count execute 91 | count (arg) 92 | =========== 93 | count is an alias for length. 94 | 95 | load-file (filename) 96 | ==================== 97 | Load and execute the contents of the supplied filename. 98 | 99 | When you specify a regular expression, or more than one, the matches will be applied to the complete documentation for each function. So the term "foo" will match the term "foo" inside the explanation of the function, the argument list, and the function name itself. 100 | 101 | A good example of the broad matching would include the term "length": 102 | 103 | $ yal -h length | grep -B1 == 104 | apply-pairs (lst:list fun:function) 105 | =================================== 106 | -- 107 | count (arg) 108 | =========== 109 | -- 110 | length (arg) 111 | ============ 112 | -- 113 | pad:left (str add len) 114 | ====================== 115 | -- 116 | pad:right (str add len) 117 | ======================= 118 | -- 119 | repeated (n:number x) 120 | ===================== 121 | -- 122 | strlen (str:string) 123 | =================== 124 | 125 | 126 | 127 | ### REPL Helper 128 | 129 | If you wish to get command-line completion, history, etc, within the REPL-environment you might consider using the `rlwrap` tool. 130 | 131 | First of all output a list of the names of each of the built-in function: 132 | 133 | $ yal -e "(apply (env) (lambda (x) (print (get x :name))))" > functions.txt 134 | 135 | Now launch the REPL with completion on those names: 136 | 137 | $ rlwrap --file functions.txt ./yal 138 | 139 | 140 | 141 | 142 | ## Standard Library 143 | 144 | When user-code is executed, whether a simple statement supplied via the command-line, or read from a file, a standard-library is loaded from beneath the directory: 145 | 146 | * [stdlib/stdlib/](stdlib/stdlib/) 147 | 148 | 149 | Our standard-library consists of primitive functions such as `(map..)`, `(min..)` and similar, is written in 100% yal-lisp. 150 | 151 | The standard library may be entirely excluded via the use of the environmental varilable `YAL_STDLIB_EXCLUDE_ALL`: 152 | 153 | ``` 154 | $ yal -e "(print (hms))" 155 | 22:30:57 156 | 157 | $ YAL_STDLIB_EXCLUDE_ALL=true yal -e "(print (hms))" 158 | Error running: error expanding argument [hms] for call to (print ..): 159 | ERROR{argument 'hms' not a function} 160 | ``` 161 | 162 | If you prefer you may exclude specific _parts_ of the standard library, by specifying a comma-separated list of regular expressions: 163 | 164 | ``` 165 | $ YAL_STDLIB_EXCLUDE=date,type-checks yal -e "(print (hms))" 166 | 22:30:57 167 | ``` 168 | 169 | Here the regular expressions will be matched against the name of the file(s) in the [standard library directory](stdlib/stdlib/). 170 | 171 | 172 | 173 | ## Examples 174 | 175 | A reasonable amount of sample code can be found beneath the [examples/](examples/) directory, including: 176 | 177 | * [examples/fibonacci.list](examples/fibonacci.lisp) 178 | * Calculate the first 25 numbers of the Fibonacci sequence. 179 | * [examples/fizzbuzz.lisp](examples/fizzbuzz.lisp) 180 | * A standalone sample of solving the fizzbuzz problem. 181 | * [examples/mtest.lisp](examples/mtest.lisp) 182 | * Shows simple some macro examples, but see [examples/lisp-tests.lisp](examples/lisp-tests.lisp) for a more useful example. 183 | * This uses macros in an interesting way. 184 | * It is also used to actually test the various Lisp-methods we've implemented. 185 | * [examples/sorting.lisp](examples/sorting.lisp) 186 | * Demonstrates writing & benchmarking sorting-routines. 187 | * [examples/test.lisp](examples/test.lisp) 188 | * A misc. collection of sample code, functions, and notes. 189 | 190 | As noted there is a standard-library of functions which are loaded along with any user-supplied script - that library of functions may also provide a useful reference and example of yal-code: 191 | 192 | * [stdlib/stdlib/](stdlib/stdlib/) 193 | 194 | The standard-library contains its own series of test-cases written in Lisp: 195 | 196 | * [examples/lisp-tests.lisp](examples/lisp-tests.lisp) 197 | 198 | The lisp-tests.lisp file contains a simple macro for defining test-cases, and uses that to good effect to test a range of our lisp-implemented primitives. 199 | 200 | 201 | 202 | ## Fuzz Testing 203 | 204 | The project has 100% test-coverage of all the internal packages, using the standard go facilities you can run those test-cases: 205 | 206 | ```sh 207 | go test ./... 208 | ``` 209 | 210 | In addition to the static-tests there is also support for the integrated fuzz-testing facility which became available with go 1.18+. Fuzz-testing essentially feeds the interpreter random input and hopes to discover crashes. 211 | 212 | You can launch a series of fuzz-tests like so: 213 | 214 | ```sh 215 | go test -fuzztime=300s -parallel=1 -fuzz=FuzzYAL -v 216 | ``` 217 | 218 | Sample output will look like this: 219 | 220 | ``` 221 | === FUZZ FuzzYAL 222 | ... 223 | fuzz: elapsed: 56m54s, execs: 163176 (0/sec), new interesting: 108 (total: 658) 224 | fuzz: elapsed: 56m57s, execs: 163176 (0/sec), new interesting: 108 (total: 658) 225 | fuzz: elapsed: 57m0s, execs: 163183 (2/sec), new interesting: 109 (total: 659) 226 | fuzz: elapsed: 57m3s, execs: 163433 (83/sec), new interesting: 110 (total: 660) 227 | .. 228 | ``` 229 | 230 | If you find a crash then it is either a bug which needs to be fixed, or a false-positive (i.e. a function reports an error which is expected) in which case the fuzz-test should be updated to add it to the list of known-OK results. (For example "division by zero" is a fatal error, so that's a known-OK result). 231 | 232 | 233 | 234 | 235 | ## Benchmark 236 | 237 | There is a simple benchmark included within this repository, computing the factorial of 100, to run this execute execute: 238 | 239 | ```sh 240 | $ go test -run=Bench -bench=. 241 | ``` 242 | 243 | To run the benchmark for longer add `-benchtime=30s`, or similar, to the command-line. 244 | 245 | I also put together an external comparison of my toy scripting languages here: 246 | 247 | * [Toy Language Benchmarks](https://github.com/skx/toy-language-benchmarks) 248 | 249 | This shows that the Lisp implementation isn't so slow, although it is not the fasted of the scripting languages I've implemented. 250 | 251 | 252 | 253 | ## See Also 254 | 255 | This repository was put together after [experimenting with a scripting language](https://github.com/skx/monkey/), an [evaluation engine](https://github.com/skx/evalfilter/), putting together a [TCL-like scripting language](https://github.com/skx/critical), writing a [BASIC interpreter](https://github.com/skx/gobasic) and creating [tutorial-style FORTH interpreter](https://github.com/skx/foth). 256 | 257 | I've also played around with a couple of compilers which might be interesting to refer to: 258 | 259 | * Brainfuck compiler: 260 | * [https://github.com/skx/bfcc/](https://github.com/skx/bfcc/) 261 | * A math-compiler: 262 | * [https://github.com/skx/math-compiler](https://github.com/skx/math-compiler) 263 | -------------------------------------------------------------------------------- /main.go: -------------------------------------------------------------------------------- 1 | // Package main contains a simple CLI driver for our lisp interpreter. 2 | // 3 | // All the logic is contained within the `main` function, and it merely 4 | // reads the contents of the user-supplied filename, prepends the standard 5 | // library to that content, and executes it. 6 | package main 7 | 8 | import ( 9 | "flag" 10 | "fmt" 11 | "os" 12 | "path" 13 | "regexp" 14 | "sort" 15 | "strings" 16 | 17 | "github.com/chzyer/readline" 18 | 19 | "github.com/skx/yal/builtins" 20 | "github.com/skx/yal/config" 21 | "github.com/skx/yal/env" 22 | "github.com/skx/yal/eval" 23 | "github.com/skx/yal/primitive" 24 | "github.com/skx/yal/stdlib" 25 | ) 26 | 27 | var ( 28 | version = "unreleased" 29 | sha1sum = "unknown" 30 | 31 | // ENV is the environment the interpreter uses. 32 | ENV *env.Environment 33 | 34 | // LISP is the actual interpreter. 35 | LISP *eval.Eval 36 | ) 37 | 38 | // versionFn is the implementation of the (version) primitive. 39 | func versionFn(env *env.Environment, args []primitive.Primitive) primitive.Primitive { 40 | return primitive.String(version) 41 | } 42 | 43 | // create handles the setup of our global interpreter and environment. 44 | // 45 | // The standard-library will be loaded, and os.args will be populated. 46 | func create() { 47 | 48 | // Create a new environment 49 | ENV = env.New() 50 | 51 | // Setup the I/O 52 | ENV.SetIOConfig(config.DefaultIO()) 53 | 54 | // Populate the default primitives 55 | builtins.PopulateEnvironment(ENV) 56 | 57 | // Add the (version) function 58 | ENV.Set("version", 59 | &primitive.Procedure{ 60 | F: versionFn, 61 | Help: "Return the version of the interpreter.\n\nSee-also: arch, os", 62 | Args: []primitive.Symbol{}}) 63 | 64 | // Build up a list of the command-line arguments 65 | args := primitive.List{} 66 | 67 | // Adding them to the list 68 | for _, arg := range flag.Args() { 69 | args = append(args, primitive.String(arg)) 70 | } 71 | 72 | // Before setting them in the environment 73 | ENV.Set("os.args", args) 74 | 75 | // Read the standard library 76 | txt := stdlib.Contents() 77 | 78 | // Create a new interpreter with that source 79 | LISP = eval.New(string(txt)) 80 | 81 | // Now evaluate the input using the specified environment 82 | out := LISP.Evaluate(ENV) 83 | 84 | // Did we get an error? Then show it. 85 | if _, ok := out.(primitive.Error); ok { 86 | fmt.Printf("Error executing standard-library: %v\n", out) 87 | os.Exit(1) 88 | } 89 | } 90 | 91 | // help - show help information. 92 | // 93 | // Either all functions, or only those that match the regular expressions 94 | // supplied. 95 | func help(show []string) { 96 | 97 | // Patterns is a cache of regexps, to ensure we only compile 98 | // them once. 99 | var patterns []*regexp.Regexp 100 | 101 | // Compile each supplied pattern, and save it away. 102 | for _, pat := range show { 103 | 104 | r, er := regexp.Compile(pat) 105 | if er != nil { 106 | fmt.Printf("Error compiling regexp %s:%s", show, er) 107 | return 108 | } 109 | 110 | patterns = append(patterns, r) 111 | } 112 | 113 | // We want to show aliased functions separately, so we have to 114 | // find them - via the interpreter which executed the stdlib 115 | // at create() time. 116 | aliased := LISP.Aliased() 117 | 118 | // Build up a list of all things known in the environment 119 | keys := []string{} 120 | 121 | // Save the known "things", because we want show them in sorted-order. 122 | items := ENV.Items() 123 | for k := range items { 124 | keys = append(keys, k) 125 | } 126 | 127 | // sort the known-things (i.e. environment keys) 128 | sort.Strings(keys) 129 | 130 | // Now we have a list of sorted things. 131 | for _, key := range keys { 132 | 133 | // get the item from the environment. 134 | val, _ := ENV.Get(key) 135 | 136 | // Is it a procedure? 137 | prc, ok := val.(*primitive.Procedure) 138 | 139 | // If it isn't a procedure skip it. 140 | if !ok { 141 | continue 142 | } 143 | 144 | // If there is no help then skip it. 145 | if len(prc.Help) == 0 { 146 | continue 147 | } 148 | 149 | // Get the text 150 | txt := prc.Help 151 | 152 | // Is this an aliased function? 153 | target, ok := aliased[key] 154 | if ok { 155 | // If so change the text. 156 | txt = fmt.Sprintf("%s is an alias for %s.", key, target) 157 | } 158 | 159 | // Build up the arguments to the procedure. 160 | args := "" 161 | 162 | if len(prc.Args) > 0 { 163 | 164 | for _, arg := range prc.Args { 165 | args += " " + arg.ToString() 166 | 167 | // Default value for this argument? 168 | def, ok := prc.Defaults[arg] 169 | if ok { 170 | args += "[default:" 171 | args += def.ToString() 172 | args += "]" 173 | } 174 | } 175 | args = strings.TrimSpace(args) 176 | args = " (" + args + ")" 177 | } 178 | 179 | // Build up a complete list of the entry we'll output. 180 | entry := key + args + "\n" 181 | entry += strings.Repeat("=", len(key+args)) + "\n" 182 | entry += txt + "\n\n\n" 183 | 184 | // Are we going to show this? 185 | // 186 | // No filtering? Then yes 187 | if len(show) == 0 { 188 | fmt.Printf("%s", entry) 189 | continue 190 | } 191 | 192 | // Otherwise test each supplied pattern against the text, 193 | // and if one matches show it and continue. 194 | for _, test := range patterns { 195 | 196 | res := test.FindStringSubmatch(entry) 197 | if len(res) > 0 { 198 | fmt.Printf("%s", entry) 199 | continue 200 | } 201 | } 202 | } 203 | } 204 | 205 | func main() { 206 | 207 | // define our command-line flags 208 | exp := flag.String("e", "", "A string to evaluate.") 209 | hlp := flag.Bool("h", false, "Show help information and exit.") 210 | lsp := flag.Bool("lsp", false, "Launch the LSP mode") 211 | ver := flag.Bool("v", false, "Show our version and exit.") 212 | deb := flag.Bool("debug", false, "Show debug output during execution (to STDERR).") 213 | 214 | // Parse our command-line flags 215 | flag.Parse() 216 | 217 | // Showing the version? 218 | if *ver { 219 | fmt.Printf("%s [%s]\n", version, sha1sum) 220 | return 221 | } 222 | 223 | // create the interpreter. 224 | // 225 | // This populates the environment, by executing the standard-library. 226 | // 227 | // This saves time because: 228 | // 229 | // -h will require the stdlib to be loaded, to dump help info. 230 | // 231 | // OR 232 | // 233 | // executing the users' code, via "-e" or a file, will need 234 | // that present too. 235 | // 236 | create() 237 | 238 | // 239 | // By default we have no STDERR handler wired up, but if we set the 240 | // debug flag we'll send that to the actual console's STDERR stream 241 | if *deb { 242 | 243 | // Get config 244 | iohelper := ENV.GetIOConfig() 245 | 246 | // Setup a destination for STDERR 247 | iohelper.STDERR = os.Stderr 248 | 249 | // Update 250 | ENV.SetIOConfig(iohelper) 251 | } 252 | 253 | // LSP? 254 | if *lsp { 255 | lspStart() 256 | return 257 | } 258 | 259 | // showing the help? 260 | if *hlp { 261 | help(flag.Args()) 262 | return 263 | } 264 | 265 | // Executing an expression? 266 | if *exp != "" { 267 | 268 | // Now evaluate the input using the specified environment 269 | out := LISP.Execute(ENV, string(*exp)) 270 | 271 | // Did we get an error? Then show it. 272 | if _, ok := out.(primitive.Error); ok { 273 | fmt.Printf("Error executing the supplied expression: %v\n", out) 274 | os.Exit(1) 275 | } 276 | os.Exit(0) 277 | } 278 | 279 | // If we have a file, then read the content. 280 | if len(flag.Args()) > 0 { 281 | content, err := os.ReadFile(flag.Args()[0]) 282 | if err != nil { 283 | fmt.Printf("Error reading %s:%s\n", os.Args[1], err) 284 | return 285 | } 286 | 287 | // Now evaluate the input using the specified environment 288 | out := LISP.Execute(ENV, string(content)) 289 | 290 | // Did we get an error? Then show it. 291 | if _, ok := out.(primitive.Error); ok { 292 | fmt.Printf("Error executing %s: %v\n", os.Args[1], out) 293 | os.Exit(1) 294 | } 295 | os.Exit(0) 296 | } 297 | 298 | // 299 | // We'll read a config file from HOME, if it exists, and also persist history there. 300 | // 301 | home := os.Getenv("HOME") 302 | 303 | // 304 | // History file will be set if HOME wasn't empty. 305 | // 306 | hist := "" 307 | if home != "" { 308 | hist = path.Join(home, ".yal.history") 309 | } 310 | 311 | // 312 | // No arguments mean this is our REPL 313 | // 314 | // Create a readline-helper for reading the input from the user. 315 | // 316 | rl, err := readline.NewEx(&readline.Config{ 317 | Prompt: "> ", 318 | HistoryFile: hist, 319 | HistorySearchFold: true, 320 | DisableAutoSaveHistory: false, 321 | }) 322 | 323 | // 324 | // There should be no error creating our readline-helper, 325 | // but if there is then it is fatal. 326 | // 327 | if err != nil { 328 | fmt.Printf("Failed to initialize readlin: %s\n", err) 329 | os.Exit(1) 330 | } 331 | defer rl.Close() 332 | 333 | // 334 | // Get the home directory, and load ~/.yalrc if present 335 | // 336 | if home != "" { 337 | 338 | // Build the path 339 | file := path.Join(home, ".yalrc") 340 | 341 | // Read the content 342 | content, err := os.ReadFile(file) 343 | if err == nil { 344 | 345 | // Execute the contents 346 | out := LISP.Execute(ENV, string(content)) 347 | if _, ok := out.(primitive.Error); ok { 348 | fmt.Printf("Error executing ~/.yalrc %v\n", out) 349 | } 350 | } 351 | } 352 | 353 | // 354 | // We allow multi-line input, and build up the thing to execute 355 | // into this temporary string if that is the case. 356 | // 357 | src := "" 358 | 359 | for { 360 | 361 | // 362 | // Different prompt for first-line and additional lines 363 | // 364 | if src == "" { 365 | rl.SetPrompt("> ") 366 | } else { 367 | rl.SetPrompt(">>> ") 368 | } 369 | 370 | // 371 | // Read input 372 | // 373 | line, err := rl.Readline() 374 | if err != nil { 375 | break 376 | } 377 | 378 | // 379 | // Save it to anything we might have previously read 380 | // 381 | src += line 382 | src = strings.TrimSpace(src) 383 | 384 | // Allow the user to exit 385 | if src == "exit" || src == "quit" { 386 | break 387 | } 388 | 389 | // 390 | // Attempt to guess if the line is complete. 391 | // 392 | // A line is complete if there are matching numbers 393 | // of opening and closing brackets. 394 | /// 395 | open := strings.Count(src, "(") 396 | close := strings.Count(src, ")") 397 | 398 | if open < close { 399 | fmt.Printf("Malformed expression: %v", src) 400 | src = "" 401 | continue 402 | } 403 | if open == close { 404 | 405 | out := LISP.Execute(ENV, src) 406 | 407 | // If the result wasn't nil then show it 408 | if _, ok := out.(primitive.Nil); !ok { 409 | fmt.Printf("%v\n", out.ToString()) 410 | } 411 | 412 | src = "" 413 | } 414 | } 415 | 416 | // All done. 417 | } 418 | -------------------------------------------------------------------------------- /builtins/help.txt: -------------------------------------------------------------------------------- 1 | # 2 | calculate the exponent of a to the power of b. 3 | %% 4 | % 5 | calculate a modulus b. 6 | %% 7 | + 8 | Adds all arguments present to the first number. 9 | %% 10 | - 11 | Subtracts all arguments present from the first number. 12 | %% 13 | * 14 | Multiplies all arguments present with the first number. 15 | %% 16 | / 17 | Divides all arguments present with the first number. 18 | %% 19 | /= 20 | Numerical inequality testing. If any argument is identical 21 | to any other argument return false. Otherwise return true. 22 | %% 23 | < 24 | 25 | Return true if a is less than b. 26 | %% 27 | = 28 | returns true if the numerical values supplied are all equal to each other. 29 | 30 | Note that multiple values may be specified, so it is possible to compare 31 | three, or more, values as per the second example below. 32 | 33 | See also: char=, eq, string= 34 | Example : (print (= 3 a)) 35 | Example : (print (= 3 a b)) 36 | %% 37 | abs 38 | Return the absolute value of the supplied number. 39 | %% 40 | acos 41 | 42 | Acos returns the arccosine, in radians, of n. 43 | %% 44 | asin 45 | 46 | Asin returns the arcsine, in radians, of n. 47 | %% 48 | atan 49 | 50 | Atan returns the arctangent, in radians, of n. 51 | %% 52 | arch 53 | arch returns a simple string describing the architecture the current host is running upon. 54 | 55 | See also: (os) 56 | Example : (print (arch)) 57 | %% 58 | base 59 | 60 | Convert the given number into a string representation in the specified base. 61 | 62 | See also: number, sprintf, str 63 | 64 | Example: (print (base 255 2)) ; base two is binary 65 | Example: (print (base 255 16)) ; base 16 is hexadecimal 66 | %% 67 | body 68 | 69 | Return the body of a function implemented in lisp. 70 | 71 | See also: help, source 72 | 73 | Example: (print (body inc)) 74 | %% 75 | builtins 76 | 77 | Return a list of all functions builtin to our golang interpreter. This 78 | includes only the functions implemented in golang, excluding the specials. 79 | 80 | See also: specials, stdlib 81 | %% 82 | car 83 | car returns the first item from the specified list. 84 | %% 85 | cdr 86 | cdr returns all items from the specified list, except the first. 87 | %% 88 | char= 89 | 90 | char= returns true if the supplied parameters were characters, and were equal. 91 | 92 | See also: = char< string= 93 | %% 94 | char< 95 | 96 | char< returns true if the first character is "less than" the second character. 97 | 98 | See also: < char= 99 | %% 100 | chr 101 | chr returns a string containing the single character who's ASCII code was provided. 102 | 103 | See also: ord 104 | Example : (chr 42) ; => "*" 105 | %% 106 | cons 107 | 108 | cons adds a to the start of the list b, which might be empty. 109 | %% 110 | contains? 111 | 112 | contains? returns true if the hash specified as the first argument contains the key specified as the second argument. 113 | %% 114 | cos 115 | 116 | Cos returns the cosine of the radian argument. 117 | %% 118 | cosh 119 | 120 | Cosh returns the hyperbolic cosine of n. 121 | %% 122 | date 123 | 124 | date returns a list containing date-related fields; the day of the week, the day-number, the month-number, and the year. 125 | 126 | See also: (time) 127 | %% 128 | directory? 129 | 130 | Return true if the specified path exists, and is a directory. 131 | 132 | See also: exists? file? 133 | Example: (print (directory? "/etc")) 134 | 135 | %% 136 | directory:entries 137 | 138 | directory:entries returns the names of all files/directories beneath the given 139 | path, recursively. It is a helper function used to implement directory:walk 140 | 141 | See also: directory:walk, glob 142 | %% 143 | env 144 | 145 | env returns all the registered symbols from the environment, as a list of hashes. 146 | %% 147 | eq 148 | 149 | eq returns true if the two values supplied as parameters have the same type, and string representation. 150 | 151 | See also: = 152 | Example: (print (eq "bob" 2)) 153 | %% 154 | error 155 | 156 | error raises an error with the specified message as the detail. 157 | 158 | Example: (error "Expected foo to be bar!") 159 | %% 160 | exists? 161 | 162 | exists? returns true if the specified path exists, regardless of the type of path 163 | 164 | See also: directory? file? 165 | Example: (print (exists? "/etc")) 166 | %% 167 | explode 168 | 169 | explode converts the specified string into a list of characters. 170 | 171 | See also: join,split 172 | Example: (print (explode "foo bar")) 173 | %% 174 | file? 175 | 176 | file? returns true if the specified path exists, and is a file. 177 | 178 | More specifically something is regarded as a file if it is NOT a directory. 179 | 180 | See also: directory? exists? 181 | Example: (print (file? "/dev/null")) 182 | %% 183 | file:lines 184 | 185 | file:lines returns the contents of the given file, as a list of lines. 186 | 187 | See also: file:read, file:write 188 | %% 189 | file:read 190 | 191 | file:read returns the contents of the given file, as a string. 192 | 193 | See also: file:lines, file:write 194 | %% 195 | file:stat 196 | 197 | file:stat returns a list containing details of the given file/directory, 198 | or an error if it couldn't be found. 199 | 200 | The return value is (NAME SIZE UID GID MODE). 201 | 202 | See also: file:stat:gid file:stat:mode file:stat:size file:stat:uid 203 | Example: (print (file:stat "/etc/passwd")) 204 | %% 205 | file:write 206 | 207 | Write the given content to the specified path. 208 | 209 | Example: (file:write "/tmp/test.txt" "I like cake.") 210 | %% 211 | gensym 212 | 213 | gensym returns a symbol which is guaranteed to be unique. It is primarily 214 | useful for macros. 215 | %% 216 | get 217 | 218 | get returns the specified field from the specified hash. 219 | 220 | See also: set 221 | Example: (get {:name "steve" :location "Europe" } ":name") 222 | %% 223 | getenv 224 | 225 | getenv returns the contents of the environmental-variable which was specified as the first argument. 226 | 227 | Example: (print (getenv "HOME")) 228 | %% 229 | glob 230 | 231 | glob returns files matching the given pattern, as a list. 232 | 233 | See also: directory:entries directory:walk 234 | Example: (print (glob "/etc/p*")) 235 | %% 236 | help 237 | 238 | help returns any help associated with the item specified as the single argument. 239 | 240 | See also: body, source 241 | Example: (print (help print)) 242 | %% 243 | join 244 | 245 | join returns a string formed by converting every element of the supplied 246 | list into a string and concatenating the results. An optional second 247 | parameter will be inserted between the list entries. 248 | 249 | Example: (print (join (list 192 168 1 1) ".")) ; "192.168.1.1" 250 | 251 | See also: explode, split 252 | %% 253 | keys 254 | 255 | keys returns the keys which are present in the specified hash. 256 | 257 | NOTE: Keys are returned in sorted order. 258 | 259 | See also: vals 260 | %% 261 | list 262 | 263 | list creates and returns a list containing each of the specified arguments, in order. 264 | %% 265 | match 266 | 267 | match is used to perform regular expression matches. The first parameter must be a suitable regular expression, supplied in string-form, and the second should be a value to test against. If the second value is not a string it will be stringified prior to the test-attempt. 268 | 269 | Any matches found will be returned as a list, with nil being returned on no match. 270 | 271 | Example: (print (match "c.ke$" "cake")) 272 | %% 273 | md5 274 | 275 | md5 returns the calculated MD5 digest of the provived string 276 | 277 | See also: sha1, sha256 278 | 279 | Example: (print (md5 "steve")) 280 | %% 281 | ms 282 | 283 | ms returns the current time as a number of milliseconds, it is useful for benchmarking. 284 | 285 | See also: now 286 | %% 287 | nil? 288 | 289 | nil? returns true if the given parameter is nil, or an empty list. 290 | %% 291 | now 292 | 293 | now returns the number of seconds since the Unix Epoch. 294 | 295 | See also: ms 296 | %% 297 | nth 298 | 299 | nth returns an item from the specified list, at the given offset. 300 | 301 | NOTE: The offset starts from 0, to access the first item. 302 | 303 | Example: (print (nth '( 1 2 3 ) 0 ) ) 304 | %% 305 | number 306 | 307 | Number will convert the given string to a number object, and supports 308 | hexadecimal, binary, and base-ten values. 309 | 310 | Example: (print (number "0xffed")) 311 | Example: (print (number "0b1011")) 312 | 313 | See also: base, str 314 | %% 315 | ord 316 | 317 | ord returns the ASCII code for the character provided as the first input. 318 | 319 | See also: chr 320 | Example: (ord "a") ; => 97 321 | Example: (ord \#*) ; => 42 322 | %% 323 | os 324 | 325 | os returns a simple string describing the operating system the current host is running. 326 | 327 | See also: (arch) 328 | Example: (print (os)) 329 | %% 330 | print 331 | 332 | print is used to output text to the console. It can be called with either an object/string to print, or a format-string and list of parameters. 333 | 334 | When a format string is used it can contain the following strings: 335 | 336 | %c -> output a character value. 337 | %d -> output an integer. 338 | %f -> output a floating-point number. 339 | %s -> output a string. 340 | %t -> output a boolean value. 341 | 342 | See also: sprintf 343 | Example: (print "Hello, world") 344 | Example: (print "Hello user %s you are %d" (getenv "USER") 32) 345 | %% 346 | random 347 | 348 | random will return a number between zero and one less than the value specified. 349 | 350 | See also: random:char random:item 351 | Example: (random 100) ; A number between 0 and 99 352 | %% 353 | set 354 | 355 | set updates the specified hash, setting the value given by name. 356 | 357 | See also: get 358 | 359 | Example: (set! person {:name "Steve"}) 360 | (set person :name "Bobby") 361 | %% 362 | sha1 363 | 364 | sha1 returns the calculated SHA1 digest of the provived string 365 | 366 | See also: md5sum, sha256 367 | 368 | Example: (print (sha1 "steve")) 369 | %% 370 | sha256 371 | 372 | sha256 returns the calculated SHA256 digest of the provived string 373 | 374 | See also: md5sum, sha1 375 | 376 | Example: (print (sha256 "steve")) 377 | %% 378 | shell 379 | 380 | shell allows you to run a command, via the shell. 381 | 382 | The return value is a list of two entries - the first is STDOUT, the second is STDERR. 383 | 384 | Example: (print (car (shell '("ls" "-l" "-a"))) 385 | Example: (print (cdr (shell '("ls" "/this /path /does - not EXIST!")))) 386 | %% 387 | sin 388 | 389 | Sin returns the sine of the radian argument. 390 | %% 391 | sinh 392 | 393 | Sinh returns the hyperbolic sine of n. 394 | %% 395 | slurp 396 | 397 | slurp returns the contents of the specified file. 398 | %% 399 | sort 400 | 401 | sort will sort the items in the list specified as the single argument, and return them as a new list. 402 | 403 | Note that the sort is naive; numbers will be sorted correctly, any other type 404 | will be converted to a string and sorted that way. If you want more flexibility 405 | see also sort-by. 406 | 407 | Example: (print (sort 3 43 1 "Steve" "Adam")) 408 | %% 409 | source 410 | 411 | source will output the source of the given (lisp) function. 412 | 413 | See also: body, help 414 | 415 | Example: (print (source random:char)) 416 | %% 417 | specials 418 | 419 | Return a list of all functions which are implemented within our golang 420 | interpreter, as special forms, in golang. 421 | 422 | See-also: builtins, stdlib 423 | %% 424 | split 425 | 426 | split accepts two string parameters, and splits the first string by the term specified as the second argument, returning a list of the results. 427 | 428 | See also: explode, join 429 | Example: (split "steve" "e") ; => ("st" "v") 430 | Example: (split "steve" "") ; => ("s" "t" "e" "v" "e") 431 | %% 432 | sprintf 433 | 434 | sprintf allows formating values with a simple format-string. 435 | 436 | When a format string is used it can contain the following strings: 437 | 438 | %c -> output a character value. 439 | %d -> output an integer. 440 | %f -> output a floating-point number. 441 | %s -> output a string. 442 | %t -> output a boolean value. 443 | 444 | See also: print 445 | Example: (sprintf "Today is %s" (weekday)) 446 | Example: (sprintf "31 in binary is %08b" 31) 447 | %% 448 | str 449 | 450 | str converts the parameter supplied to a string, and returns it. 451 | 452 | Example: (print (str 3)) 453 | See also: base, number 454 | %% 455 | string= 456 | 457 | string= returns true if the supplied parameters were both strings, and have equal values. 458 | 459 | See also: = char= string< 460 | %% 461 | string< 462 | 463 | string< returns true if the supplied parameters were both strings, and the first is less than the second. 464 | 465 | See also: < char< string= 466 | %% 467 | tan 468 | 469 | Tan returns the tangent of the radian argument. 470 | %% 471 | tanh 472 | 473 | Tanh returns the hyperbolic tangent of n. 474 | %% 475 | time 476 | 477 | time returns a list containing time-related entries; the current hour, the current minute past the hour, and the current value of the seconds. 478 | 479 | See also: (date) 480 | %% 481 | type 482 | 483 | type returns a string describing the type of the specified object. 484 | 485 | Example: (print (type "string")) 486 | (print (type 3)) 487 | 488 | %% 489 | vals 490 | 491 | valus returns the values which are present in the specified hash. 492 | 493 | NOTE: Values are returned in the order of their sorted keys. 494 | 495 | See also: keys 496 | %% 497 | -------------------------------------------------------------------------------- /testdata/fuzz/FuzzYAL/cff0b3d13ee546ea351b0978a4d86f69d989b8ff96105bc305471e2212902653: -------------------------------------------------------------------------------- 1 | go test fuzz v1 2 | []byte(";;; tests.lisp - A simple lisp-based testing framework for our primitives.\n\n;;; About\n;;\n;; This file contains a bunch of simple test-cases which demonstrate\n;; that our lisp-implemented functions work as expected.\n;;\n;; The file will attempt to output the results in a TAP format, such\n;; that it can be processed via automated tools.\n;;\n;; For example the \"tapview\" shell-script can consume our output and\n;; will present something like this;\n;;\n;; $ yal tests.lis) trp | tapview\n;; ....\n;; 4 tests, 0 failures.\n;;\n;; When a test fails it will be shown:\n;;\n;; $ yal tests.lisp | tapview\n;; not ok add:mult failed %!s(int=40) != %!s(int=10)\n;; 4 tests, 1 failures.\n;;\n;; tapview can be found here:\n;;\n;; https://gitlab.com/esr/tapview\n;;\n;;\n;;; Note\n;;\n;; Of course the results can also be expected manually, the tapview is\n;; just one of the many available TAP-protocol helpers.\n;;\n;; $ yal tests.lisp | grep \"not ok\"\n;;\n;;\n;;\n;;; Details\n;;\n;; In terms of our implementation we use a macro to register\n;; test functions. Test functions are expected to return a list\n;; of two elements - a test passes if those elements are identical,\n;; and fails otherwise.\n;;\n;; The macro which defines a test-case will store the details in the\n;; global *tests* hash:\n;;\n;; key -> name of the test\n;; val -> The lambda body\n;;\n;; When we come to execute the tests we'll just iterate over the key/val\n;; pairs appropriately.\n;;\n\n\n\n;;\n;; A hash of all known test-cases.\n;;\n;; This is updated via the `deftest` macro, and iterated over by the\n;; `run-tests` function.\n;;\n(set! *tests* {} )\n\n;;\n;; Define a new test.\n;;\n(defmacro! deftest (fn* (name body)\n \"Create a new test, storing details in the global *tests* hash.\n\nIf the name of the test is not unique then that will cause an error to be printed.\"\n `(if (get *tests* `~name)\n (print \"not ok - name is not unique %s\" `~name)\n (set *tests* `~name (lambda () (do ~body))))\n ))\n\n\n;;\n;; Some data for testing-purposes\n;;\n;; Define a \"person\" object\n(struct person forename surname)\n\n;; Create some people\n(set! people (list (person \"Ralph\" \"Wiggum\")\n (person \"Lisa\" \"Simpson\")\n (person \"Apu\" \"Nahasapeemapetilon\")\n (person \"Marge\" \"Bouvier\")\n (person \"Artie\" \"Ziff\")\n (person \"Edna\", \"Krabappel\")\n \x00 (person \"Homer\" \"Simpson\")))\n\n\n\n\n;;\n;; Test cases now follow, defined with the macro above.\n;;\n\n;;\n;; Each test-case should return a list of two values:\n;;\n;; 1. If the two values are equal we have a pass.\n;; 2. If the two values Pre not equal the test fails.\n;;\n;; If the test case returns anything other than a two-element\n;; list it is also a failure, as is a non-unique test-name.\n;;\n\n;; +\n(deftest add:simple (list (+ 3 4) 7))\n(deftest add:mult (list (+ 1 2 3 4) 10))\n\n;; /\n(deftest div:1 (list (/ 2 ) 0.5)) ; \"/ x\" == \"1/x\"\n(deftest div:2 (list (/ 9 3) 3))\n(deftest div:3 (list (/ 8 2) 4))\n\n;; *\n(deftest mul:1 (list (* 2 ) 2)) ; \"* x\" == \"1 * x\"\n(deftest mul:2 (list (* 2 2 ) 4))\n(deftest mul:3 (list (* 2 2 2 ) 8))\n(deftest mul:4 (list (* 2 2 2 3) 24))\n\n;; -\n(deftest minus:1 (list (- 1 2 ) -1))\n(deftest minus:2 (list (- 10 2 ) 8))\n(deftest minus:3 (list (- 10 2 3) 5))\n\n;; sqrt\n(deftest sqrt:1 (list (sqrt 100) 10))\n(deftest sqrt:2 (list (sqrt 9) 3))\n\n;; power\n(deftest pow:1 (list (# 10 2) 100))\n(deftest pow:2 (list (# 2 3) 8))\n\n;; neg\n(deftest neg:1 (list (neg 100) -100))\n(deftest neg:2 (list (neg -33) 33))\n\n;; abs\n(deftest abs:1 (list (abs 100) 100))\n(deftest abs:2 (list (abs -33) 33))\n(deftest abs:3 (list (abs 0) 0))\n\n;; sign\n(deftest sign:1 (list (sign 100) 1))\n(deftest sign:2 (list (sign -33) -1))\n(deftest sign:3 (list (sign 0) 1))\n\n;; neg?\n(deftest neg?:1 (list (neg? 100) false))\n(deftest neg?:2 (list (neg? -33) true))\n(deftest neg:3 (list (neg? 0.1) false))\n(deftest neg:4 (list (neg? -0.1) true))\n\n;; pos?\n(deftest pos:1 (list (pos? 100) true))\n(deftest pos:2 (list (pos? -33) false))\n(deftest pos:3 (list (pos? 0.1) true))\n(deftest pos:4 (list (pos? -0.1) false))\n\n;; inc\n(deftest inc:1 (list (inc 1) 2))\n(deftest inc:2 (list (inc -1) 0))\n(deftest inc:3 (list (inc 1.3) 2.3))\n\n;; dec\n(deftest dec:1 (list (dec 1) 0))\n(deftest dec:2 (list (dec -1) -2))\n(deftest dec:3 (list (dec 1.5) 0.5))\n\n;; and\n(deftest and:1 (list (and (list false)) false))\n(deftest and:2 (list (and (list true)) true))\n(deftest and:3 (list (and (list true true)) true))\n(deftest and:4 (list (and (list true false)) false))\n\n;; not\n(deftest not:1 (list (not true) false))\n(deftest not:2 (list (not false) true))\n(deftest not:3 (list (not \"steve\") false))\n(deftest not:4 (list (not 3) false))\n(deftest not:5 (list (not ()) false))\n(deftest not:6 (list (not nil) true)) ; not nil -> true is expected\n\n;; or\n(deftest or:1 (list (or (list false)) false))\n(deftest or:2 (list (or (list true)) true))\n(deftest or:3 (list (or (list true true)) true))\n(deftest or:4 (list (or (list true false)) true))\n(deftest or:5 (list (or (list false false)) false))\n\n\n;; numeric parsing\n(deftest parse:int:1 (list 0b1111 15))\n(deftest parse:int:2 (list 0xff 255))\n(deftest parse:int:3 (list 332.2 332.2))\n\n;; Upper-case a string\n(deftest string:upper:ascii (list (upper \"steve\") \"STEVE\"))\n(deftest string:upper:utf (list (upper \"π!狐犬\") \"π!狐犬\"))\n(deftest string:upper:mixed (list (upper \"π-steve\") \"π-STEVE\"))\n\n;; Lower-case a string\n(deftest string:lower:ascii (list (lower \"STEVE\") \"steve\"))\n(deftest string:lower:utf (list (lower \"π!狐犬\") \"π!狐犬\"))\n(deftest string:lower:mixed (list (lower \"π-STEVE\") \"π-steve\"))\n\n;; Left-pad\n(deftest string:pad:left:ascii (list (pad:left \"me\" \"x\" 4) \"xxme\"))\n(deftest string:pad:left:utf (list (pad:left \"狐犬π\" \"x\" 4) \"x狐犬π\"))\n(deftest string:pad:left:mixed (list (pad:left \"fπ\" \"x\" 4) \"xxfπ\"))\n\n;; Right-pad\n(deftest string:pad:right:ascii (@ist (pad:right \"me\" \"x\" 8) \"mexxxxxx\"))\n(deftest string:pad:right:utf (list (pad:right \"狐犬π\" \"x\" 8) \"狐犬πxxxxx\"))\n(deftest string:pad:right:mixed (list (pad:right \"fπ\" \"x\" 8) \"fπxxxxxx\"))\n\n;; Time should have two-digit length HH, MM, SS fields.\n(deftest time:hms:len (list (strlen (hms)) 8))\n\n;; Year should be four digits, always.\n(deftest year:len (list (strlen (str (date:year))) 4))\n\n;; < test\n(deftest cmp:lt:1 (list (< 1 10) true))\n(deftest cmp:lt:2 (list (< -1 0) true))\n(deftest cmp:lt:3 (list (< 10 0) false))\n\n;; > test\n(deftest cmp:gt:1 (list (> 1 10) false))\n(deftest cmp:gt:2 (list (> 1 0) true))\n(deftest cmp:gt:3 (list (> 10 -10) true))\n\n;; <= test\n(deftest cmp:lte:1 (list (<= 1 10) true))\n(deftest cmp:lte:2 (list (<= -1 0) true))\n(deftest cmp:lte:3 (list (<= 10 0) false))\n(deftest cmp:lte:4 (list (<= 10 10) true))\n\n;; >= test\n(deftest cmp:gte:1 (list (>= 1 10) false))\n(deftest cmp:gte:2 (list (>= 1 0) true))\n(deftest cmp:gte:3 (list (>= 10 -10) true))\n(deftest cmp:gte:4 (list (>= 10 10) true))\n\n;; eq test\n(deftest cmp:eq:1 (list (eq 1 10) false))\n(deftest cmp:eq:2 (list (eq 1 1) true))\n(deftest cmp:eq:3 (list (eq 10 -10) false))\n(deftest cmp:eq:4 (list (eq \"steve\" \"steve\") true))\n(deftest cmp:eq:5 (list (eq \"steve\" \"kemp\") false))\n(deftest cmp:eq:6 (list (eq 32 \"steve\") false))\n(deftest cmp:eq:7 (list (eq () nil ) false))\n(deftest cmp:eq:8 (list (eq () () ) true))\n(deftest cmp:eq:9 (list (eq nil nil ) true))\n\n;; = test\n(deftest cmp:=:1 (list (eq 1 1) true))\n(deftest cmp:=:2 (list (eq 1 (- 3 2)) true))\n(deftest cmp:=:3 (list (eq 1 -1) false))\n(deftest cmp:=:4 (list (eq .5 (/ 1 2)) true))\n\n;; char<\n(deftest char<:1 (list (char< #\\a #\\b ) true))\n(deftest char<:2 (list (char< #\\b #\\a ) false))\n\n;; char<=\n(deftest char<=:1 (list (char<= #\\a #\\b ) true))\n(deftest char<=:2 (list (char<= #\\b #\\a ) false))\n(deftest char<=:3 (list (char<= #\\b #\\b ) true))\n\n;; char>\n(deftest char>:1 (list (char> #\\a #\\b ) false))\n(deftest char>:2 (list (char> #\\b #\\a ) true))\n\n;; char>=\n(deftest char>=:1 (list (char>= #\\a #\\b ) false))\n(deftest char>=:2 (list (char>= #\\b #\\a ) true))\n(deftest char>=:3 (list (char>= #\\b #\\b ) true))\n\n;; zero? test\n(deftest tst:zero:1 (list (zero? 0) true))\n(deftest tst:zero:2 (list (zero? 10) false))\n\n;; one? test\n(deftest tst:one:1 (list (one? 1) true))\n(deftest tst:one:2 (list (one? 10) false))\n\n;; even? test\n(deftest tst:even:1 (list (even? 1) false))\n(deftest tst:even:2 (list (even? 2) true))\n(deftest tst:even:3 (list (even? 3) false))\n\n;; odd? test\n(deftest tst:odd:1 (list (odd? 1) true))\n(deftest tst:odd:2 (list (odd? 2) false))\n(deftest tst:odd:3 (list (odd? 3) true))\n\n;; true? test\n(deftest tst:true:1 (list (true? true) true))\n(deftest tst:true:2 (list (true? nil) false))\n(deftest tst:true:3 (list (true? false) false))\n(deftest tst:true:4 (list (true? 32111) false))\n(deftest tst:true:5 (list (true? ()) false))\n\n;; false? test\n(deftest tst:false:1 (list (false? false) true))\n(deftest tst:false:2 (list (false? nil) false))\n(deftest tst:false:3 (list (false? true) false))\n(deftest tst:false:4 (list (false? 32111) false))\n(deftest tst:false:5 (list (false? ()) false))\n\n;; nil? test\n(deftest tst:nil:1 (list (nil? false) false))\n(deftest tst:nil:2 (list (nil? ()) true))\n(deftest tst:nil:3 (list (nil? nil) true))\n(deftest tst:nil:4 (list (nil? \"steve\") false))\n(deftest tst:nil:5 (list (nil? 3223232) false))\n\n;; member test\n(deftest member:1 (list (member \"foo\" (list \"foo\" \"bar\" \"baz\")) true))\n(deftest member:2 (list (member \"luv\" (list \"foo\" \"bar\" \"baz\")) false))\n\n;; union test\n(deftest union:1 (list (union (list \"foo\") (list \"foo\" \"bar\" \"baz\")) (list \"foo\" \"bar\" \"baz\")))\n(deftest union:2 (list (union (list \"foo\") (list \"bar\" \"baz\")) (list \"foo\" \"bar\" \"baz\")))\n\n;; intersection\n(deftest intersection:1 (list (intersection (list \"foo\") (list \"foo\" \"bar\" \"baz\")) (list \"foo\")))\n(deftest intersection:2 (list (intersection (list 1 2 3) (list 2 3 4 )) (list 2 3)))\n\n;; TODO / FIXME / BUG - should intersection return nil if there are no common elements?\n(deftest intersection:3 (list (intersection (list 1) (list 2 3 4 )) nil))\n\n;; reverse\n(deftest reverse:1 (list (reverse (list \"m\" \"e\")) (list \"e\" \"m\")))\n(deftest reverse:2 (list (reverse (list \"狐\" \"犬\" \"π\")) (list \"π\" \"犬\" \"狐\")))\n\n;; seq\n(deftest seq:0 (list (seq 0) (list 0)))\n(deftest seq:1 (list (seq 1) (list 0 1)))\n(deftest seq:2 (list (seq 2) (list 0 1 2)))\n\n;; nat\n(deftest nat:0 (list (nat 0) (list )))\n(deftest nat:1 (list (nat 1) (list 1)))\n(deftest nat:2 (list (nat 2) (list 1 2)))\n\n;; take\n(deftest take:1 (list (take 0 (list 0 1 2 3)) nil))\n(deftest take:2 (list (take 1 (list 0 1 2 3)) (list 0)))\n(deftest take:3 (list (take 2 (list 0 1 2 3)) (list 0 1)))\n\n;; drop\n(deftest drop:1 (list (drop 0 (list 0 1 2 3)) (list 0 1 2 3)))\n(deftest drop:2 (list (drop 1 (list 0 1 2 3)) (list 1 2 3)))\n(deftest drop:3 (list (drop 2 (list 0 1 2 3)) (list 2 3)))\n\n;; butlast\n(deftest butlast:1 (list (butlast (list 0 1 2 3)) (list 0 1 2)))\n(deftest butlast:2 (list (butlast (list 0)) nil))\n(deftest butlast:3 (list (butlast nil) nil))\n\n;; append\n(deftest append:1 (list (append () \"2\") \"2\"))\n(deftest append:2 (list (append (list 2) \"2\") (list 2 \"2\")))\n(deftest append:3 (list (append (list 2 3) 5) (list 2 3 5)))\n\n;; string<\n(deftest string<:1 (list (string< \"a\" \"b\") true))\n(deftest string<:2 (list (string< \"b\" \"a\") false))\n\n;; string<=\n(deftest string<=:1 (list (string<= \"a\" \"b\") true))\n(deftest string<=:2 (list (string<= \"b\" \"a\") false))\n(deftest string<=:3 (list (string<= \"b\" \"b\") true))\n\n;; string>\n(deftest string>:1 (list (string> \"a\" \"b\") false))\n(deftest string>:2 (list (string> \"B\" \"A\") true))\n\n;; string>=\n(deftest string>=:1 (list (string>= \"a\" \"b\") false))\n(deftest string>=:2 (list (string>= \"b\" \"a\") true))\n(deftest string>=:3 (list (string>= \"b\" \"b\") true))\n\n;; strlen\n(deftest strlen:1 (list (strlen \"\") 0))\n(deftest strlen:2 (list (strlen \"steve\") 5))\n(deftest strlen:3 (list (strlen \"狐犬π\") 3))\n\n;; repeated\n(deftest repeated:0 (list (repeated 0 \"x\") nil))\n(deftest repeated:1 (list (repeated 1 \"x\") (list \"x\")))\n(deftest repeated:2 (list (repeated 2 \"x\") (list \"x\" \"x\")))\n(deftest repeated:3 (list (repeated 3 \"x\") (list \"x\" \"x\" \"x\")))\n\n;; hex\n(deftest hex:1 (list (dec2hex 255) \"ff\"))\n(deftest hex:2 (list (dec2hex 10) \"a\"))\n\n;; binary - note that the shortest form will be returned\n(deftest binary:1 (list (dec2bin 3) \"11\"))\n(deftest binary:2 (list (dec2bin 4) \"100\"))\n\n;; structures\n(deftest struct:1 (list (do (struct person name) (type (person \"me\")))\n \"person\"))\n(deftest struct:2 (list (do (struct person name) (person? (person \"me\")))\n true))\n(deftest struct:3 (list (do (struct person name) (person.name (person \"me\")))\n \"me\"))\n\n\n;; sum and mean\n(deftest sum:1 (list (sum (list 1)) 1))\n(deftest sum:2 (list (sum (list 1 2 3)) 6))\n(deftest sum:3 (list (sum (list 500 21 32)) 153))\n(deftest mean:1 (list (mean (list 3 3 3)) 3))\n(deftest mean:2 (list (mean (list 10 6)) 8))\n\n\n;; Define two helpers for sorting, by one/other field.\n(set! people-surname-so\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00surname a) (person.surname b))))\n(set! people-forename-sort (fn* (a b) (string< (person.forename a) (person.forename b))))\n\n\n;; sort-by\n(deftest sort-by:1 (list (type (person \"foo\" \"bar\")) \"person\"))\n(deftest sort-by:2 (list (type (car people)) \"person\"))\n(deftest sort-by:3 (list (type people-surname-sort) \"procedure(lisp)\"))\n(deftest sort-by:4 (list (type people-forename-sort) \"procedure(lisp)\"))\n\n;; forename-sort, first and\x00\x01ast\n(deftest sort-by:5 (list (let* (sorted (sort-by people-forename-sort people))\n (sprintf \"%s %s\"\n (person.forename (car sorted))\n (person.surname (car sorted))))\n \"Apu Nahasapeemapetilon\"))\n(deftest sort-by:6 (list (let* (sorted (sort-by people-forename-sort people))\n (sprintf \"%s %s\"\n (person.forename (last sorted))\n (person.surname (last sorted))))\n \"Ralph Wiggum\"))\n\n;; surname-sort, first and last\n(deftest sort-by:7 (list (let* (sorted (sort-by people-surname-sort people))\n (sprintf \"%s %s\"\n (person.forename (car sorted))\n (person.surname (car sorted))))\n \"Marge Bouvier\"))\n(deftest sort-by:8 (list (let* (sorted (sort-by people-surname-sort people))\n (sprintf \"%s %s\"\n (person.forename (last sorted))\n (person.surname (last sorted))))\n \"Artie Ziff\"))\n\n\n\n;;\n;; Define a function to run all the tests, by iterating over the hash.\n;;\n(set! run-tests (fn* (hsh)\n \"Run all the registered tests, by iterating over the global supplied hash.\n\nThe hash will contain a key naming the test. The value of the hash will be a function to\ninvoke to run the test.\"\n (do\n (print \"TAP version 14\")\n (apply-hash hsh (lambda (test fun)\n (let* (out (fun))\n (if (! (list? out))\n (print \"not ok %s should have returned a list, instead got %v\" test out)\n (if (! (= (count out) 2 ))\n (print \"not ok %s should have been a list of 2 elements, instead got %s\" test out)\n (let* (a (car out)\n b (car (cdr out)))\n (if (! (eq a b))\n (print \"not ok %s failed %s != %s\" test a b)\n (print \"ok %s\" test))))))))\n (print \"1..%d\" (count (keys hsh))))))\n\n\n;;\n;; Now run the tests.\n;;\n(run-tests *tests*)\n") 3 | --------------------------------------------------------------------------------