├── benchmark ├── hello │ ├── berry.be │ ├── lua.lua │ ├── ruby.rby │ ├── janet.jnt │ ├── julia.jl │ ├── kuroko.krk │ ├── perl.pl │ ├── python.py │ ├── emacs-lisp.el │ ├── main.zuo │ ├── php.php │ ├── picolisp.l │ ├── common.lisp │ ├── scheme.scm │ ├── newlisp.newlisp │ ├── nujel.nuj │ ├── racket.rkt │ ├── erlang.erl │ ├── dart.dart │ ├── README.md │ └── javascript.js ├── for │ ├── forth.fs │ ├── php.php │ ├── kuroko.krk │ ├── ruby.rby │ ├── main.zuo │ ├── picolisp.l │ ├── scheme.scm │ ├── janet.jnt │ ├── newlisp.newlisp │ ├── berry.be │ ├── python.py │ ├── julia.jl │ ├── perl.pl │ ├── racket.rkt │ ├── common.lisp │ ├── nujel.nuj │ ├── dart.dart │ ├── c.c │ ├── lua.lua │ ├── emacs-lisp.el │ ├── erlang.erl │ ├── javascript.js │ └── README.md ├── euler4 │ ├── erlang.beam │ ├── python.py │ ├── kuroko.krk │ ├── php.php │ ├── berry.be │ ├── picolisp.l │ ├── racket.rkt │ ├── c.c │ ├── newlisp.newlisp │ ├── ruby.rby │ ├── julia.jl │ ├── main.zuo │ ├── nujel.nuj │ ├── perl.pl │ ├── janet.jnt │ ├── dart.dart │ ├── scheme.scm │ ├── erlang.erl │ ├── javascript.js │ ├── lua.lua │ ├── emacs-lisp.el │ └── common.lisp ├── md5 │ └── md5.nuj ├── crc32 │ └── crc32.nuj ├── adler32 │ ├── adler32.nuj │ ├── adler32.py │ ├── adler32.lua │ ├── adler32.lisp │ └── adler32.c ├── euler1 │ ├── kuroko.krk │ ├── ruby.rby │ ├── janet.jnt │ ├── python.py │ ├── berry.be │ ├── php.php │ ├── perl.pl │ ├── julia.jl │ ├── picolisp.l │ ├── c.c │ ├── common.lisp │ ├── newlisp.newlisp │ ├── lua.lua │ ├── emacs-lisp.el │ ├── main.zuo │ ├── scheme.scm │ ├── dart.dart │ ├── racket.rkt │ ├── nujel.nuj │ ├── erlang.erl │ └── javascript.js ├── recfib │ ├── fib.scm │ └── fib.nuj └── compile-stdlib │ └── compile-stdlib.nuj ├── tests ├── reader │ ├── keywords.nuj │ ├── symbols.nuj │ ├── lists.nuj │ ├── booleans.nuj │ └── comments.nuj ├── fast │ ├── funcall.nuj │ ├── reader.nuj │ ├── image0.nuj │ ├── image1.nuj │ ├── list-sort.nuj │ ├── digest.nuj │ ├── list-slow-sort.nuj │ ├── day6.dat │ ├── euler001.nuj │ ├── euler002.nuj │ ├── ports.nuj │ ├── day6.nuj │ ├── word-count.nuj │ ├── day1.nuj │ ├── long-literal-test.nuj │ ├── day14.dat │ ├── day2.nuj │ ├── day3.nuj │ ├── day10.nuj │ ├── day14.nuj │ └── day3-2.nuj ├── bmp.nuj ├── slow │ ├── day11.dat │ ├── day12.input │ ├── euler004.nuj │ ├── day17.nuj │ ├── euler003.nuj │ ├── day16.dat │ ├── day5.2.nuj │ ├── day7.nuj │ ├── day5.nuj │ ├── day12.nuj │ ├── day9.nuj │ ├── day11.nuj │ └── day13.nuj ├── trace.nuj ├── testsuite │ ├── dispatch.nuj │ ├── ports.nuj │ ├── compiler.nuj │ ├── path.nuj │ ├── keyword.nuj │ ├── module.nuj │ ├── generic.nuj │ ├── objects.nuj │ ├── type-errors.nuj │ ├── standalone.nuj │ ├── string.nuj │ ├── casting.nuj │ ├── exception.nuj │ ├── image.nuj │ ├── arithmetic.nuj │ ├── language.nuj │ ├── reader.nuj │ ├── arrays.nuj │ └── bytecode.nuj └── clock.nuj ├── mk ├── nmake.mk ├── amalgamation │ ├── implementation-suffix.h │ ├── suffix.h │ ├── implementation-prefix.h │ ├── bin-prefix.h │ └── prefix.h ├── ansi_colors.mk ├── common.mk └── disable_implicit_rules.mk ├── web ├── favicon.png └── report.css ├── test-files └── r5rs.pdf ├── configure ├── .builds ├── arch.yml ├── alpine.yml ├── arch_tcc.yml ├── guix.yml ├── rocky.yml ├── debian_arm.yml ├── netbsd.yml ├── freebsd.yml └── openbsd.yml ├── tools ├── sloc ├── sloc-by-file ├── benchmark-aggregate.nuj ├── benchmark-sync.nuj ├── buildwasm-filesystem.nuj ├── build-image.nuj └── c-asset-packer.nuj ├── stdlib_modules ├── test.nuj ├── net.nuj ├── help.nuj ├── crypto │ └── adler32.nuj ├── games │ └── guess.nuj ├── random.nuj ├── array │ └── 2d.nuj ├── app │ └── EventLog.nuj ├── serialization │ └── json.nuj ├── repl.nuj └── net │ ├── gopher.nuj │ └── http.nuj ├── GNUmakefile ├── .gitattributes ├── docs ├── README.md ├── stable │ ├── 1.5-symbols-keywords.md │ ├── 1.8-functions.md │ ├── 1.7-quote-quasiquote.md │ ├── 1.6-variables.md │ ├── 1.1-parentheses.md │ ├── 1.4-arithmetic.md │ ├── 1.0-setup.md │ ├── README.md │ ├── 1.3-numbers.md │ └── 1.2-comments.md └── unstable │ └── modules.md ├── stdlib ├── core │ ├── classes.nuj │ ├── opcodes.nuj │ └── quasiquote.nuj ├── math │ └── math.nuj ├── compiler │ ├── backend.nuj │ └── frontend │ │ └── constant_folding.nuj ├── string │ ├── char.nuj │ └── path.nuj ├── bitmanip.nuj └── collections │ ├── collection_primitives.nuj │ ├── tree.nuj │ └── collection.nuj ├── bin ├── private.h ├── environment.c ├── misc.c ├── main.c └── net.c ├── Makefile ├── .gitignore ├── LICENSE ├── Nujel.sln ├── binlib └── tiny-repl.nuj └── lib ├── allocator.c ├── array.c └── val.c /benchmark/hello/berry.be: -------------------------------------------------------------------------------- 1 | print("Hello") -------------------------------------------------------------------------------- /benchmark/hello/lua.lua: -------------------------------------------------------------------------------- 1 | print("Hello") -------------------------------------------------------------------------------- /benchmark/hello/ruby.rby: -------------------------------------------------------------------------------- 1 | puts "Hello" -------------------------------------------------------------------------------- /tests/reader/keywords.nuj: -------------------------------------------------------------------------------- 1 | :a :s :d 2 | -------------------------------------------------------------------------------- /tests/reader/symbols.nuj: -------------------------------------------------------------------------------- 1 | asd qwe 2 | -------------------------------------------------------------------------------- /benchmark/hello/janet.jnt: -------------------------------------------------------------------------------- 1 | (print "Hello") -------------------------------------------------------------------------------- /benchmark/hello/julia.jl: -------------------------------------------------------------------------------- 1 | print("Hello") 2 | -------------------------------------------------------------------------------- /benchmark/hello/kuroko.krk: -------------------------------------------------------------------------------- 1 | print('Hello') -------------------------------------------------------------------------------- /benchmark/hello/perl.pl: -------------------------------------------------------------------------------- 1 | print "Hello" 2 | -------------------------------------------------------------------------------- /mk/nmake.mk: -------------------------------------------------------------------------------- 1 | # No NMake support (yet) 2 | -------------------------------------------------------------------------------- /benchmark/hello/python.py: -------------------------------------------------------------------------------- 1 | print("Hello") 2 | -------------------------------------------------------------------------------- /benchmark/hello/emacs-lisp.el: -------------------------------------------------------------------------------- 1 | (print "Hello") 2 | -------------------------------------------------------------------------------- /benchmark/hello/main.zuo: -------------------------------------------------------------------------------- 1 | #lang zuo 2 | 3 | (alert "Hello") -------------------------------------------------------------------------------- /benchmark/hello/php.php: -------------------------------------------------------------------------------- 1 | 4 | io:format("Hello"). -------------------------------------------------------------------------------- /configure: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | echo "No need for configure, just type `make` and you are good to go!" 3 | -------------------------------------------------------------------------------- /benchmark/euler4/erlang.beam: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Melchizedek6809/Nujel/HEAD/benchmark/euler4/erlang.beam -------------------------------------------------------------------------------- /mk/amalgamation/implementation-prefix.h: -------------------------------------------------------------------------------- 1 | /* Start of Nujel implementation */ 2 | #ifdef NUJEL_IMPLEMENTATION 3 | -------------------------------------------------------------------------------- /benchmark/hello/dart.dart: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env dart 2 | import 'dart:io'; 3 | 4 | void main(){ 5 | print('Hello'); 6 | } -------------------------------------------------------------------------------- /benchmark/hello/README.md: -------------------------------------------------------------------------------- 1 | This benchmark mostly tests runtime startup delay, since the actual preocessing done is miniscule. 2 | -------------------------------------------------------------------------------- /tests/bmp.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | (image/save! (image/test) "test.bmp") 3 | 4 | (defn min-tmp (a b) (if (< a b) a b)) 5 | -------------------------------------------------------------------------------- /benchmark/md5/md5.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | (import hash :crypto/md5) 3 | 4 | (println (hash (slurp "test-files/r5rs.pdf"))) 5 | -------------------------------------------------------------------------------- /benchmark/for/php.php: -------------------------------------------------------------------------------- 1 | = i 10000000) ret) 5 | (else (test-run (+ 1 i) (+ ret i))))) 6 | 7 | (alert (test-run 0 0)) 8 | -------------------------------------------------------------------------------- /benchmark/for/picolisp.l: -------------------------------------------------------------------------------- 1 | (de bench-run () 2 | (let ret 0 3 | (for i (- 10000000 1) (setq ret (+ ret i))) 4 | ret)) 5 | (prinl "The result is: " (bench-run)) 6 | (bye) 7 | -------------------------------------------------------------------------------- /benchmark/for/scheme.scm: -------------------------------------------------------------------------------- 1 | (define (test-run) 2 | (do ([i 0 (+ i 1)] 3 | [ret 0 (+ ret i)]) 4 | ((>= i 10000000) ret))) 5 | 6 | (display (test-run)) 7 | (newline) 8 | -------------------------------------------------------------------------------- /benchmark/euler1/kuroko.krk: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env kuroko 2 | let ret = 0 3 | for i in range(10000000): 4 | if (((i % 3) == 0) or ((i % 5) == 0)): 5 | ret = ret + i 6 | print('The sum is: ', ret) 7 | -------------------------------------------------------------------------------- /benchmark/for/janet.jnt: -------------------------------------------------------------------------------- 1 | (defn testRun [] 2 | (var ret 0) 3 | (var i 0) 4 | (while (< i 10000000) 5 | (+= ret i) 6 | (++ i)) 7 | ret) 8 | 9 | (print (testRun)) 10 | -------------------------------------------------------------------------------- /benchmark/for/newlisp.newlisp: -------------------------------------------------------------------------------- 1 | (define (test-run i ret) 2 | (while (< i 10000000) 3 | (set 'ret (+ i ret)) 4 | (inc i)) 5 | ret) 6 | (print (test-run 0 0)) 7 | (print "\n") 8 | (exit) 9 | -------------------------------------------------------------------------------- /benchmark/for/berry.be: -------------------------------------------------------------------------------- 1 | def testRun() 2 | var ret = 0 3 | for i: 0 .. (10000000-1) 4 | ret += i 5 | end 6 | print("The result is: " .. ret) 7 | end 8 | 9 | testRun() 10 | -------------------------------------------------------------------------------- /benchmark/for/python.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | def testCalc(): 3 | ret = 0 4 | for i in range(10000000): 5 | ret = ret + i 6 | return ret 7 | 8 | print('The result is: ', testCalc()) 9 | -------------------------------------------------------------------------------- /benchmark/euler1/ruby.rby: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | ret = 0 4 | for i in 0..(10000000-1) do 5 | if ((i % 3) == 0) || ((i % 5) == 0) then 6 | ret = ret + i 7 | end 8 | end 9 | puts "The sum is: #{ret}" -------------------------------------------------------------------------------- /benchmark/for/julia.jl: -------------------------------------------------------------------------------- 1 | function testCalc() 2 | ret = 0 3 | for i in 1:(10000000-1) 4 | ret = ret + i 5 | end 6 | return ret 7 | end 8 | print(string("This results in: ", testCalc())) 9 | -------------------------------------------------------------------------------- /benchmark/for/perl.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use warnings; 3 | use strict; 4 | 5 | my $ret = 0; 6 | for(my $i = 0; $i< 10000000; $i++){ 7 | $ret = $ret + $i; 8 | } 9 | print "This results in $ret"; 10 | -------------------------------------------------------------------------------- /benchmark/for/racket.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (define (test-run) 4 | (do ([i 0 (+ 1 i)] 5 | [ret 0 (+ ret i)]) 6 | ((>= i 10000000) ret))) 7 | 8 | (display (test-run)) 9 | (newline) 10 | -------------------------------------------------------------------------------- /benchmark/for/common.lisp: -------------------------------------------------------------------------------- 1 | (defun test () 2 | (let ((ret 0)) 3 | (dotimes (i 10000000) 4 | (incf ret i)) 5 | ret)) 6 | 7 | (compile 'test) 8 | (format T "THE RESULT IS ~a~%" (test)) 9 | (quit) 10 | -------------------------------------------------------------------------------- /benchmark/for/nujel.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (defn bench-run () 4 | (def ret 0) 5 | (dotimes (i 10,000,000 ret) 6 | (set! ret (+ ret i)))) 7 | 8 | (pfmtln "The result is: {}" (bench-run)) 9 | -------------------------------------------------------------------------------- /tests/trace.nuj: -------------------------------------------------------------------------------- 1 | (defn third-one (c) 2 | (ref #nil 123)) 3 | 4 | (defn second-one (b c) 5 | (third-one c)) 6 | 7 | (defn first-one (a b c) 8 | (second-one b c)) 9 | 10 | (first-one :a 2 "c") 11 | -------------------------------------------------------------------------------- /benchmark/hello/javascript.js: -------------------------------------------------------------------------------- 1 | "use strict"; 2 | 3 | try{ 4 | var consoleLog = print ? print : console.log; 5 | }catch(e){ 6 | var consoleLog = console.log; 7 | } // mujs workaround 8 | 9 | consoleLog("Hello"); 10 | -------------------------------------------------------------------------------- /benchmark/recfib/fib.scm: -------------------------------------------------------------------------------- 1 | (define (fib n) 2 | (cond ((= 0 n) 0) 3 | ((= 1 n) 1) 4 | (#t (+ (fib (- n 1)) (fib (- n 2)))))) 5 | 6 | (display "fib(40) = ") 7 | (display (fib 40)) 8 | (display "\n") 9 | -------------------------------------------------------------------------------- /mk/amalgamation/bin-prefix.h: -------------------------------------------------------------------------------- 1 | /* 2 | | Nujel runtime amalgamation, just compile away! 3 | | Everything should be contained, you might need to link the math library in 4 | | with `-lm`. 5 | */ 6 | #define NUJEL_IMPLEMENTATION 7 | -------------------------------------------------------------------------------- /.builds/arch.yml: -------------------------------------------------------------------------------- 1 | image: archlinux 2 | sources: 3 | - https://git.sr.ht/~melchizedek6809/Nujel 4 | tasks: 5 | - compile-runtime: | 6 | cd Nujel 7 | make nujel 8 | - test: | 9 | cd Nujel 10 | make test 11 | -------------------------------------------------------------------------------- /benchmark/for/dart.dart: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env dart 2 | import 'dart:io'; 3 | 4 | void main(){ 5 | var ret = 0; 6 | for(var i=0;i<10000000;i++){ 7 | ret += i; 8 | } 9 | print('The result is: ${ret}'); 10 | } -------------------------------------------------------------------------------- /tools/sloc: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | cd "$(dirname "$0")" 3 | cd ../ 4 | 5 | scc --count-as "nuj:Scheme" --exclude-dir="vendor,bootstrap,web,releases,.builds,.github,tools,.gitignore,benchmark,configure,tests,testsuite" -i nuj,c,h,asm,s,mk 6 | -------------------------------------------------------------------------------- /benchmark/for/c.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | int main(int argc, char *argv[]){ 4 | long long int ret = 0; 5 | for(int i=0;i<10000000;i++){ 6 | ret += i; 7 | } 8 | printf("This results in: %lli\n", ret); 9 | return 0; 10 | } 11 | -------------------------------------------------------------------------------- /benchmark/for/lua.lua: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env lua 2 | local function bench () 3 | local ret = 0 4 | for i = 1,(10000000-1) 5 | do 6 | ret = ret + i 7 | end 8 | return ret 9 | end 10 | 11 | print("The result is ", bench()) 12 | -------------------------------------------------------------------------------- /benchmark/for/emacs-lisp.el: -------------------------------------------------------------------------------- 1 | (require 'cl-lib) 2 | (defun test () 3 | (let ((ret 0)) 4 | (dotimes (i 10000000) 5 | (cl-incf ret i)) 6 | ret)) 7 | (byte-compile 'test) 8 | 9 | (princ (format "THE RESULT IS %d\n" (test))) 10 | -------------------------------------------------------------------------------- /benchmark/for/erlang.erl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env escript 2 | -mode(compile). 3 | 4 | forLoop(Ret,0) -> Ret; 5 | forLoop(Ret,I) -> forLoop(Ret + I, I - 1). 6 | 7 | main([]) -> 8 | io:format("The result is: ~w~n",[forLoop(0,10000000-1)]), 9 | 0. 10 | -------------------------------------------------------------------------------- /benchmark/euler1/janet.jnt: -------------------------------------------------------------------------------- 1 | (defn test-run [] 2 | (var ret 0) 3 | (loop [i :range [0 10000000] 4 | :when (or (= 0 (% i 3)) 5 | (= 0 (% i 5)))] 6 | (+= ret i)) 7 | ret) 8 | 9 | (print "The sum is: " (test-run)) 10 | -------------------------------------------------------------------------------- /benchmark/euler1/python.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | def testCalc(): 3 | ret = 0 4 | for i in range(10000000): 5 | if ((i % 3) == 0) or ((i % 5) == 0): 6 | ret = ret + i 7 | return ret 8 | 9 | print('The sum is: ', (testCalc())) 10 | -------------------------------------------------------------------------------- /tools/sloc-by-file: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | cd "$(dirname "$0")" 3 | cd ../ 4 | 5 | scc --count-as "nuj:Scheme" --exclude-dir="vendor,bootstrap,web,releases,.builds,.github,tools,.gitignore,benchmark,configure,tests,testsuite" -i nuj,c,h,asm,s,mk --by-file 6 | -------------------------------------------------------------------------------- /benchmark/recfib/fib.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (defn fib (n) 4 | (cond ((zero? n) 0) 5 | ((= 1 n) 1) 6 | (#t (+ (fib (- n 1)) (fib (- n 2)))))) 7 | 8 | (pfmtln "fib(40) is: {}\nGC Runs: {}" (fib 40) (garbage-collection-runs)) 9 | -------------------------------------------------------------------------------- /benchmark/euler1/berry.be: -------------------------------------------------------------------------------- 1 | def test_run() 2 | var ret = 0 3 | for i:0 .. (10000000-1) 4 | if (((i%3) == 0) || ((i%5) == 0)) 5 | ret += i 6 | end 7 | end 8 | return ret 9 | end 10 | print("The sum is: " .. test_run()) 11 | -------------------------------------------------------------------------------- /benchmark/euler1/php.php: -------------------------------------------------------------------------------- 1 | 2 | 3 | int main(int argc, char *argv[]){ 4 | long long int ret = 0; 5 | for(int i=0;i<10000000;i++){ 6 | if(((i % 3) == 0) || ((i % 5) == 0)){ 7 | ret += i; 8 | } 9 | } 10 | printf("This sum is: %lli\n", ret); 11 | return 0; 12 | } 13 | -------------------------------------------------------------------------------- /tests/slow/day12.input: -------------------------------------------------------------------------------- 1 | yb-start 2 | de-vd 3 | rj-yb 4 | rj-VP 5 | OC-de 6 | MU-de 7 | end-DN 8 | vd-end 9 | WK-vd 10 | rj-de 11 | DN-vd 12 | start-VP 13 | DN-yb 14 | vd-MU 15 | DN-rj 16 | de-VP 17 | yb-OC 18 | start-rj 19 | oa-MU 20 | yb-de 21 | oa-VP 22 | jv-MU 23 | yb-MU 24 | end-OC 25 | -------------------------------------------------------------------------------- /.builds/debian_arm.yml: -------------------------------------------------------------------------------- 1 | image: debian/sid 2 | arch: arm64 3 | packages: 4 | - build-essential 5 | sources: 6 | - https://git.sr.ht/~melchizedek6809/Nujel 7 | tasks: 8 | - compile-runtime: | 9 | cd Nujel 10 | make nujel 11 | - test: | 12 | cd Nujel 13 | make test 14 | -------------------------------------------------------------------------------- /benchmark/euler1/common.lisp: -------------------------------------------------------------------------------- 1 | (defun test () 2 | (let ((ret 0)) 3 | (dotimes (i 10000000) 4 | (when (or (zerop (mod i 3)) 5 | (zerop (mod i 5))) 6 | (incf ret i))) 7 | ret)) 8 | 9 | (compile 'test) 10 | (format T "THE SUM IS ~a~%" (test)) 11 | (quit) 12 | -------------------------------------------------------------------------------- /GNUmakefile: -------------------------------------------------------------------------------- 1 | # Nujel - Copyright (C) 2020-2022 - Benjamin Vincent Schulenburg 2 | # This project uses the MIT license, a copy should be included under /LICENSE */ 3 | # 4 | # Since GNU Make prefers GNUMakefile over Makefile it's quite easy to specify 5 | # a separate makefile for GNU Make 6 | include mk/gmake.mk 7 | -------------------------------------------------------------------------------- /benchmark/euler1/newlisp.newlisp: -------------------------------------------------------------------------------- 1 | (define (test-run i ret) 2 | (while (< i 10000000) 3 | (when (or (= 0 (mod i 3)) 4 | (= 0 (mod i 5))) 5 | (set 'ret (+ i ret))) 6 | (inc i)) 7 | ret) 8 | 9 | (print "The sum is: ") 10 | (print (test-run 0 0)) 11 | (print "\n") 12 | (exit) 13 | -------------------------------------------------------------------------------- /tools/benchmark-aggregate.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (file/write (cat "const reportData = [" 4 | (-> (directory/read-recursive "web/benchmark-results") 5 | (map file/read) 6 | (join ",")) 7 | "];") 8 | "web/report-data.js") 9 | -------------------------------------------------------------------------------- /benchmark/euler1/lua.lua: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env lua 2 | 3 | local function bench() 4 | local ret = 0 5 | for i = 1,(10000000-1) 6 | do 7 | if (((i % 3) == 0) or ((i % 5) == 0)) then 8 | ret = ret + i 9 | end 10 | end 11 | return ret 12 | end 13 | 14 | print("The sum is ", bench()) 15 | -------------------------------------------------------------------------------- /tests/testsuite/dispatch.nuj: -------------------------------------------------------------------------------- 1 | (:nil (:type-name #nil)) 2 | (:int (:type-name 123)) 3 | (:string (:type-name "asd")) 4 | (:int (apply :type-name '(123))) 5 | (:nil (apply :type-name #nil)) 6 | ('(:nil :int :string) (map '(#nil 123 "asd") :type-name)) 7 | (0 (:length #nil)) 8 | (0 (:length 123)) 9 | (3 (:length "asd")) 10 | -------------------------------------------------------------------------------- /benchmark/euler1/emacs-lisp.el: -------------------------------------------------------------------------------- 1 | (require 'cl-lib) 2 | (defun test () 3 | (let ((ret 0)) 4 | (dotimes (i 10000000) 5 | (when (or (zerop (mod i 3)) 6 | (zerop (mod i 5))) 7 | (cl-incf ret i))) 8 | ret)) 9 | (byte-compile 'test) 10 | 11 | (princ (format "THE SUM IS %d\n" (test))) 12 | -------------------------------------------------------------------------------- /benchmark/euler1/main.zuo: -------------------------------------------------------------------------------- 1 | #lang zuo 2 | 3 | (define [multiple-of-3-or-5? a] 4 | [or [= 0 [modulo a 3]] 5 | [= 0 [modulo a 5]]]) 6 | 7 | (define (test-run i ret) 8 | (cond ((>= i 10000000) ret) 9 | (else (test-run (+ 1 i) (if (multiple-of-3-or-5? i) (+ ret i) ret))))) 10 | 11 | (alert "The sum is" (test-run 0 0)) 12 | -------------------------------------------------------------------------------- /benchmark/euler1/scheme.scm: -------------------------------------------------------------------------------- 1 | (define (test-run) 2 | (let ((ret 0)) 3 | (do ((i 0 (+ i 1))) 4 | ((>= i 10000000) ret) 5 | (if (or (zero? (modulo i 3)) 6 | (zero? (modulo i 5))) 7 | (set! ret (+ ret i)))))) 8 | 9 | (display "The sum is: ") 10 | (display (test-run)) 11 | (newline) 12 | -------------------------------------------------------------------------------- /mk/amalgamation/prefix.h: -------------------------------------------------------------------------------- 1 | /* 2 | | This is a Nujel amalgamation, you just include it where necessary and if you 3 | | want the actual implementation you first define NUJEL_IMPLEMENTATION and then 4 | | include this file from a (hopefully infrequently changed file). This should 5 | | be familiar to you if you have used stb libraries. 6 | */ 7 | #define NUJEL_AMALGAMATION 8 | -------------------------------------------------------------------------------- /benchmark/for/javascript.js: -------------------------------------------------------------------------------- 1 | "use strict"; 2 | 3 | try{ 4 | var consoleLog = print ? print : console.log; 5 | }catch(e){ 6 | var consoleLog = console.log; 7 | } // mujs workaround 8 | 9 | function testRun(){ 10 | var ret = 0; 11 | for(var i=0;i<10000000;i++){ 12 | ret += i; 13 | } 14 | consoleLog("The result is: " + ret); 15 | } 16 | testRun(); 17 | -------------------------------------------------------------------------------- /.builds/netbsd.yml: -------------------------------------------------------------------------------- 1 | image: netbsd/latest 2 | sources: 3 | - https://git.sr.ht/~melchizedek6809/Nujel 4 | tasks: 5 | - compile-runtime: | 6 | cd Nujel 7 | make nujel 8 | - test: | 9 | cd Nujel 10 | make test 11 | - compile-future: | 12 | cd Nujel 13 | make future-nujel 14 | - test-future: | 15 | cd Nujel 16 | make test.future 17 | -------------------------------------------------------------------------------- /.builds/freebsd.yml: -------------------------------------------------------------------------------- 1 | image: freebsd/latest 2 | sources: 3 | - https://git.sr.ht/~melchizedek6809/Nujel 4 | tasks: 5 | - compile-runtime: | 6 | cd Nujel 7 | make nujel 8 | - test: | 9 | cd Nujel 10 | make test 11 | - compile-future: | 12 | cd Nujel 13 | make future-nujel 14 | - test-future: | 15 | cd Nujel 16 | make test.future 17 | -------------------------------------------------------------------------------- /.builds/openbsd.yml: -------------------------------------------------------------------------------- 1 | image: openbsd/latest 2 | sources: 3 | - https://git.sr.ht/~melchizedek6809/Nujel 4 | tasks: 5 | - compile-runtime: | 6 | cd Nujel 7 | make nujel 8 | - test: | 9 | cd Nujel 10 | make test 11 | - compile-future: | 12 | cd Nujel 13 | make future-nujel 14 | - test-future: | 15 | cd Nujel 16 | make test.future 17 | -------------------------------------------------------------------------------- /benchmark/euler1/dart.dart: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env dart 2 | import 'dart:io'; 3 | 4 | int testRun(){ 5 | var ret = 0; 6 | for(var i=0;i<10000000;i++){ 7 | if(((i % 3) == 0) || ((i % 5) == 0)){ 8 | ret += i; 9 | } 10 | } 11 | return ret; 12 | } 13 | 14 | void main(){ 15 | var ret = testRun(); 16 | print('The result is: ${ret}'); 17 | } -------------------------------------------------------------------------------- /benchmark/euler1/racket.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (define (multiple-of-3-or-5? α) 4 | (or (zero? (modulo α 3)) 5 | (zero? (modulo α 5)))) 6 | 7 | (define (test-run) 8 | (do ([i 0 (+ 1 i)] 9 | [ret 0]) 10 | ((>= i 10000000) ret) 11 | (when (multiple-of-3-or-5? i) 12 | (set! ret (+ ret i))))) 13 | 14 | (display "The sum is:") 15 | (display (test-run)) 16 | (newline) 17 | -------------------------------------------------------------------------------- /tools/benchmark-sync.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | (popen "rsync -avhe ssh web/benchmark-results/ wolkenwelten.net:/srv/http/nujel.net-performance/benchmark-results/") 3 | (popen "rsync -avhe ssh wolkenwelten.net:/srv/http/nujel.net-performance/benchmark-results/ web/benchmark-results/") 4 | (popen "./tools/benchmark-aggregate.nuj") 5 | (popen "rsync -avhe ssh web/ wolkenwelten.net:/srv/http/nujel.net-performance/") 6 | -------------------------------------------------------------------------------- /tests/fast/reader.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (for-each (-> (directory/read-relative "tests/fast/reader-tests") sort) 4 | (fn (file) 5 | (try car (file/read file)))) 6 | 7 | #;(for-each (-> (directory/read-relative "tests/fast/reader-tests") sort) 8 | (fn (file) 9 | (efmtln ">> Running: {file}") 10 | (load file))) 11 | 12 | (return :success) 13 | -------------------------------------------------------------------------------- /tests/fast/image0.nuj: -------------------------------------------------------------------------------- 1 | (def T {}) 2 | (set! T :new (defn new (self) 3 | { :prototype* self :count 0 })) 4 | (set! T :inc (defn inc (self) 5 | (set! self :count (inc (ref self :count))) 6 | (ref self :count))) 7 | 8 | (def res (:inc (:new T))) 9 | (return (if (= res 1) 10 | :success 11 | (exception :incorrect-result "Should result in 1" res))) -------------------------------------------------------------------------------- /tests/fast/image1.nuj: -------------------------------------------------------------------------------- 1 | (defclass T 2 | (defn new (self) 3 | { :prototype* self :count 0 }) 4 | 5 | (defn inc (self) 6 | (set! self :count (inc (ref self :count))) 7 | (ref self :count))) 8 | 9 | (def res (:inc (:new T))) 10 | 11 | (return (if (= res 1) 12 | :success 13 | (exception :incorrect-result "Should result in 1" res))) -------------------------------------------------------------------------------- /benchmark/euler1/nujel.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | ;; Multiples of 3 or 5 below 10,000,000 3 | ;; https://projecteuler.net/problem=1 4 | 5 | (defn bench-run () 6 | (def ret 0) 7 | (dotimes (i 10,000,000 ret) 8 | (when (or (zero? (rem i 3)) 9 | (zero? (rem i 5))) 10 | (set! ret (+ ret i))))) 11 | 12 | (pfmtln "The sum is: {}\nGC Runs: {}" (bench-run) (garbage-collection-runs)) 13 | -------------------------------------------------------------------------------- /benchmark/euler1/erlang.erl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env escript 2 | -mode(compile). 3 | 4 | forLoop(Ret,0) -> Ret; 5 | forLoop(Ret,I) -> 6 | if (I rem 3) == 0 -> 7 | forLoop(Ret + I, I - 1); 8 | (I rem 5) == 0 -> 9 | forLoop(Ret + I, I - 1); 10 | true -> 11 | forLoop(Ret, I - 1) 12 | end. 13 | 14 | main([]) -> 15 | io:format("The sum is: ~w~n",[forLoop(0,10000000-1)]), 16 | 0. 17 | -------------------------------------------------------------------------------- /benchmark/for/README.md: -------------------------------------------------------------------------------- 1 | This directory contains a lot of micro-benchmarks testing how fast 2 | tiny loops doing additions are in various languages. These should mostly 3 | be idiomatic but can have some minor optimizations as long as these seem reasonable 4 | (no inline assembly or something like that). Apart from that, these are meant to 5 | roughly gauge the performance of Nujel and hopefully help in determining slow parts 6 | of Nujel. 7 | -------------------------------------------------------------------------------- /benchmark/euler1/javascript.js: -------------------------------------------------------------------------------- 1 | "use strict"; 2 | 3 | try{ 4 | var consoleLog = print ? print : console.log; 5 | }catch(e){ 6 | var consoleLog = console.log; 7 | } // mujs workaround 8 | 9 | function test_run(){ 10 | var ret = 0; 11 | for(var i=0;i<10000000;i++){ 12 | if(((i%3) == 0) || ((i%5) == 0)){ 13 | ret += i; 14 | } 15 | } 16 | return ret; 17 | }; 18 | consoleLog("The sum is: " + test_run()); 19 | -------------------------------------------------------------------------------- /benchmark/adler32/adler32.py: -------------------------------------------------------------------------------- 1 | def adler32(v): 2 | a = 1 3 | b = 0 4 | for c in v: 5 | a = (a + c) % 65521 6 | b = (a + b) % 65521 7 | return a | (b << 16) 8 | 9 | def readFile(filename): 10 | in_file = open(filename, "rb") 11 | data = in_file.read() 12 | in_file.close() 13 | return data 14 | 15 | def adler32sum(filename): 16 | sum = adler32(readFile(filename)) 17 | print("{0:08X}".format(sum)) 18 | 19 | adler32sum("test-files/r5rs.pdf") 20 | -------------------------------------------------------------------------------- /mk/ansi_colors.mk: -------------------------------------------------------------------------------- 1 | ANSI_RESET :=  2 | 3 | ANSI_BLACK :=  4 | ANSI_RED :=  5 | ANSI_GREEN :=  6 | ANSI_YELLOW :=  7 | ANSI_BLUE :=  8 | ANSI_PINK :=  9 | ANSI_CYAN :=  10 | ANSI_GREY :=  11 | 12 | ANSI_BG_BLACK :=  13 | ANSI_BG_RED :=  14 | ANSI_BG_GREEN :=  15 | ANSI_BG_YELLOW :=  16 | ANSI_BG_BLUE :=  17 | ANSI_BG_PINK :=  18 | ANSI_BG_CYAN :=  19 | ANSI_BG_GREY :=  20 | -------------------------------------------------------------------------------- /tests/testsuite/ports.nuj: -------------------------------------------------------------------------------- 1 | ("asd" (with-string-port p (:block-write p "asd"))) 2 | ("asd" (with-string-port p (:write p "a" "s" "d"))) 3 | ("asd" (with-string-port p (:write p "a" "sd"))) 4 | ("asd" (with-string-port p (:write p "as" "d"))) 5 | ("asd" (with-string-port p (:write p "as") (:char-write p #x64))) 6 | ("abc" (with-string-port p (:char-write p #x61) (:char-write p #x62) (:char-write p #x63))) 7 | ("abcdef" (with-string-port p (:char-write p #x61) (:char-write p #x62) (:char-write p #x63) (:write p "def"))) 8 | -------------------------------------------------------------------------------- /benchmark/adler32/adler32.lua: -------------------------------------------------------------------------------- 1 | local function readAll(file) 2 | local f = assert(io.open(file, "rb")) 3 | local content = f:read("*all") 4 | f:close() 5 | return content 6 | end 7 | 8 | local function adler32(bv) 9 | local a = 1 10 | local b = 0 11 | for i = 1,#bv do 12 | a = (a + bv:byte(i,i)) % 65521 13 | b = (a + b) % 65521 14 | end 15 | return a + (b * 65536) 16 | end 17 | 18 | print(string.format("%8.8X",adler32(readAll("test-files/r5rs.pdf")))) 19 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | * text eol=lf 2 | *.input binary 3 | *.pdf binary 4 | 5 | *.c linguist-language=C 6 | *.h linguist-language=C 7 | *.s linguist-language=Assembly 8 | 9 | *.nuj linguist-language=Scheme 10 | *.no linguist-generated 11 | 12 | vendor/** linguist-vendored=true 13 | tools/** linguist-vendored=true 14 | web/** linguist-vendored=true 15 | benchmark/** linguist-vendored=true 16 | third-party/** linguist-vendored=true 17 | bootstrap/** linguist-vendored=true 18 | 19 | Nujel.sln text eol=crlf 20 | Nujel.vcxproj* text eol=crlf 21 | -------------------------------------------------------------------------------- /web/report.css: -------------------------------------------------------------------------------- 1 | .two-col > * { 2 | float:left; 3 | width:49%; 4 | } 5 | .two-col > *:nth-child(even) { 6 | float:right; 7 | } 8 | .two-col::after { 9 | content:''; 10 | clear:both; 11 | display:block; 12 | position:relative; 13 | } 14 | 15 | h1 { 16 | text-align:center; 17 | display:block; 18 | font-size:3em; 19 | font-family:'Courier New', Courier, monospace; 20 | } 21 | 22 | h2 { 23 | text-align:center; 24 | display:block; 25 | font-size:2em; 26 | font-family:'Courier New', Courier, monospace; 27 | } 28 | -------------------------------------------------------------------------------- /tests/fast/list-sort.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (import (rng) :random) 4 | 5 | (defn test-sort (times sort-func) 6 | (def l #nil) 7 | (def r (:new rng)) 8 | (dotimes (i times) 9 | (set! l (cons (:rng! r) l))) 10 | (def sorted (sort-func l)) 11 | (while sorted 12 | (when (and (cadr sorted) 13 | (> (car sorted) (cadr sorted))) 14 | (throw :list-not-sorted)) 15 | (cdr! sorted))) 16 | 17 | (test-sort 1500 list-merge-sort) 18 | (return :success) 19 | -------------------------------------------------------------------------------- /tests/clock.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | #| 4 | | This is just a simple program that can be used to test the accuracy of the clock 5 | |# 6 | 7 | (def next-tick (+ (time/milliseconds) 1000)) 8 | (def tick-tock #t) ; Just a simple comment 9 | (def test {}) 10 | (set! test :asd 123) 11 | (while #t 12 | (while (< (time/milliseconds) next-tick)) 13 | (if tick-tock 14 | (println "\"Tick\"") 15 | (println "Tock")) 16 | (set! tick-tock (not tick-tock)) 17 | (set! next-tick (+ (time/milliseconds) 1000))) 18 | -------------------------------------------------------------------------------- /tests/fast/digest.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | ;; Just testing that adler32 still works 3 | (import (hash :as adler32) :crypto/adler32) 4 | 5 | (def coc-hash (adler32 (file/read "CODE_OF_CONDUCT.md"))) 6 | (def lic-hash (adler32 (file/read "LICENSE"))) 7 | 8 | (when (not= coc-hash #xB5C288AD) 9 | (throw (list :wrong-result "CoC Adler32 digest wrong" (int->string/HEX coc-hash)))) 10 | (when (not= lic-hash #x8A5056E4) 11 | (throw (list :wrong-result "License Adler32 digest wrong" (int->string/HEX lic-hash)))) 12 | 13 | (return :success) 14 | -------------------------------------------------------------------------------- /tests/testsuite/compiler.nuj: -------------------------------------------------------------------------------- 1 | (:arity-error (try car (macroexpand (return 1 2 3)))) 2 | (:arity-error (try car (macroexpand (if 1 2 3 4)))) 3 | (:arity-error (try car (macroexpand (def 1 2 3)))) 4 | (8 (constant-fold (macroexpand (+ 1 1 (* 2 3))))) 5 | (21 (compile/for :none '(+ 1 2 3 4 5 6))) 6 | (4 (compile/for :none '(do 1 2 3 4))) 7 | (:type-error (try car (bytecompile '(def #nil #nil)))) 8 | (:type-error (try car (bytecompile '(set! #nil #nil)))) 9 | (:type-error (try car (bytecompile '(def)))) 10 | (:arity-error (try car (bytecompile '(set!)))) 11 | -------------------------------------------------------------------------------- /benchmark/euler4/python.py: -------------------------------------------------------------------------------- 1 | def reverseNum(a): 2 | ret = 0 3 | while a > 0: 4 | ret = (ret * 10) + (a % 10) 5 | a = a//10 6 | return ret 7 | 8 | def palindromeP(a): 9 | return a == reverseNum(a) 10 | 11 | def startSearch(): 12 | ret = 0 13 | for a in range(1000): 14 | for b in range(1000): 15 | p = a * b 16 | if (palindromeP(p) and (p > ret)): 17 | ret = p 18 | return ret 19 | 20 | print("The biggest product of 2 3-digit numbers that is a palindrome is: ", startSearch()) 21 | -------------------------------------------------------------------------------- /tests/testsuite/path.nuj: -------------------------------------------------------------------------------- 1 | ("nuj" (path/extension "test.nuj")) 2 | ("nuj" (path/extension "Another/test.nuj")) 3 | ("NUJ" (upper-case (path/extension "Another/test.nuj"))) 4 | ("no" (path/extension "asd/test.nuj.no")) 5 | ("asd/test.nuj" (path/without-extension "asd/test.nuj.no")) 6 | ("" (path/dirname "test.nuj")) 7 | ("Another" (path/dirname "Another/test.nuj")) 8 | ("asd" (path/dirname "asd/test.nuj.no")) 9 | 10 | ("test.nuj" (path/basename "test.nuj")) 11 | ("test.nuj" (path/basename "Another/test.nuj")) 12 | ("test.nuj.no" (path/basename "asd/test.nuj.no")) 13 | -------------------------------------------------------------------------------- /benchmark/euler4/kuroko.krk: -------------------------------------------------------------------------------- 1 | def reverseNum(a): 2 | let ret = 0 3 | while a > 0: 4 | ret = (ret * 10) + (a % 10) 5 | a = a//10 6 | return ret 7 | 8 | def palindromeP(a): 9 | return a == reverseNum(a) 10 | 11 | def startSearch(): 12 | let ret = 0 13 | for a in range(1000): 14 | for b in range(1000): 15 | let p = a * b 16 | if (palindromeP(p) and (p > ret)): 17 | ret = p 18 | return ret 19 | 20 | print("The biggest product of 2 3-digit numbers that is a palindrome is: ", startSearch()) 21 | -------------------------------------------------------------------------------- /tests/fast/list-slow-sort.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | (import (rng) :random) 3 | 4 | (defn test-sort (times sort-func) 5 | (def l #nil) 6 | (def rand (:new rng)) 7 | (dotimes (i times) 8 | (set! l (cons (:rng! rand) l))) 9 | (def sorted (sort-func l)) 10 | (while sorted 11 | (when (and (cadr sorted) 12 | (> (car sorted) (cadr sorted))) 13 | (throw :list-not-sorted)) 14 | (cdr! sorted))) 15 | 16 | (test-sort 1500 list/sort) 17 | 18 | (return :success) 19 | -------------------------------------------------------------------------------- /tests/fast/day6.dat: -------------------------------------------------------------------------------- 1 | 1,4,2,4,5,3,5,2,2,5,2,1,2,4,5,2,3,5,4,3,3,1,2,3,2,1,4,4,2,1,1,4,1,4,4,4,1,4,2,4,3,3,3,3,1,1,5,4,2,5,2,4,2,2,3,1,2,5,2,4,1,5,3,5,1,4,5,3,1,4,5,2,4,5,3,1,2,5,1,2,2,1,5,5,1,1,1,4,2,5,4,3,3,1,3,4,1,1,2,2,2,5,4,4,3,2,1,1,1,1,2,5,1,3,2,1,4,4,2,1,4,5,2,5,5,3,3,1,3,2,2,3,4,1,3,1,5,4,2,5,2,4,1,5,1,4,5,1,2,4,4,1,4,1,4,4,2,2,5,4,1,3,1,3,3,1,5,1,5,5,5,1,3,1,2,1,4,5,4,4,1,3,3,1,4,1,2,1,3,2,1,5,5,3,3,1,3,5,1,5,3,5,3,1,1,1,1,4,4,3,5,5,1,1,2,2,5,5,3,2,5,2,3,4,4,1,1,2,2,4,3,5,5,1,1,5,4,3,1,3,1,2,4,4,4,4,1,4,3,4,1,3,5,5,5,1,3,5,4,3,1,3,5,4,4,3,4,2,1,1,3,1,1,2,4,1,4,1,1,1,5,5,1,3,4,1,1,5,4,4,2,2,1,3,4,4,2,2,2,3 -------------------------------------------------------------------------------- /docs/README.md: -------------------------------------------------------------------------------- 1 | # The Nujel Programming Language 2 | 3 | ## Stable 4 | These documents describe parts of the language that are very unlikely to change except for details. 5 | - [Nujel - an Introduction to the language](./stable/README.md) 6 | 7 | ## Unstable 8 | These parts will probably still change quite a bit, but probably not in major ways. 9 | - [Module system](./unstable/modules.md) 10 | 11 | ## Experimental 12 | If there is no documentation available for a feature/system then it might change drastically in future versions, so please keep that in mind when writing code using those parts of the language. -------------------------------------------------------------------------------- /tests/testsuite/keyword.nuj: -------------------------------------------------------------------------------- 1 | ("asd" (:string asd:)) 2 | (:asd (:keyword "asd")) 3 | (:type-error (try car (:keyword #nil))) 4 | (:type-error (try car (:keyword 123))) 5 | (#t (keyword? :asd)) 6 | (#f (keyword? (:symbol ":asd"))) 7 | (#t (keyword? (:keyword ":asd"))) 8 | (#f (keyword? 'asd)) 9 | (#f (keyword? (:symbol "asd"))) 10 | (#f (keyword? 123)) 11 | (:read-error (try car (read/single ":asd:"))) 12 | (:read-error (try car (read/single ":asd:qwe:"))) 13 | (:read-error (try car (read/single ":asd:qwe"))) 14 | (:read-error (try car (read/single "asd:qwe"))) 15 | (:read-error (try car (read/single "a:sd:qw:e"))) 16 | -------------------------------------------------------------------------------- /tools/buildwasm-filesystem.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (import (serialize :as val->json) :serialization/json) 4 | 5 | (def directories '("binlib" "stdlib" "tests" "testsuite" "tools")) 6 | (def output-file "web/filesystem.json") 7 | 8 | (-> directories 9 | (map directory/read-recursive) 10 | (flatten) 11 | (filter (path/ext?! "nuj")) 12 | (reduce (fn (a b) 13 | (set! a (:keyword b) 14 | @(name: b content: (file/read b))))) 15 | (val->json) 16 | (file/write output-file)) 17 | (println (cat (ref ansi-bg 2) "(JSON)" ansi-bg-reset " " output-file)) 18 | -------------------------------------------------------------------------------- /tests/testsuite/module.nuj: -------------------------------------------------------------------------------- 1 | (:unbound-variable (try car (test/count!))) 2 | (:a (let ((mod (module (export a :a)))) 3 | (module/insert :test-suite-module mod) 4 | (import a :test-suite-module) 5 | a)) 6 | (3 (let ((mod (module (def counter 0) 7 | (export count! (fn () (inc! counter)))))) 8 | (module/insert :test-suite-module mod) 9 | (require :test-suite-module) 10 | (test-suite-module/count!) 11 | (test-suite-module/count!) 12 | (test-suite-module/count!))) 13 | -------------------------------------------------------------------------------- /benchmark/euler4/php.php: -------------------------------------------------------------------------------- 1 | 0){ 6 | $ret = ($ret * 10) + ($a % 10); 7 | $a = intdiv($a, 10); 8 | } 9 | return $ret; 10 | } 11 | 12 | function palindromeP(int $a){ 13 | return $a == reverseNum($a); 14 | } 15 | 16 | function startSearch(){ 17 | $ret = 0; 18 | for($a=0;$a<1000;$a++){ 19 | for($b=0;$b<1000;$b++){ 20 | $p = $a * $b; 21 | if(palindromeP($p) && ($p > $ret)){ 22 | $ret = $p; 23 | } 24 | } 25 | } 26 | return $ret; 27 | } 28 | 29 | echo("The biggest product of 2 3-digit numbers that is a palindrome is: " . startSearch()); 30 | -------------------------------------------------------------------------------- /stdlib_modules/net.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | (import (get :as http/get) :net/http) 5 | 6 | (defn get (url) 7 | :export 8 | (def res (http/get url)) 9 | (when (> (ref res :status-code) 299) 10 | (return #nil)) 11 | (ref res :body)) 12 | 13 | (defn download (url filename) 14 | :export 15 | (when-not filename 16 | (set! filename (car (last-pair (split url "/"))))) 17 | (def body (get url)) 18 | (when body (file/write body filename))) 19 | -------------------------------------------------------------------------------- /benchmark/euler4/berry.be: -------------------------------------------------------------------------------- 1 | def reverseNum(a) 2 | var ret = 0 3 | while a>0 4 | ret = (ret * 10) + (a % 10) 5 | a = (a/10) 6 | end 7 | return ret 8 | end 9 | 10 | def palindromeP(a) 11 | return a == reverseNum(a) 12 | end 13 | 14 | def startSearch() 15 | var ret = 0 16 | for a:0 .. 999 17 | for b:0 .. 999 18 | var p = a * b 19 | if(palindromeP(p) && (p > ret)) 20 | ret = p 21 | end 22 | end 23 | end 24 | return ret 25 | end 26 | 27 | print("The biggest product of 2 3-digit numbers that is a palindrome is: " .. startSearch()) 28 | -------------------------------------------------------------------------------- /benchmark/euler4/picolisp.l: -------------------------------------------------------------------------------- 1 | (de reverse-num (a) 2 | (let ret 0 3 | (while (> a 0) 4 | (setq ret (+ (* ret 10) (% a 10))) 5 | (setq a (/ a 10))) 6 | ret)) 7 | 8 | (de palindrome? (a) 9 | (== a (reverse-num a))) 10 | 11 | (de bench-run () 12 | (let max 0 13 | (for a 999 14 | (for b 999 15 | (let p (* a b) 16 | (when (and (palindrome? p) 17 | (> p max)) 18 | (setq max p))))) 19 | max)) 20 | 21 | (prinl "The biggest product of 2 3-digit numbers that is a palindrome is: " (bench-run)) 22 | (bye) 23 | -------------------------------------------------------------------------------- /benchmark/euler4/racket.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (define (reverse-num a ret) 4 | (if (< a 1) 5 | ret 6 | (reverse-num (quotient a 10) 7 | (+ (* ret 10) (remainder a 10))))) 8 | 9 | (define (palindrome? a) 10 | (= a (reverse-num a 0))) 11 | 12 | (define (search) 13 | (do ((a 0 (+ 1 a)) 14 | (ret 0)) 15 | ((>= a 1000) ret) 16 | (do ((b 0 (+ 1 b))) 17 | ((>= b 1000)) 18 | (when (palindrome? (* a b)) 19 | (set! ret (max ret (* a b))))))) 20 | 21 | (display "The biggest product of 2 3-digit numbers that is a palindrome is: ") 22 | (display (search)) 23 | (newline) 24 | -------------------------------------------------------------------------------- /tests/fast/euler001.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | ; Multiples of 3 or 5 3 | ; https://projecteuler.net/problem=1 4 | ; 5 | ; Find the sum of all the multiples of 3 or 5 below 1000. 6 | 7 | (defn multiple-of-3? (α) 8 | (zero? (rem α 3))) 9 | 10 | (defn multiple-of-5? (α) 11 | (zero? (rem α 5))) 12 | 13 | (defn multiple-of-3-or-5? (α) 14 | (or (multiple-of-3? α) 15 | (multiple-of-5? α))) 16 | 17 | (def result (-> (range 1000) 18 | (filter multiple-of-3-or-5?) 19 | (sum))) 20 | (when (not= result 233168) 21 | (throw (list :wrong-result "Wrong result" result))) 22 | (return :success) 23 | -------------------------------------------------------------------------------- /benchmark/euler4/c.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | int reverseNum(int a){ 4 | int ret = 0; 5 | for(;a>0;a/=10){ 6 | ret = (ret * 10) + (a % 10); 7 | } 8 | return ret; 9 | } 10 | 11 | int palindromeP(int a){ 12 | return a == reverseNum(a); 13 | } 14 | 15 | int startSearch() { 16 | int ret = 0; 17 | for(int a=0;a<1000;a++){ 18 | for(int b=0;b<1000;b++){ 19 | int p = a * b; 20 | if(palindromeP(p) && (p > ret)){ 21 | ret = p; 22 | } 23 | } 24 | } 25 | return ret; 26 | } 27 | 28 | int main(int argc, char *argv[]){ 29 | printf("The biggest product of 2 3-digit numbers that is a palindrome is: %i\n", startSearch()); 30 | return 0; 31 | } 32 | -------------------------------------------------------------------------------- /benchmark/euler4/newlisp.newlisp: -------------------------------------------------------------------------------- 1 | (define (reverse-num a) 2 | (let ((ret 0)) 3 | (while (> a 0) 4 | (set 'ret (+ (* ret 10) (% a 10))) 5 | (set 'a (/ a 10))) 6 | ret)) 7 | 8 | (define (palindrome? a) 9 | (= a (reverse-num a 0))) 10 | 11 | (define (searchStart) 12 | (let ((ret 0)) 13 | (for (a 0 1000) 14 | (for (b 0 1000) 15 | (let ((p (* a b))) 16 | (when (and (palindrome? p) 17 | (> p ret)) 18 | (set 'ret p))))) 19 | ret)) 20 | 21 | 22 | (print "The biggest product of 2 3-digit numbers that is a palindrome is: ") 23 | (print (searchStart)) 24 | (print "\n") 25 | (exit) 26 | -------------------------------------------------------------------------------- /benchmark/euler4/ruby.rby: -------------------------------------------------------------------------------- 1 | def reverseNum(a) 2 | ret = 0 3 | while (a > 0) do 4 | ret = (ret * 10) + (a % 10); 5 | a = (a / 10).floor; 6 | end 7 | return ret 8 | end 9 | 10 | def palindromeP(a) 11 | a == reverseNum(a) 12 | end 13 | 14 | def startSearch 15 | ret = 0 16 | for a in 0..999 do 17 | for b in 0..999 do 18 | p = a * b 19 | if (palindromeP(p) && (p > ret)) then 20 | ret = p 21 | end 22 | end 23 | end 24 | return ret 25 | end 26 | 27 | ret = startSearch 28 | puts "The biggest product of 2 3-digit numbers that is a palindrome is: #{ret}" 29 | -------------------------------------------------------------------------------- /benchmark/euler4/julia.jl: -------------------------------------------------------------------------------- 1 | function reverseNum(a) 2 | ret = 0 3 | while (a > 0) 4 | ret = (ret * 10) + (a % 10) 5 | a = floor(a / 10) 6 | end 7 | return ret 8 | end 9 | 10 | function palindrome(a) 11 | return (a == reverseNum(a)) 12 | end 13 | 14 | function startSearch() 15 | ret = 0 16 | for a = 1:999 17 | for b = 1:999 18 | p = a * b 19 | if (palindrome(p) && (p > ret)) 20 | ret = p 21 | end 22 | end 23 | end 24 | return ret 25 | end 26 | 27 | print(string("The biggest product of 2 3-digit numbers that is a palindrome is: ", startSearch())) 28 | -------------------------------------------------------------------------------- /benchmark/euler4/main.zuo: -------------------------------------------------------------------------------- 1 | #lang zuo 2 | 3 | (define (max a b) 4 | (if (> a b) a b)) 5 | 6 | (define (reverse-num a ret) 7 | (if (< a 1) 8 | ret 9 | (reverse-num (quotient a 10) 10 | (+ (* ret 10) (modulo a 10))))) 11 | 12 | (define (palindrome? a) 13 | (= a (reverse-num a 0))) 14 | 15 | (define (search a b ret) 16 | (cond ((>= a 1000) ret) 17 | ((>= b 1000) (search (+ a 1) 0 ret)) 18 | (else (search a (+ 1 b) (if (palindrome? (* a b)) 19 | (max ret (* a b)) 20 | ret))))) 21 | 22 | (alert "The biggest product of 2 3-digit numbers that is a palindrome is" (search 0 0 0)) 23 | -------------------------------------------------------------------------------- /benchmark/euler4/nujel.nuj: -------------------------------------------------------------------------------- 1 | ;; The biggest product of 2 3-digit numbers that is a palindrome 2 | ;; https://projecteuler.net/problem=4 3 | 4 | 5 | (defn reverse-num (a) 6 | (def ret 0) 7 | (while (> a 0) 8 | (set! ret (+ (* ret 10) (rem a 10))) 9 | (set! a (div/int a 10))) 10 | ret) 11 | 12 | (defn palindrome? (a) 13 | (= a (reverse-num a))) 14 | 15 | (defn bench-run () 16 | (def max-val 0) 17 | (dotimes (a 1000 max-val) 18 | (dotimes (b 1000) 19 | (def p (* a b)) 20 | (when (palindrome? p) 21 | (set! max-val (max p max-val)))))) 22 | 23 | (pfmtln "The biggest product of 2 3-digit numbers that is a palindrome is: {}" (bench-run)) 24 | -------------------------------------------------------------------------------- /benchmark/euler4/perl.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use warnings; 3 | use strict; 4 | 5 | sub reverseNum { 6 | my $a = $_[0]; 7 | my $ret = 0; 8 | while ($a > 0){ 9 | $ret = ($ret * 10) + ($a % 10); 10 | $a = int $a / 10; 11 | } 12 | return $ret; 13 | } 14 | 15 | sub startSearch { 16 | my $ret = 0; 17 | for(my $a=0; $a < 1000; $a++){ 18 | for(my $b=0; $b < 1000; $b++){ 19 | my $p = $a * $b; 20 | if((reverseNum($p) == $p) && ($p > $ret)){ 21 | $ret = $p; 22 | } 23 | } 24 | } 25 | print "The biggest product of 2 3-digit numbers that is a palindrome is: $ret"; 26 | } 27 | 28 | startSearch(); 29 | -------------------------------------------------------------------------------- /docs/stable/1.5-symbols-keywords.md: -------------------------------------------------------------------------------- 1 | [ 2 | [1.4 - Arithmetic](./1.4-arithmetic.md) 3 | | 4 | [1.6 - Variables](./1.6-variables.md) 5 | ] 6 | 7 | -------- 8 | 9 | # Symbols / Keywords 10 | Keywords have to start, or end, with a single `:` character and are self-evaluating. They are a distinct type from symbols but can be easily converted. 11 | ```scheme 12 | :asd ; A keyword 13 | ; => :asd 14 | 15 | asd: ; Another keyword 16 | ; => asd: 17 | 18 | [= asd: :asd] ; It doesn't matter where we put the colon 19 | ; => #t 20 | 21 | [= :asd [symbol->keyword 'asd]] 22 | ; => #t 23 | ``` 24 | 25 | -------- 26 | 27 | [ 28 | [1.4 - Arithmetic](./1.4-arithmetic.md) 29 | | 30 | [1.6 - Variables](./1.6-variables.md) 31 | ] -------------------------------------------------------------------------------- /tests/slow/euler004.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (defn reverse-num (a) 4 | (def ret 0) 5 | (while (> a 0) 6 | (set! ret (* ret 10)) 7 | (set! ret (+ ret (rem a 10))) 8 | (set! a (div/int a 10))) 9 | (return ret)) 10 | 11 | (defn palindrome? (a) 12 | (= a (reverse-num a))) 13 | 14 | (def max 0) 15 | (dotimes (a 1000) 16 | (dotimes (b 1000) 17 | (def p (* a b)) 18 | (when (and (palindrome? p) 19 | (> p max)) 20 | (set! max p)))) 21 | 22 | 23 | (when (not= max 906609) 24 | (throw (list :wrong-result "Wrong result" max))) 25 | (return :success) 26 | -------------------------------------------------------------------------------- /benchmark/euler4/janet.jnt: -------------------------------------------------------------------------------- 1 | (defn reverse-num [real-a] 2 | (var ret 0) 3 | (var a real-a) 4 | (while (> a 0) 5 | (set ret (+ (* ret 10) (% a 10))) 6 | (set a (math/floor (/ a 10)))) 7 | ret) 8 | 9 | (defn palindrome? [a] 10 | (= a (reverse-num a))) 11 | 12 | (defn startSeach [] 13 | (var max 0) 14 | (loop [a :range [0 1000]] 15 | (loop [b :range [0 1000]] 16 | (var p (* a b)) 17 | (when (and (palindrome? p) 18 | (> p max)) 19 | (set max p)))) 20 | max) 21 | 22 | 23 | (print "The biggest product of 2 3-digit numbers that is a palindrome is: " (startSeach)) 24 | -------------------------------------------------------------------------------- /tests/fast/euler002.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | ; Even Fibonacci numbers 3 | ; https://projecteuler.net/problem=2 4 | ; 5 | ; By considering the terms in the Fibonacci sequence whose values do not exceed four million, find the sum of the even-valued terms. 6 | 7 | (defn fib-range/iter (l max) 8 | (def v (+ (car l) (cadr l))) 9 | (if (> v max) 10 | l 11 | (fib-range/iter (cons v l) max))) 12 | 13 | (defn fib-range (max) 14 | (nreverse (fib-range/iter (list 2 1) max))) 15 | 16 | (def ret (-> (fib-range 4,000,000) 17 | (filter even?) 18 | (sum))) 19 | (when (not= ret 4613732) 20 | (throw (list :wrong-result "Wrong result" ret))) 21 | (return :success) 22 | -------------------------------------------------------------------------------- /benchmark/euler4/dart.dart: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env dart 2 | import 'dart:io'; 3 | 4 | 5 | int reverseNum(a){ 6 | int ret = 0; 7 | for(;a>0;a = (a~/10)){ 8 | ret = ((ret * 10) + (a % 10)).floor(); 9 | } 10 | return ret; 11 | } 12 | 13 | bool palindromeP(a){ 14 | return a == reverseNum(a); 15 | } 16 | int startSearch() { 17 | var ret = 0; 18 | for(var a=0;a<1000;a++){ 19 | for(var b=0;b<1000;b++){ 20 | var p = a * b; 21 | if(palindromeP(p) && (p > ret)){ 22 | ret = p; 23 | } 24 | } 25 | } 26 | return ret; 27 | } 28 | 29 | void main(){ 30 | var ret = startSearch(); 31 | print("The biggest product of 2 3-digit numbers that is a palindrome is: ${ret}"); 32 | } 33 | -------------------------------------------------------------------------------- /stdlib/core/classes.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; Contains macros that provide a nice class system on the underlying prototype system 5 | 6 | (defmacro defclass (name . body) 7 | (def fn-meta (meta/parse/body name '() body)) 8 | (def def-form `(def ~name (:data (let* ~@body (def meta* ~fn-meta) (current-closure))))) 9 | (if (ref fn-meta :export) 10 | (if (ref fn-meta :export) 11 | (list 'export (if (symbol? (ref fn-meta :export)) 12 | (ref fn-meta :export) 13 | name) def-form)) 14 | def-form)) 15 | -------------------------------------------------------------------------------- /tests/testsuite/generic.nuj: -------------------------------------------------------------------------------- 1 | (1 (ref [1 2 3] 0)) 2 | (2 (ref [1 2 3] 1)) 3 | (3 (ref [1 2 3] 2)) 4 | (1 (ref '(1 2 3) 0)) 5 | (2 (ref '(1 2 3) 1)) 6 | (3 (ref '(1 2 3) 2)) 7 | (#nil (ref '(1 2 3) 3)) 8 | (123 (ref {:asd 123 :qwe 234} :asd)) 9 | (#nil (ref {:asd 123 :qwe 234} :asdqwe)) 10 | (32 (ref "asd " 3)) 11 | (:type-error (try car (ref '(1 2 3) -1))) 12 | (:type-error (try car (ref "" -10))) 13 | (:out-of-bounds (try car (ref "" 10))) 14 | (:out-of-bounds (try car (ref [1 2 3] 10))) 15 | (99 (ref (set! [1 2 3] 0 99) 0)) 16 | (:out-of-bounds (try car (set! [1 2 3] 10 99))) 17 | (:type-error (try car (set! [1 2 3] -10 99))) 18 | (:type-error (try car (set! '(1 2 3) 0 99))) 19 | (:type-error (try car (set! '(1 2 3) 0 99))) 20 | (:type-error (try car (set! "asd" 0 99))) 21 | -------------------------------------------------------------------------------- /benchmark/euler4/scheme.scm: -------------------------------------------------------------------------------- 1 | ;; The biggest product of 2 3-digit numbers that is a palindrome 2 | ;; https://projecteuler.net/problem=4 3 | 4 | (define (reverse-num a ret) 5 | (if (< a 1) 6 | ret 7 | (reverse-num (quotient a 10) 8 | (+ (* ret 10) (remainder a 10))))) 9 | 10 | (define (palindrome? a) 11 | (= a (reverse-num a 0))) 12 | 13 | (define (search) 14 | (let ((max-val 0)) 15 | (do ((a 0 (+ a 1))) 16 | ((>= a 1000) max-val) 17 | (do ((b 0 (+ b 1))) 18 | ((>= b 1000)) 19 | (let ((p (* a b))) 20 | (if (palindrome? p) 21 | (set! max-val (max p max-val)))))))) 22 | 23 | (display "The biggest product of 2 3-digit numbers that is a palindrome is: ") 24 | (display (search)) 25 | (newline) 26 | -------------------------------------------------------------------------------- /docs/stable/1.8-functions.md: -------------------------------------------------------------------------------- 1 | [ 2 | [1.7 - Quote & Quasiquote](./1.7-quote-quasiquote.md) 3 | | 4 | [Overview](./README.md) 5 | ] 6 | 7 | -------- 8 | 9 | # Functions 10 | Functions use `defn` and `fn`, just like *Clojure*, however we can freely choose where we want to use brackets and parentheses. Variadic functions also use the scheme notation with a dotted pair, or omitting the brackets altogether. 11 | ```scheme 12 | [defn double [α] [* α α]] 13 | [double 2] 14 | ; => 4 15 | 16 | [defn multiply-vals [val . l] 17 | [map l [fn [v] [* v val]]]] 18 | [multiply-vals 2 1 2 3] 19 | ; => [2 4 6] 20 | 21 | [defn my-list l l] 22 | [my-list 1 2 3 4] 23 | ; => [1 2 3 4] 24 | ``` 25 | 26 | -------- 27 | 28 | [ 29 | [1.7 - Quote & Quasiquote](./1.7-quote-quasiquote.md) 30 | | 31 | [Overview](./README.md) 32 | ] -------------------------------------------------------------------------------- /tests/fast/ports.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (def out-contents "This is a short test paragraph\nIt even contains a linebreak!") 4 | (def path "test-file.tmp") 5 | (when (file/file? path) 6 | (throw (list :port-error "The temporary filepath already contains a file" path))) 7 | 8 | (file/write out-contents path) 9 | (when (not (file/file? path)) 10 | (throw (list :port-error "The temporary filepath doesn't contain a file after it should have been written too"))) 11 | 12 | (def in-contents (slurp path)) 13 | (when (not= in-contents out-contents) 14 | (throw (list :port-error "The contents we've written and read back don't match, something isn't working"))) 15 | 16 | (rm path) 17 | (when (file/file? path) 18 | (throw (list :port-error "The temporary filepath still exists"))) 19 | 20 | (return :success) 21 | -------------------------------------------------------------------------------- /benchmark/euler4/erlang.erl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env escript 2 | -mode(compile). 3 | 4 | reverseNum(A,Ret) -> 5 | if (A < 1) -> 6 | Ret; 7 | true -> 8 | reverseNum( A div 10, (Ret * 10) + (A rem 10)) 9 | end. 10 | 11 | palindrome(A) -> 12 | A == reverseNum(A,0). 13 | 14 | ifPalindrome(A,Ret) -> 15 | case palindrome(A) of 16 | true -> 17 | max(Ret,A); 18 | false -> 19 | Ret 20 | end. 21 | 22 | startSearch(A,B,Ret) -> 23 | if (A >= 1000) -> 24 | Ret; 25 | (B >= 1000) -> 26 | startSearch(A+1,0,Ret); 27 | true -> 28 | startSearch(A,B+1, ifPalindrome(A*B,Ret)) 29 | end. 30 | 31 | main([]) -> 32 | io:format("The biggest product of 2 3-digit numbers that is a palindrome is: ~w~n",[startSearch(0,0,0)]), 33 | 0. 34 | -------------------------------------------------------------------------------- /benchmark/euler4/javascript.js: -------------------------------------------------------------------------------- 1 | "use strict"; 2 | 3 | try{ 4 | var consoleLog = print ? print : console.log; 5 | }catch(e){ 6 | var consoleLog = console.log; 7 | } // mujs workaround 8 | 9 | function reverseNum(a){ 10 | var ret = 0; 11 | for(;a>0;a = (a/10)|0){ 12 | ret = (ret * 10) + (a % 10); 13 | } 14 | return ret; 15 | } 16 | 17 | function palindromeP(a){ 18 | return a == reverseNum(a); 19 | } 20 | 21 | function startSearch() { 22 | var ret = 0; 23 | for(var a=0;a<1000;a++){ 24 | for(var b=0;b<1000;b++){ 25 | var p = a * b; 26 | if(palindromeP(p) && (p > ret)){ 27 | ret = p; 28 | } 29 | } 30 | } 31 | return ret; 32 | } 33 | 34 | consoleLog("The biggest product of 2 3-digit numbers that is a palindrome is: " + startSearch()); 35 | -------------------------------------------------------------------------------- /benchmark/euler4/lua.lua: -------------------------------------------------------------------------------- 1 | -- The biggest product of 2 3-digit numbers that is a palindrome 2 | -- https://projecteuler.net/problem=4 3 | local function reverseNum (a) 4 | local ret = 0 5 | while (a > 0) do 6 | ret = (ret * 10) + (a % 10) 7 | a = math.floor(a / 10) 8 | end 9 | return ret 10 | end 11 | 12 | local function palindrome (a) 13 | return (a == reverseNum(a)) 14 | end 15 | 16 | local function startSearch () 17 | local ret = 0 18 | for a = 0,1000 do 19 | for b = 0,1000 do 20 | local p = a * b 21 | if (palindrome(p) and (p > ret)) then 22 | ret = p 23 | end 24 | end 25 | end 26 | return ret 27 | end 28 | 29 | print("The biggest product of 2 3-digit numbers that is a palindrome is: ", startSearch()) 30 | -------------------------------------------------------------------------------- /tests/testsuite/objects.nuj: -------------------------------------------------------------------------------- 1 | (2 (-> {:inc! (fn (self) (set! self :v (inc (ref self :v)))) :v 0} :inc! :inc! (ref :v))) 2 | (2 (do (def proto {:inc! (fn (self) (set! self :v (inc (ref self :v))))}) 3 | (def o {:v 0 :prototype* proto}) 4 | (:inc! o) 5 | (:inc! o) 6 | (ref o :v))) 7 | (2 (do (def proto { :set! (fn (self v) (set! self :v v)) 8 | :inc! (fn (self) (:set! self (inc (ref self :v))))}) 9 | (def o {:v 0 :prototype* proto}) 10 | (:inc! o) 11 | (:inc! o) 12 | (ref o :v))) 13 | (110 (do (def proto { :set! (fn (self v) (set! self :v v)) 14 | :inc! (fn (self) (:set! self (inc (ref self :v))))}) 15 | (def o { :v 0 16 | :prototype* proto 17 | :set! (fn (self v) (set! self :v (* v 10)))}) 18 | (:inc! o) 19 | (:inc! o) 20 | (ref o :v))) 21 | -------------------------------------------------------------------------------- /docs/stable/1.7-quote-quasiquote.md: -------------------------------------------------------------------------------- 1 | [ 2 | [1.6 - Variables](./1.6-variables.md) 3 | | 4 | [1.8 - Procedures](./1.8-functions.md) 5 | ] 6 | 7 | -------- 8 | 9 | # Quote / Quasiquote 10 | Quote works as you would expect, quasiquote however uses the clojure syntax for `unquote`/`unquote-splicing`. This is because I want to be able to treat `,` as white-space (it also looks very similar to a period, which I dislike). 11 | ```scheme 12 | 'a ; You can quote symbols 13 | ; => a 14 | 15 | '[1 2 3] ; Or lists 16 | ; => [1 2 3] 17 | 18 | '(1 2 3) ; With parentheses or brackets 19 | ; => [1 2 3] 20 | 21 | `[1 2 ~[+ 1 1 1]] ; To unquote you can use a tilde 22 | ; => [1 2 3] 23 | 24 | `[1 ~@[list 2 3]] ; And ~@ for unquote-splicing 25 | ; => [1 2 3] 26 | 27 | ``` 28 | 29 | -------- 30 | 31 | [ 32 | [1.6 - Variables](./1.6-variables.md) 33 | | 34 | [1.8 - Procedures](./1.8-functions.md) 35 | ] -------------------------------------------------------------------------------- /tests/testsuite/type-errors.nuj: -------------------------------------------------------------------------------- 1 | (:type-error (try car (abs))) 2 | (:type-error (try car (sqrt))) 3 | (:type-error (try car (cbrt))) 4 | (:type-error (try car (floor))) 5 | (:type-error (try car (ceil))) 6 | (:type-error (try car (round))) 7 | (:type-error (try car (sin))) 8 | (:type-error (try car (cos))) 9 | (:type-error (try car (tan))) 10 | (:type-error (try car (atan2))) 11 | (:type-error (try car (atan2 1.0))) 12 | (:type-error (try car (atan2 1.0 "1.0"))) 13 | (:type-error (try car (:asd))) 14 | (:type-error (try car (:asd #nil))) 15 | (:type-error (try car (eval '()))) 16 | (:type-error (try car (compile '()))) 17 | (:type-error (try car (compile '(123)))) 18 | (:type-error (try car (compile '("asd")))) 19 | (:type-error (try car (compile '(##())))) 20 | (:type-error (try car (compile '(#@())))) 21 | (:type-error (try car (compile '(fn)))) 22 | (:type-error (try car (compile '(fn 123)))) 23 | -------------------------------------------------------------------------------- /benchmark/euler4/emacs-lisp.el: -------------------------------------------------------------------------------- 1 | ;; The biggest product of 2 3-digit numbers that is a palindrome 2 | ;; https://projecteuler.net/problem=4 3 | 4 | (require 'cl-lib) 5 | 6 | (defun reverse-num (a) 7 | (let ((ret 0)) 8 | (while (> a 0) 9 | (progn (setf ret (+ (* ret 10) (mod a 10))) 10 | (setf a (floor a 10)))) 11 | ret)) 12 | 13 | (defun palindrome? (a) 14 | (eq a (reverse-num a))) 15 | 16 | (defun start-search () 17 | (let ((max 0)) 18 | (dotimes (a 1000 max) 19 | (dotimes (b 1000) 20 | (let ((p (* a b))) 21 | (when (and (palindrome? p) 22 | (> p max)) 23 | (setf max p))))))) 24 | 25 | (byte-compile 'reverse-num) 26 | (byte-compile 'palindrome?) 27 | (byte-compile 'start-search) 28 | 29 | (princ (format "The biggest product of 2 3-digit numbers that is a palindrome is: %d\n" (start-search))) 30 | -------------------------------------------------------------------------------- /bin/private.h: -------------------------------------------------------------------------------- 1 | #ifndef NUJEL_BIN_PRIVATE 2 | #define NUJEL_BIN_PRIVATE 3 | 4 | #ifndef NUJEL_AMALGAMATION 5 | #include "../lib/nujel.h" 6 | #endif 7 | 8 | #if (!defined(_WIN32)) && (!defined(__wasi__)) 9 | #include 10 | #endif 11 | 12 | #include 13 | #include 14 | #include 15 | 16 | #if defined(_MSC_VER) 17 | #include 18 | #define access(path,mode) _access(path,mode) 19 | #else 20 | #include 21 | #endif 22 | 23 | extern lSymbol *lSymError; 24 | extern lSymbol *lSymReplace; 25 | extern lSymbol *lSymAppend; 26 | 27 | void lRedefineEnvironment(lClosure *c); 28 | void lRedefineFileHandles(lClosure *c); 29 | 30 | void setIOSymbols(); 31 | void lOperationsIO (); 32 | void lOperationsPort (); 33 | void lOperationsNet (); 34 | void *loadFile(const char *filename, size_t *len); 35 | 36 | int makeDir (const char *name); 37 | 38 | #endif 39 | -------------------------------------------------------------------------------- /tests/fast/day6.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (defn step (a) 4 | [(ref a 1) 5 | (ref a 2) 6 | (ref a 3) 7 | (ref a 4) 8 | (ref a 5) 9 | (ref a 6) 10 | (+ (ref a 7) (ref a 0)) 11 | (ref a 8) 12 | (ref a 0)]) 13 | 14 | (defn do-steps (l count) 15 | (dotimes (i count l) 16 | (set! l (step l)))) 17 | 18 | (defn input/parse (l) 19 | (def ret [0 0 0 0 0 0 0 0 0]) 20 | (while l 21 | (array/++ ret (car l)) 22 | (cdr! l)) 23 | ret) 24 | 25 | (def input (input/parse (map (split (file/read "tests/fast/day6.dat") ",") read/int))) 26 | (def result (sum (do-steps input 80))) 27 | (when (not= result 349549) 28 | (throw (list :wrong-result "Wrong result" result))) 29 | (def result (sum (do-steps input 256))) 30 | (when (not= result 1589590444365) 31 | (throw (list :wrong-result "Wrong result" result))) 32 | 33 | (return :success) 34 | -------------------------------------------------------------------------------- /docs/stable/1.6-variables.md: -------------------------------------------------------------------------------- 1 | [ 2 | [1.5 - Symbols & Keywords](./1.5-symbols-keywords.md) 3 | | 4 | [1.7 - Quote & Quasiquote](./1.7-quote-quasiquote.md) 5 | ] 6 | 7 | -------- 8 | 9 | # Variables 10 | You can define new variables using `def` and give old variables a new value using `set!`. You can use `let` if you only want a variable visible to a small section of code. 11 | ```scheme 12 | my-temp ; You can access a variables value by evaluating the symbol 13 | ; => :unbound-variable 14 | [def my-temp 123] ; Of course it needs to be defined first 15 | ; => 123 16 | [set! my-temp 234] 17 | my-temp 18 | ; => 234 19 | [def double [fn [a] [* a a]]] ; You can also define functions this way, although defn should be preferred because it gives better error messages/stack traces 20 | [double 4] 21 | ; => 16 22 | ``` 23 | 24 | -------- 25 | 26 | [ 27 | [1.5 - Symbols & Keywords](./1.5-symbols-keywords.md) 28 | | 29 | [1.7 - Quote & Quasiquote](./1.7-quote-quasiquote.md) 30 | ] -------------------------------------------------------------------------------- /docs/stable/1.1-parentheses.md: -------------------------------------------------------------------------------- 1 | [ 2 | [Introduction](./README.md) 3 | | 4 | [1.2 - Comments](./1.2-comments.md) 5 | ] 6 | 7 | -------- 8 | 9 | # Parentheses 10 | Nujel uses the S-Expression notation as used by languages such as *Lisp*, *Scheme* and *Clojure*, but with one difference: Nujel defaults to using brackets instead of parentheses. This is mainly because brackets are much easier to type with a default US keyboard layout. You can still use parentheses if you must, since the two are completely interchangeable. 11 | ```scheme 12 | [+ 1 2] ; => 3 13 | (+ 1 2) ; => 3 14 | ``` 15 | 16 | Dotted pairs are also supported: 17 | ```scheme 18 | [car '[a . b]] ; => a 19 | [cdr '[a . b]] ; => b 20 | [car [cons 1 2]] ; => 1 21 | [cdr [cons 1 2]] ; => 2 22 | ``` 23 | And as you can see Nujel uses `car` and `cdr` to access the first or rest parts of lists. To build a new pair you can use `cons`. 24 | 25 | -------- 26 | [ 27 | [Introduction](./README.md) 28 | | 29 | [1.2 - Comments](./1.2-comments.md) 30 | ] -------------------------------------------------------------------------------- /docs/unstable/modules.md: -------------------------------------------------------------------------------- 1 | [^ overview](./../README.md) 2 | 3 | # Nujel - module system - **unstable** 4 | The Nujel module system is mostly modeled after ES6 Modules 5 | 6 | ## Expected changes 7 | The exact forms used for import/export might change, as well as exact error messages/keywords. 8 | 9 | ## No single/shared namespace 10 | In Nujel there is no single/shared namespace, so there is no way to reference a particular value without importing it first. 11 | 12 | ## Every symbol needs to be explicitly imported before usage 13 | Of course everything in :core is available by default, but apart from that everything needs to be requested explicitly. This should make upgrading much simpler since modules can provide incompatible functionality under a different symbol. 14 | 15 | 16 | ## Only way to import all symbols from another module is by requesting every export as a map 17 | This is a way of importing everything from a module, without the possibility of inadvertently shadowing symbols 18 | 19 | -------------------------------------------------------------------------------- /stdlib_modules/help.nuj: -------------------------------------------------------------------------------- 1 | (import (rainbow green yellow blue) :ansi) 2 | 3 | (defn main (args) 4 | :export 5 | (println (cat (rainbow "Nujel") " - A Lisp dialect for games.\n")) 6 | (println (cat (green "Usage:") " nujel (options) (command_string | file)")) 7 | (println (cat "\nLow-level options - for work on the runtime itself")) 8 | (println (cat " " (yellow "v") " - be verbose")) 9 | (println (cat " " (yellow "r") " - run TinyREPL")) 10 | (println (cat "\nHigh-level options - for working with/on Nujel code")) 11 | (println (cat " " (blue "h") " - Print this help screen")) 12 | (println (cat " " (blue "m") " - Execute the following module")) 13 | (println (cat " " (blue "x") " - Run the expression following this argument directly")) 14 | (println (cat "\nLong options - for working with/on Nujel code")) 15 | (println (cat " " (green "no-color") " - Disable ANSI color")) 16 | (println (cat " " (green "color ") " - Enable ANSI color"))) 17 | -------------------------------------------------------------------------------- /tests/testsuite/standalone.nuj: -------------------------------------------------------------------------------- 1 | ; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ; This project uses the MIT license, a copy should be included under /LICENSE 3 | 4 | 5 | (#t (file/dir? "stdlib")) 6 | (#f (file/file? "stdlib")) 7 | (#t (file/file? "GNUmakefile")) 8 | (#f (file/dir? "GNUmakefile")) 9 | (#f (ref (file/stat "GNUmakefile") :error?)) 10 | (#t (ref (file/stat "This-file-should-never-exist.jpeg") :error?)) 11 | (#t (> (ref (file/stat "GNUmakefile") :size) 8)) 12 | (#t (int? (ref (file/stat "GNUmakefile") :modification-time))) 13 | (#t (int? (ref (file/stat "GNUmakefile") :access-time))) 14 | (#t (bool? (ref (file/stat "GNUmakefile") :regular-file?))) 15 | (#t (bool? (ref (file/stat "GNUmakefile") :directory?))) 16 | (#t (bool? (ref (file/stat "GNUmakefile") :character-device?))) 17 | (#t (bool? (ref (file/stat "GNUmakefile") :block-device?))) 18 | (#t (bool? (ref (file/stat "GNUmakefile") :named-pipe?))) 19 | (#t (tree? System/Environment)) 20 | (#t (string? (ref System/Environment 'PATH))) 21 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # Nujel - Copyright (C) 2020-2022 - Benjamin Vincent Schulenburg 2 | # This project uses the MIT license, a copy should be included under /LICENSE */ 3 | # 4 | # This trick is originally from BearSSL to distinguish between bmake/nmake 5 | # ====================================================================== 6 | # The lines below are a horrible hack that nonetheless works. On a 7 | # "make" utility compatible with Single Unix v4 (this includes GNU and 8 | # BSD make), the '\' at the end of a command line counts as an escape 9 | # for the newline character, so the next line is still a comment. 10 | # However, Microsoft's nmake.exe (that comes with Visual Studio) does 11 | # not interpret the final '\' that way in a comment. The end result is 12 | # that when using nmake.exe, this will include "mk/nmake.mk", whereas 13 | # GNU/BSD make will include "mk/bmake.mk". 14 | 15 | !ifndef 0 # \ 16 | !include mk/nmake.mk # \ 17 | !else 18 | .POSIX: 19 | include mk/bmake.mk 20 | # Extra hack for OpenBSD make. 21 | ifndef: all 22 | 0: all 23 | endif: all 24 | # \ 25 | !endif 26 | -------------------------------------------------------------------------------- /benchmark/euler4/common.lisp: -------------------------------------------------------------------------------- 1 | ;; The biggest product of 2 3-digit numbers that is a palindrome 2 | ;; https://projecteuler.net/problem=4 3 | 4 | (defun reverse-num (a) 5 | (declare (fixnum a)) 6 | (let ((ret 0)) 7 | (declare (fixnum ret)) 8 | (loop while (> a 0) do 9 | (progn (setf ret (+ (* ret 10) (rem a 10))) 10 | (setf a (floor a 10)))) 11 | ret)) 12 | 13 | (defun palindrome? (a) 14 | (declare (fixnum a)) 15 | (eq a (reverse-num a))) 16 | 17 | (defun start-search () 18 | (let ((max 0)) 19 | (declare (fixnum max)) 20 | (dotimes (a 1000 max) 21 | (declare (fixnum a)) 22 | (dotimes (b 1000) 23 | (declare (fixnum b)) 24 | (let ((p (* a b))) 25 | (declare (fixnum p)) 26 | (when (and (palindrome? p) 27 | (> p max)) 28 | (setf max p))))))) 29 | 30 | (compile 'reverse-num) 31 | (compile 'palindrome?) 32 | (compile 'start-search) 33 | (format T "The biggest product of 2 3-digit numbers that is a palindrome is: ~a~%" (start-search)) 34 | (quit) 35 | -------------------------------------------------------------------------------- /docs/stable/1.4-arithmetic.md: -------------------------------------------------------------------------------- 1 | [ 2 | [1.3 - Numbers](./1.3-numbers.md) 3 | | 4 | [1.5 - Symbols & Keywords](./1.5-symbols-keywords.md) 5 | ] 6 | 7 | -------- 8 | 9 | # Arithmetic operations 10 | Nujel supports most widely used operators directly and tries to use the same names as *Clojure* does. 11 | 12 | ```scheme 13 | [+ 1 2 3 4] ; You can add as many numbers as you want 14 | ; => 10 15 | [+ 1 2 [+ 3 4]] 16 | ; => 10 17 | [+ [+ 1 2] [+ 3 4]] 18 | ; => 10 19 | [+ 1 -2] ; You can also use negative numbers in additions 20 | ; => -1 21 | [+ 1 [- 2]] ; - can also be used to negate numbers 22 | ; => -1 23 | [+ 1 [- [+ 1 1]]] ; Results of a calculation can also be negated 24 | ; => -1 25 | [+ 1 :two "drei"] ; You can only calculate with numbers 26 | ; => :type-error 27 | [def my-var 123] 28 | [* 2 my-var] ; Using variables is fine as long as they are of a numeric type 29 | ; => 246 30 | [def my-string "tausend"] 31 | [* 2 my-string] 32 | ; => :type-error 33 | ``` 34 | 35 | -------- 36 | 37 | [ 38 | [1.3 - Numbers](./1.3-numbers.md) 39 | | 40 | [1.5 - Symbols & Keywords](./1.5-symbols-keywords.md) 41 | ] -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # OSX Files 2 | Icon? 3 | .DS_Store 4 | ._* 5 | xcuserdata/ 6 | *.xcscmblueprint 7 | *.xccheckout 8 | /DerivedData/ 9 | .vscode/ 10 | 11 | # debugging/profiling data 12 | /callgrind.out.* 13 | /vgcore.* 14 | gmon.out 15 | 16 | # Executables/Object/Temporary files 17 | /tmp 18 | /fuzz-nujel 19 | /nujel 20 | /nujel-bootstrap 21 | /future-nujel 22 | /tools/emsdk 23 | *.out 24 | *.a 25 | *.com 26 | *.dbg 27 | *.lib 28 | *.so 29 | *.o 30 | *.err 31 | /stdlib/**/*.no 32 | /stdlib_modules/**/*.no 33 | /binlib/**/*.no 34 | /tests/**/*.no 35 | *.wd 36 | *.wa 37 | *.wo 38 | *.wasm 39 | *.d 40 | *.deps 41 | *.gch 42 | *.obj 43 | *.err 44 | *.dylib 45 | *.exe 46 | *.kate-swp 47 | *.dll 48 | *.core 49 | *.res 50 | *.dSYM 51 | *.tar.xz 52 | *.tar.gz 53 | 54 | /nujel.c 55 | /nujel.h 56 | 57 | /web/index.js 58 | /web/index.html 59 | /web/index.wasm 60 | /web/index.wasm 61 | /web/plotly-* 62 | /.vs 63 | 64 | /web/filesystem.json 65 | /web/benchmark-results/ 66 | /web/report-data.js 67 | 68 | # User-specific files 69 | *.rsuser 70 | *.suo 71 | *.user 72 | *.userosscache 73 | *.sln.docstates 74 | 75 | /init.nuji -------------------------------------------------------------------------------- /tests/slow/day17.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (def counter 0) 4 | 5 | (defn in-area? (x y) 6 | (and (>= x 144) 7 | (<= x 178) 8 | (>= y -100) 9 | (<= y -76))) 10 | 11 | (defn over? (x y) 12 | (or (> x 178) 13 | (< y -100))) 14 | 15 | (defn zdir (a) 16 | (cond ((zero? a) 0) 17 | ((> a 0) -1) 18 | (#t 1))) 19 | 20 | (defn shoot (x y vx vy max-y) 21 | ;(println (cat x " " y " " vx " " vy)) 22 | (cond ((in-area? x y) (inc! counter) max-y) 23 | ((over? x y) 0) 24 | (#t (shoot (+ x vx) (+ y vy) (+ vx (zdir vx)) (+ vy -1) (max y max-y))))) 25 | 26 | (defn find-max () 27 | (def ret 0) 28 | (dotimes (vx 300) 29 | (dotimes (vy 600) 30 | (def res (shoot 0 0 vx (- vy 300) 0)) 31 | (set! ret (max ret res)) 32 | )) ret) 33 | 34 | (def res-p1 (find-max)) 35 | (when (not= res-p1 4950) 36 | (throw (list :wrong-result "Wrong result" res-p1))) 37 | (def res-p2 counter) 38 | (when (not= res-p2 1477) 39 | (throw (list :wrong-result "Wrong result" res-p2))) 40 | 41 | (return :success) 42 | -------------------------------------------------------------------------------- /tests/slow/euler003.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | ;; Prime factorization 3 | ;; https://projecteuler.net/problem=3 4 | ;; 5 | ;; Find the largest prime factor of 600851475143 6 | 7 | (defn prime? (v) 8 | (def mv v) 9 | (def i 2) 10 | (while (< i mv) 11 | (when (zero? (rem v i)) 12 | (return #f)) 13 | (set! i (add/int i 1))) 14 | (return #t)) 15 | 16 | (defn prime-factors (v) 17 | (def factors #nil) 18 | (def mv (+ 1 (div/int v 2))) 19 | (def i 2) 20 | (while (<= i mv) 21 | (when (prime? i) 22 | (while (zero? (rem v i)) 23 | (set! v (div/int v i)) 24 | (set! mv (+ 1 v)) 25 | (set! factors (cons i factors)))) 26 | (inc! i)) 27 | (return factors)) 28 | 29 | (defn largest-prime-factor (v) 30 | (car (prime-factors v))) 31 | 32 | (def ret (largest-prime-factor 600851475143)) 33 | (when (not= ret 6857) 34 | (throw (list :wrong-result "Wrong result" ret))) 35 | 36 | (return :success) 37 | -------------------------------------------------------------------------------- /docs/stable/1.0-setup.md: -------------------------------------------------------------------------------- 1 | [ 2 | [Introduction](./README.md) 3 | | 4 | [1.1 - Parentheses](./1.1-parentheses.md) 5 | ] 6 | 7 | -------- 8 | 9 | # Setup 10 | I would highly recommend running Nujel in the background while reading this book, so you can experiment yourself with the various snippets provided. To install Nujel you can follow the instructions provided in the [README.md](../../README.md) file from the root of this repository. 11 | 12 | Currently there are no official binaries provided, but compiling Nujel shoule be very simple since you only need a C Compiler and `make`, there are no other dependencies. 13 | 14 | ## Text Editor 15 | If you use Emacs you can try using [nujel-mode](https://github.com/Melchizedek6809/nujel-mode), otherwise you can try using *Scheme* or *Clojure* modes since they should work reasonably well with Nujel. 16 | 17 | ## Interactive Environment 18 | You can run Nujel with `rlwrap` in order to get proper readline support, `nujel-mode` supports running Nujel interactively as well. 19 | 20 | -------- 21 | 22 | [ 23 | [Introduction](./README.md) 24 | | 25 | [1.1 - Parentheses](./1.1-parentheses.md) 26 | ] -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 202X Benjamin Vincent Schulenburg 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in all 11 | copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 19 | SOFTWARE. 20 | -------------------------------------------------------------------------------- /tests/fast/word-count.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | ;; Simple test program that should give the same result as `wc -l` or `wc -w` 3 | 4 | (defn count-lines (filename) 5 | (def text (:string (file/read filename))) 6 | (- (count (split text "\n")) 1)) 7 | 8 | (defn count-words (filename) 9 | (def text (:string (file/read filename))) 10 | (-> text 11 | (split "\n") 12 | (reduce (fn (a b) 13 | (+ a (count (split b " ") (fn (a) (> (:length (trim a)) 0))))) 14 | 0))) 15 | 16 | (def lines (count-lines "CODE_OF_CONDUCT.md")) 17 | (when (not= lines 136) 18 | (throw (list :wrong-result "CoC Lines Wrong" lines))) 19 | (def words (count-words "CODE_OF_CONDUCT.md")) 20 | (when (not= words 717) 21 | (throw (list :wrong-result "CoC Words Wrong" words))) 22 | (def llines (count-lines "LICENSE")) 23 | (when (not= llines 19) 24 | (throw (list :wrong-result "LICENSE Lines Wrong" llines))) 25 | (def lwords (count-words "LICENSE")) 26 | (when (not= lwords 168) 27 | (throw (list :wrong-result "LICENSE Words Wrong" lwords))) 28 | 29 | (return :success) 30 | -------------------------------------------------------------------------------- /docs/stable/README.md: -------------------------------------------------------------------------------- 1 | [ 2 | [Nujel Documents](./../README.md) 3 | | 4 | [1.0 - Setup](./1.0-setup.md) 5 | ] 6 | 7 | -------- 8 | 9 | # Nujel - an Introduction to the language 10 | Most functions/macros borrow their name directly from *Clojure* or *Common Lisp*, while the reader syntax is most similar to *(Guile) Scheme*, with some changes due to different semantics. 11 | 12 | ## Who this book is for 13 | This book is mostly meant for programmers already familiar with a Lisp derived language such as *Common Lisp*, *Scheme* or *Clojure*. 14 | 15 | ## Expected changes 16 | The exact error messages/keywords might change, so depend on that at your own risk. 17 | 18 | ## Chapters 19 | - [1.0 - Setup](./1.0-setup.md) 20 | - [1.1 - Parentheses](./1.1-parentheses.md) 21 | - [1.2 - Comments](./1.2-comments.md) 22 | - [1.3 - Numbers](./1.3-numbers.md) 23 | - [1.4 - Arithmetic](./1.4-arithmetic.md) 24 | - [1.5 - Symbols & Keywords](./1.5-symbols-keywords.md) 25 | - [1.6 - Variables](./1.6-variables.md) 26 | - [1.7 - Quote & Quasiquote](./1.7-quote-quasiquote.md) 27 | - [1.8 - Procedures](./1.8-functions.md) 28 | 29 | -------- 30 | 31 | [ 32 | [Nujel Documents](./../README.md) 33 | | 34 | [1.0 - Setup](./1.0-setup.md) 35 | ] -------------------------------------------------------------------------------- /stdlib/math/math.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; Some convenient math functions and constants 5 | 6 | (def PI 3.141592653589793) 7 | (def π PI) 8 | 9 | (defn inc (x) 10 | :inline 11 | "Return a number 1 greater than x" 12 | (+ 1 x)) 13 | 14 | (defn dec (x) 15 | :inline 16 | "Return a number 1 less than x" 17 | (- x 1)) 18 | 19 | (defmacro inc! (i v) 20 | "Decrement I by V (defaults to 1) and store the result in I" 21 | `(set! ~i (+ ~i ~(or v 1)))) 22 | 23 | (defmacro dec! (i v) 24 | "Decrement I by V and store the result in I" 25 | `(set! ~i (- ~i ~(or v 1)))) 26 | 27 | (defn radians (degrees) 28 | "Convert a quantity in degrees to radians" 29 | (/ (* π degrees) 180.0)) 30 | 31 | (defn min args 32 | "Returns the minimum value of its arguments" 33 | :cat :math 34 | 35 | (reduce args (fn (a b) (if (< a b) a b)))) 36 | 37 | (defn max args 38 | "Returns the maximum value of its arguments" 39 | :cat :math 40 | 41 | (reduce args (fn (a b) (if (> a b) a b)))) 42 | -------------------------------------------------------------------------------- /mk/common.mk: -------------------------------------------------------------------------------- 1 | prefix := /usr/local 2 | exec_prefix = $(prefix) 3 | bindir = $(exec_prefix)/bin/ 4 | 5 | AFL_CC := afl-gcc 6 | AFL_FUZZ := afl-fuzz 7 | FUZZ_NUJEL := fuzz-nujel 8 | CC := cc 9 | CAT := cat 10 | AR := ar 11 | INSTALL := install 12 | STRIP := strip 13 | 14 | EMCC := emcc 15 | EMAR := emar 16 | EMMEM := -s TOTAL_MEMORY=96MB -s ALLOW_MEMORY_GROWTH=1 17 | 18 | NUJEL := nujel 19 | FUTURE_NUJEL := future-nujel 20 | PROG = $(NUJEL) 21 | 22 | CC_MUSL := musl-gcc 23 | CFLAGS := -g -D_GNU_SOURCE 24 | CINCLUDES := 25 | LDFLAGS := 26 | CSTD := -std=c99 27 | OPTIMIZATION := -O2 28 | WARNINGS := -Wall -Werror -Wextra -Wshadow -Wcast-align -Wno-missing-braces 29 | 30 | LIBS := -lm 31 | 32 | RELEASE_OPTIMIZATION := -O3 33 | VERSION_ARCH := $(shell uname -m) 34 | 35 | WASI_CLANG := clang 36 | WASI_STRIP := llvm-strip 37 | WASI_SDK_PATH := /usr/share/wasi-sysroot/ 38 | -------------------------------------------------------------------------------- /tests/fast/day1.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | ; https://adventofcode.com/2021/day/1 3 | 4 | (def example-list '(199 200 208 210 200 207 240 269 260 263)) 5 | 6 | (defn count-increases (l) 7 | "Compares every two items in L and increments a counter if the value increases" 8 | (def acc 0) 9 | (while (and l (cdr l)) 10 | (when (> (cadr l) (car l)) 11 | (inc! acc)) 12 | (cdr! l)) 13 | acc) 14 | 15 | (defn build-sums (l) 16 | "Build sums out of 3 values with a sliding window" 17 | (def ret #nil) 18 | (while (and l (cdr l) (cddr l)) 19 | (set! ret (cons (+ (car l) (cadr l) (caddr l)) ret)) 20 | (cdr! l)) 21 | (nreverse ret)) 22 | 23 | (def result (count-increases example-list)) 24 | (when (not= result 7) (throw (list :wrong-result "Wrong result" result))) 25 | 26 | (def result (count-increases (read (file/read "tests/fast/day1.dat")))) 27 | (when (not= result 1711) (throw (list :wrong-result "Wrong result" result))) 28 | 29 | (def result (count-increases (build-sums (read (file/read "tests/fast/day1.dat"))))) 30 | (when (not= result 1743) (throw (list :wrong-result "Wrong result" result))) 31 | 32 | (return :success) 33 | -------------------------------------------------------------------------------- /tests/testsuite/string.nuj: -------------------------------------------------------------------------------- 1 | (888 (-> (range 200) 2 | (map :string) 3 | (join ", ") 4 | (:length))) 5 | (2328731233 (import (hash) :crypto/adler32) 6 | (-> (range 200) 7 | (map :string) 8 | (join ", ") 9 | hash)) 10 | (1091 (-> (range 200) 11 | (map :string) 12 | string/write 13 | :length)) 14 | ("" (:cut "\n" 1 1)) 15 | ("" (:cut "\n" 1 -1)) 16 | ("" (:cut "Hallo, Welt!" 0 -5)) 17 | ("" (:cut "Hallo, Welt!" 15 5)) 18 | ("Hallo" (:cut "Hallo, Welt!" 0 5)) 19 | ("Welt" (:cut "Hallo, Welt!" 7 11)) 20 | ("" (:cut "asd" 0 -1)) 21 | ("a" (:cut "asd" -10 1)) 22 | ("a" (:cut "asd" 0 1)) 23 | ("s" (:cut "asd" 1 2)) 24 | ("sd" (:cut "asd" 1 3)) 25 | ("d" (:cut "asd" 2 3)) 26 | ("" (:cut "asd" 3 4)) 27 | (7 (:index-of "Dies ist ein Test" "t")) 28 | (16 (:last-index-of "Dies ist ein Test" "t")) 29 | (1 (:index-of "1,2,3" ",")) 30 | (0 (:index-of "1,2,3" "1")) 31 | (-1 (:index-of "1,2,3" "0")) 32 | (2 (:index-of "1,2,3" "2")) 33 | (4 (:index-of "1,2,3" "3")) 34 | (3 (:last-index-of "1,2,3" ",")) 35 | (0 (:last-index-of "1,2,3" "1")) 36 | (-1 (:last-index-of "1,2,3" "4")) 37 | (2 (:last-index-of "1,2,3" "2")) 38 | (4 (:last-index-of "1,2,3" "3")) 39 | -------------------------------------------------------------------------------- /stdlib/core/opcodes.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; Contains some functions so that opcodes can be used as functions 5 | 6 | (defn < (a b) 7 | "Less than comparator" 8 | (< a b)) 9 | 10 | (defn <= (a b) 11 | "Less or equal comparator" 12 | (<= a b)) 13 | 14 | (defn = (a b) 15 | "Equality comparator" 16 | (= a b)) 17 | 18 | (defn not= (a b) 19 | "Inequality comparator" 20 | (not= a b)) 21 | 22 | (defn >= (a b) 23 | "Greater or equal comparator" 24 | (>= a b)) 25 | 26 | (defn > (a b) 27 | "Greater than comparator" 28 | (> a b)) 29 | 30 | (defn car (pair) 31 | "Return the head of PAIR" 32 | (car pair)) 33 | 34 | (defn cdr (pair) 35 | "Return the rest of PAIR" 36 | (cdr pair)) 37 | 38 | (defn cadr (pair) 39 | "Return the cadr of PAIR" 40 | (cadr pair)) 41 | 42 | (defn cons (a b) 43 | "Construct a new pair of A and B" 44 | (cons a b)) 45 | 46 | (defn nil? (a) 47 | "Check whether a is #nil" 48 | (= a #nil)) 49 | 50 | (defn zero? (a) 51 | "Check whether a is 0" 52 | (= a 0)) 53 | -------------------------------------------------------------------------------- /stdlib/compiler/backend.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; Contains an abstraction that allows for multiple backends, right now we only 5 | ;;; support :bytecode and :none (:none is lowered Nujel, with most of the sugar removed). 6 | 7 | (defn compile/backend/none (expr env) 8 | :internal 9 | expr) 10 | 11 | (defn compile/backend/bytecode (expr env) 12 | :internal 13 | (-> (bytecompile expr env) 14 | (assemble* env))) 15 | 16 | (def *active-backend* :bytecode) 17 | (def backend/tree { :bytecode compile/backend/bytecode 18 | :none compile/backend/none}) 19 | 20 | (defn backend (expr env) 21 | :internal 22 | ((ref backend/tree *active-backend*) expr env)) 23 | 24 | (defn compile/for (backend expr environment) 25 | (def last-backend *active-backend*) 26 | (def ret #nil) 27 | (try (fn (e) 28 | (set! *active-backend* last-backend) 29 | (throw e)) 30 | (set! *active-backend* backend) 31 | (set! ret (compile expr environment)) 32 | (set! *active-backend* last-backend) 33 | (return ret))) 34 | -------------------------------------------------------------------------------- /stdlib/string/char.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; Some convenience functions for dealing with characters 5 | 6 | (defn lower-case-char (c) 7 | (if (< c 65) 8 | c 9 | (if (> c 90) 10 | c 11 | (+ c 32)))) 12 | 13 | (defn upper-case-char (c) 14 | (if (< c 97) 15 | c 16 | (if (> c 122) 17 | c 18 | (+ c -32)))) 19 | 20 | (defn whitespace? (c) 21 | "Return #t if C is a whitespace char" 22 | (or (= c #x20) ; Space 23 | (= c #x09) ; Tabl 24 | (and (>= c #x0a) 25 | (<= c #x0d)))) 26 | 27 | (defn from-char-code l 28 | "Turn the provided char codes into a string and return it" 29 | (def buf (buffer/allocate (:length l))) 30 | (dotimes (i (:length buf) (buffer->string buf)) 31 | (when (or (not (int? (car l))) 32 | (> (car l) 255) 33 | (< (car l) 0)) 34 | (exception :type-error "(from-char-code) expects :int arguments from 0 to 255, not: " (car l))) 35 | (set! buf i (car l)) 36 | (cdr! l))) 37 | -------------------------------------------------------------------------------- /tests/testsuite/casting.nuj: -------------------------------------------------------------------------------- 1 | (1 (read/int "1")) 2 | (1 (read/int "1.0")) 3 | (1 (read/int "1.2")) 4 | (1 (read/int " \n\t1")) 5 | (-1 (read/int "-1")) 6 | (-1 (read/int " -1")) 7 | (:type-error (try car (let ((a 10)) (when (when #t (set! a (+ 2 "2")) #f) (set! a -1)) a))) 8 | ;(:type-error (try car (apply (fn (α) (+ 1 α))))) 9 | ;(:type-error (try car (def cb (fn (α) (+ 1 α))) (apply cb))) 10 | ;(:type-error (try car (let ((cb (fn (α) (+ 1 α)))) (apply cb)))) 11 | ;(:type-error (try car (let* (def cb (fn (α) (+ 1 α))) (apply cb)))) 12 | (:type-error (try car (+ '1 '(2)))) 13 | (:type-error (try car (- '1 '(2)))) 14 | (:type-error (try car (- '1 '(2 3)))) 15 | (:type-error (try (fn (e) (car e)) (+ "1" "2"))) 16 | (:type-error (try (fn (e) (car e)) (sin 1))) 17 | (:type-error (try (fn (e) (car e)) (ceil 1))) 18 | (:type-error (try (fn (e) (car e)) (floor 1))) 19 | (:type-error (try (fn (e) (car e)) (round 1))) 20 | (:type-error (try car (+ #x10#f))) 21 | (:type-error (try car (+ #x10"16"))) 22 | (:type-error (try car (int "8"))) 23 | ;(:type-error (try car (+ (cadr '(1 2)) (cadr #nil) (cadr '(1))))) 24 | (:type-error (try car (int "a1"))) 25 | (:type-error (try car (int "1a"))) 26 | (:type-error (try car (int "1 a"))) 27 | (:type-error (try car (def cb '+) (apply cb))) 28 | (#t (= (:symbol "asd") (:symbol :asd))) 29 | -------------------------------------------------------------------------------- /tests/slow/day16.dat: -------------------------------------------------------------------------------- 1 | E20D79005573F71DA0054E48527EF97D3004653BB1FC006867A8B1371AC49C801039171941340066E6B99A6A58B8110088BA008CE6F7893D4E6F7893DCDCFDB9D6CBC4026FE8026200DC7D84B1C00010A89507E3CCEE37B592014D3C01491B6697A83CB4F59E5E7FFA5CC66D4BC6F05D3004E6BB742B004E7E6B3375A46CF91D8C027911797589E17920F4009BE72DA8D2E4523DCEE86A8018C4AD3C7F2D2D02C5B9FF53366E3004658DB0012A963891D168801D08480485B005C0010A883116308002171AA24C679E0394EB898023331E60AB401294D98CA6CD8C01D9B349E0A99363003E655D40289CBDBB2F55D25E53ECAF14D9ABBB4CC726F038C011B0044401987D0BE0C00021B04E2546499DE824C015B004A7755B570013F2DD8627C65C02186F2996E9CCD04E5718C5CBCC016B004A4F61B27B0D9B8633F9344D57B0C1D3805537ADFA21F231C6EC9F3D3089FF7CD25E5941200C96801F191C77091238EE13A704A7CCC802B3B00567F192296259ABD9C400282915B9F6E98879823046C0010C626C966A19351EE27DE86C8E6968F2BE3D2008EE540FC01196989CD9410055725480D60025737BA1547D700727B9A89B444971830070401F8D70BA3B8803F16A3FC2D00043621C3B8A733C8BD880212BCDEE9D34929164D5CB08032594E5E1D25C0055E5B771E966783240220CD19E802E200F4588450BC401A8FB14E0A1805B36F3243B2833247536B70BDC00A60348880C7730039400B402A91009F650028C00E2020918077610021C00C1002D80512601188803B4000C148025010036727EE5AD6B445CC011E00B825E14F4BBF5F97853D2EFD6256F8FFE9F3B001420C01A88915E259002191EE2F4392004323E44A8B4C0069CEF34D304C001AB94379D149BD904507004A6D466B618402477802E200D47383719C0010F8A507A294CC9C90024A967C9995EE2933BA840 -------------------------------------------------------------------------------- /benchmark/adler32/adler32.lisp: -------------------------------------------------------------------------------- 1 | (defun read-file (path) 2 | (declare (type (or pathname string) path)) 3 | (let ((data (make-array 0 :element-type '(unsigned-byte 8) :adjustable t)) 4 | (block-size 4096) 5 | (offset 0)) 6 | (with-open-file (file path :element-type '(unsigned-byte 8)) 7 | (loop 8 | (let* ((capacity (array-total-size data)) 9 | (nb-left (- capacity offset))) 10 | (when (< nb-left block-size) 11 | (let ((new-length (max (+ capacity (- block-size nb-left)) 12 | (floor (* capacity 3) 2)))) 13 | (setf data (adjust-array data new-length))))) 14 | (let ((end (read-sequence data file :start offset))) 15 | (when (= end offset) 16 | (return-from read-file (adjust-array data end))) 17 | (setf offset end)))))) 18 | (compile 'read-file) 19 | 20 | (defun adler32 (bv) 21 | (let ((a 1) 22 | (b 0)) 23 | (dotimes (i (length bv)) 24 | (setf a (mod (+ a (aref bv i)) 65521)) 25 | (setf b (mod (+ a b) 65521)) 26 | (format T "~a ~a~%" a b)) 27 | (logior a (ash b 16)))) 28 | (compile 'adler32) 29 | 30 | (defun adler32-file (filename) 31 | (format T "~%~X ~a ADLER32~%" (adler32 (read-file filename)) filename)) 32 | 33 | ;(adler32-file "test-files/r5rs.pdf") 34 | (adler32-file "test") 35 | -------------------------------------------------------------------------------- /tests/fast/long-literal-test.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (try (fn (e) 4 | (when (not= (car e) :read-error) 5 | (throw e))) 6 | (read/single "1,4,2,4,5,3,5,2,2,5,2,1,2,4,5,2,3,5,4,3,3,1,2,3,2,1,4,4,2,1,1,4,1,4,4,4,1,4,2,4,3,3,3,3,1,1,5,4,2,5,2,4,2,2,3,1,2,5,2,4,1,5,3,5,1,4,5,3,1,4,5,2,4,5,3,1,2,5,1,2,2,1,5,5,1,1,1,4,2,5,4,3,3,1,3,4,1,1,2,2,2,5,4,4,3,2,1,1,1,1,2,5,1,3,2,1,4,4,2,1,4,5,2,5,5,3,3,1,3,2,2,3,4,1,3,1,5,4,24,2,4,5,3,5,2,2,5,2,1,2,4,5,,5,2,4,1,5,1,4,5,1,2,4,4,1,4,1,4,4,2,2,5,4,1,3,1,3,3,1,5,1,5,5,5,1,3,1,2,1,4,5,4,4,1,3,3,1,4,1,2,1,3,2,1,5,5,3,3,1,3,5,1,5,3,5,3,1,1,1,1,4,4,3,5,5,1,1,2,2,5,5,3,2,5,2,3,4,4,1,1,2,2,4,3,5,5,1,1,5,4,3,1,3,1,2,4,4,4,4,1,4,3,4,1,3,5,5,5,1,3,5,4,3,1,3,5,4,4,3,4,2,1,1,3,1,1,2,4,1,4-1,1,1,5,5,1,3,4,1,1,5,1,4,2,4,5,3,5,2,2,5,2,1,2,4,5,2,3,5,4,3,3,1,2,3,2,1,4,4,2,1,1,4,1,4,4,4,1,4,2,4,3,3,3,3,1,1,5,4,2,5,2,4,2,2,3,1,2,5,2,4,1,5,3,5,1,4,5,3,1,4,5,2,4,5,3,1,2,5,1,2,2,1,5,5,1,1,1,4,2,5,4,3,3,1,3,4,1,1,2,2,2,5,4,4,3,2,1,1,1,1,2,5,1,3,2,1,4,4,2,1,4,5,2,5,5,3,3,1,3,2,2,3,4,1,3,1,5,4,24,2,4,5,3,5,2,2,5,2,1,2,4,5,,5,2,4,1,5,1,4,5,1,2,4,4,1,4,1,4,4,2,2,5,4,1,3,1,3,3,1,5,1,5,5,5,1,3,1,2,1,4,5,4,4,1,3,3,1,4,1,2,1,3,2,1,5,5,3,3,1,3,5,1,5,3,5,3,1,1,1,1,4,4,3,5,5,1,1,2,2,5,5,3,2,5,2,3,4,4,1,1,2,2,4,3,5,5,1,1,5,4,3,1,3,1,2,4,4,4,4,1,4,3,4,1,3,5,5,5,1,3,5,4,3,1,3,5,4,4,3,4,2,1,1,3,1,1,2,4,1,4-1,1,1,5,5,1,3,4,1,1,5,")) 7 | (return :success) 8 | -------------------------------------------------------------------------------- /tests/testsuite/exception.nuj: -------------------------------------------------------------------------------- 1 | (:float-inf (try car (/ 3 0))) 2 | (:test (try (fn (e) :test) (/ 3 0))) 3 | (:test (try car (try (fn (e) :test) (/ 3 0)))) 4 | (:inner (try (fn (e) :outer) (try (fn (e) :inner) (throw :asd)))) 5 | (:outer (try (fn (e) :outer) (try (fn (e) :inner) 1) (throw :asd))) 6 | (#t (try (fn (error) (string? (cadr error))) (/ 3 0))) 7 | (:success (try (fn (error) (car error)) (throw '(:success)) :failure)) 8 | ('(123) (try (fn (error) error) (throw 123) 0)) 9 | ('(#t) (try (fn (error) error) (throw #t) #f)) 10 | ("asd" (try (fn (error) (car error)) (throw '("asd")) #nil)) 11 | (:test-exception (try (fn (error) (car error)) (throw (list :test-exception "Testing the exception system")) #nil)) 12 | (#t (try (fn (error) (string? (cadr error))) (throw (list :test-exception "Testing the exception system")) #nil)) 13 | (:float-inf (try (fn (err) (car err)) (try (fn (err) (/ 3 0) err) (throw :test-exception)))) 14 | (:float-inf (try (fn (err) (car err)) (/ 3 0))) 15 | (:float-inf (try (fn (err) (car err)) (try (fn (error) (/ 3 0) error) (throw :test-exception)))) 16 | (:float-inf (try (fn (err) (car err)) (/ 1.0 0.0))) 17 | (:float-nan (try (fn (err) (car err)) (/ 0.0 0.0))) 18 | (:float-inf (try (fn (err) (car err)) (/ -1.0 0.0))) 19 | (:invalid-let-form (try (fn (err) (car err)) (macroexpand (let (1) 1)))) 20 | (:invalid-let-form (try car (macroexpand (let (() 1) 1)))) 21 | -------------------------------------------------------------------------------- /tests/fast/day14.dat: -------------------------------------------------------------------------------- 1 | OOVSKSPKPPPNNFFBCNOV 2 | 3 | BC -> C 4 | PP -> O 5 | SK -> K 6 | KH -> N 7 | OK -> S 8 | PC -> O 9 | VP -> K 10 | CF -> K 11 | HC -> H 12 | FV -> V 13 | PB -> P 14 | NK -> H 15 | CK -> F 16 | FH -> H 17 | SV -> B 18 | NH -> C 19 | CP -> S 20 | HP -> O 21 | HS -> O 22 | BK -> B 23 | KC -> P 24 | VV -> B 25 | OF -> O 26 | KP -> V 27 | FO -> V 28 | FK -> V 29 | VH -> K 30 | KB -> P 31 | KF -> H 32 | SH -> S 33 | HF -> O 34 | BB -> F 35 | FC -> O 36 | SO -> S 37 | BS -> O 38 | HH -> C 39 | BO -> S 40 | CO -> F 41 | VC -> V 42 | KS -> N 43 | OC -> N 44 | FP -> P 45 | HN -> B 46 | HV -> V 47 | HO -> P 48 | KO -> C 49 | SF -> H 50 | NO -> N 51 | PS -> C 52 | BP -> K 53 | SC -> C 54 | NP -> C 55 | CH -> V 56 | KV -> B 57 | HK -> V 58 | OP -> V 59 | SP -> V 60 | NC -> V 61 | FF -> B 62 | CC -> V 63 | CS -> F 64 | SB -> C 65 | OS -> C 66 | FN -> O 67 | CV -> P 68 | OH -> H 69 | OO -> P 70 | PO -> F 71 | NS -> H 72 | VB -> K 73 | OV -> K 74 | PH -> H 75 | BH -> V 76 | SS -> B 77 | PK -> F 78 | VK -> O 79 | BN -> V 80 | VF -> O 81 | PF -> H 82 | VS -> K 83 | ON -> V 84 | BF -> F 85 | CN -> F 86 | VO -> B 87 | FS -> K 88 | OB -> B 89 | PN -> H 90 | NF -> O 91 | VN -> P 92 | BV -> S 93 | NV -> V 94 | FB -> V 95 | NB -> P 96 | CB -> B 97 | KK -> S 98 | NN -> F 99 | SN -> B 100 | HB -> P 101 | PV -> S 102 | KN -> S -------------------------------------------------------------------------------- /docs/stable/1.3-numbers.md: -------------------------------------------------------------------------------- 1 | [ 2 | [1.2 - Comments](./1.2-comments.md) 3 | | 4 | [1.4 - Arithmetic](./1.4-arithmetic.md) 5 | ] 6 | 7 | -------- 8 | 9 | # Numbers 10 | Nujel supports normal decimal notation and treats `,` and `_` as whitespace characters so you can split big numbers for increased legibility. There is also special syntax for binary, octal and hexadecimal literals. Scientific notation is **not** supported. 11 | ```scheme 12 | 9 ; probably not that suprising 13 | ; => 9 14 | 15 | 100,0; possible, but probably shouldn't be commited that way 16 | ; => 1000 17 | 18 | 1,0,0,0; also a possibility... 19 | ; => 1000 20 | 21 | 1,000 ; much better! 22 | ; => 1000 23 | 24 | 1_000 ; Underscore is also workable, although mostly preferrable for non decimal literals 25 | ; => 1000 26 | 27 | #b10000 ; This way we can write binary literals 28 | ; => 16 29 | 30 | #b0001_0000 ; Especially here does it become useful that we can use _ and , to split our literal wherever we choose 31 | ; => 16 32 | 33 | #x12_34 ; Also helps for hex literals 34 | ; => 4660 35 | 36 | #o10 ; Octal literals are also possible 37 | ; => 8 38 | 39 | 0x123 ; Using an 0x prefix does NOT work and results in a read error being thrown 40 | ; => :read-error 41 | 42 | -100 ; You can also write negative numbers 43 | 44 | ``` 45 | 46 | -------- 47 | 48 | [ 49 | [1.2 - Comments](./1.2-comments.md) 50 | | 51 | [1.4 - Arithmetic](./1.4-arithmetic.md) 52 | ] -------------------------------------------------------------------------------- /stdlib_modules/crypto/adler32.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; Simple implementation of adler32 5 | 6 | (defn hash (data) 7 | :export 8 | (def a 1) 9 | (def b 0) 10 | (when (and (not= (:type-name data) :buffer) 11 | (not= (:type-name data) :string)) 12 | (exception :type-error "Can only hash buffers or strings")) 13 | (dotimes (i (:length data)) 14 | (set! a (mod/int (add/int a (ref data i)) 65521)) 15 | (set! b (mod/int (add/int a b) 65521))) 16 | (bit-or a (bit-shift-left b 16))) 17 | 18 | (deftest "00620062" (fmt "{:08X}" (crypto/adler32/hash "a"))) 19 | (deftest "0F9D02BC" (fmt "{:08X}" (crypto/adler32/hash "asdQWE123"))) 20 | (deftest "796B110D" (fmt "{:08X}" (crypto/adler32/hash "DiesIstEinTestDerNujelAdler32Implementierung"))) 21 | 22 | (defn main (args) 23 | :export 24 | (when (not (car args)) 25 | (efmtln "Usage: (...FILES)") 26 | (exit 1)) 27 | (doseq (file args) 28 | (if (file/dir? file) 29 | (pfmtln "nujel/adler32: {file}: Is a directory") 30 | (if (file/file? file) 31 | (pfmtln "{:08X} {file} ADLER32" (hash (slurp/buffer file))) 32 | (pfmtln "nujel/adler32: {file}: No such file or directory"))))) 33 | -------------------------------------------------------------------------------- /docs/stable/1.2-comments.md: -------------------------------------------------------------------------------- 1 | [ 2 | [1.1 - Parentheses](./1.1-parentheses.md) 3 | | 4 | [1.3 - Numbers](./1.3-numbers.md) 5 | ] 6 | 7 | -------- 8 | 9 | # Comments 10 | Comments use Scheme syntax, and some SRFI's have been implemented directly. 11 | ```scheme 12 | ; A single semicolon comments out everything until the next line 13 | (+ 1 #;2 3) ; You can use #; to comment out the following form, should be SRFI-62 compatible! 14 | ; => 4 15 | #| 16 | | Nujel also allows for SRFI-30 like nested Multi-line comments 17 | |# 18 | [comment [println "A message, never to be printed."]] ; Nujel also has a comment macro, this however returns #nil unlike #; 19 | ``` 20 | 21 | Apart from that it is recommended to use a single `;` at the end of a line to comment whatever is happening on that particular line. 22 | 23 | If however you would like to comment a bigger section of code you should put 2 `;;` at the beginning of the line. 24 | 25 | For top-level comments describing the entire file try and use 3 `;;;` at the beginning of the lines. 26 | 27 | The comment macro is mostly useful for usage with `nujel-mode` since you can easily evaluate commented out forms. Beware however that everything within a comment macro needs to be a valid Nujel S-Expression! 28 | 29 | This is in accordance with *Scheme*, *Common Lisp* as well as *Clojure* best practices. 30 | 31 | -------- 32 | 33 | [ 34 | [1.1 - Parentheses](./1.1-parentheses.md) 35 | | 36 | [1.3 - Numbers](./1.3-numbers.md) 37 | ] -------------------------------------------------------------------------------- /stdlib_modules/games/guess.nuj: -------------------------------------------------------------------------------- 1 | (require :ansi) 2 | (import (rng) :random) 3 | 4 | (defn win (guesses-left) 5 | (pfmtln "Fantastic, {} with {guesses-left} guesses left." (ansi/rainbow "you won")) 6 | (pfmtln "Hope you had fun and have a nice day!") 7 | (exit 0)) 8 | 9 | (defn loose () 10 | (pfmtln "Too bad, you didn't guess the number in time, maybe next time.") 11 | (pfmtln "Hope you still had fun, have a nice day!") 12 | (exit 0)) 13 | 14 | (defn quit () 15 | (pfmtln "Bye!") 16 | (exit 0)) 17 | 18 | (defn main (args) 19 | :export 20 | (println (ansi/rainbow "Guess the number!!!")) 21 | (println "") 22 | (println "You have 10 tries, with every guess I will tell you if it was too high or too low, the number is in the range of 0 to 100") 23 | (def rand (:new rng)) 24 | (def guesses-left 10) 25 | (def number (:int rand 100)) 26 | (while (> guesses-left 0) 27 | (def line (readline (fmt "Your {} guess? " (cond ((= guesses-left 1) (ansi/red "final")) 28 | (#t (- 11 guesses-left)))))) 29 | (when-not line (quit)) 30 | (def cur-guess (read/int line)) 31 | (when (= number cur-guess) 32 | (win guesses-left)) 33 | (if (< cur-guess number) 34 | (println "Too low") 35 | (println "Too high")) 36 | (set! guesses-left (- guesses-left 1))) 37 | (loose)) 38 | -------------------------------------------------------------------------------- /benchmark/adler32/adler32.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | 6 | uint32_t adler32(const void *msg, size_t len) { 7 | uint32_t a = 1; 8 | uint32_t b = 0; 9 | const uint8_t *p = msg; 10 | for (int i=0;i b num) 1 0))) 0))) 0)) 35 | 36 | (defn parse/line (line) 37 | (line/draw-vents (tree/zip '(:b :a) (map (split line "->") parse/point)))) 38 | 39 | (def vents (array/2d/new 1000 1000 0)) 40 | (def lines (split (file/read "tests/slow/day5.input") "\n")) 41 | (for-each lines parse/line) 42 | (when (not= (points/count vents 1) 21305) 43 | (throw (list :wrong-result "Wrong result" result))) 44 | 45 | (return :success) 46 | -------------------------------------------------------------------------------- /stdlib_modules/random.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; A very simple pseudo random number generator, suitable for the illusion of 5 | ;;; randomness 6 | (defclass rng 7 | "A simple RNG" 8 | :export 9 | 10 | (defn new (self seed) 11 | (when-not seed (set! seed (bit-xor (time) (time/milliseconds)))) 12 | { :seed seed :prototype* self }) 13 | 14 | (defn seed! (self seed) 15 | "Set a new seed value for the RNG" 16 | (set! self.seed seed)) 17 | 18 | (defn rng! (self) 19 | "Generate a random integer" 20 | (set! self.seed (+ 12345 (* self.seed 1103515245))) 21 | (bit-or (bit-shift-left (bit-and self.seed #xFFFF) 16) 22 | (bit-and (bit-shift-right self.seed 16) #xFFFF))) 23 | 24 | (defn int (self max) 25 | "Return a value from 0 to MAX, or, if left out, a random int" 26 | (if max (rem (abs (:rng! self)) max) (:rng! self)))) 27 | 28 | (deftest #t (int? (:int (:new random/rng)))) 29 | (deftest #t (def r (:new random/rng)) (:seed! r 123) (def first-value (:int r)) (:seed! r 123) (= first-value (:int r))) 30 | (deftest #t (def r (:new random/rng)) (:seed! r 99) (not= (:int r) (:int r))) 31 | (deftest #t (int? (-> (:new random/rng) :int))) 32 | (deftest #t (def rng (:new random/rng 123)) (def a (:int rng)) (:seed! rng 123) (= (:int rng) a)) 33 | (deftest #t (def rng (:new random/rng 99)) (not= (:int rng) (:int rng))) 34 | -------------------------------------------------------------------------------- /Nujel.sln: -------------------------------------------------------------------------------- 1 | 2 | Microsoft Visual Studio Solution File, Format Version 12.00 3 | # Visual Studio Version 17 4 | VisualStudioVersion = 17.2.32526.322 5 | MinimumVisualStudioVersion = 10.0.40219.1 6 | Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "Nujel", "Nujel.vcxproj", "{0706930F-24DC-493B-B0B9-8AC5BE4FBDCE}" 7 | EndProject 8 | Global 9 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 10 | Debug|x64 = Debug|x64 11 | Debug|x86 = Debug|x86 12 | Release|x64 = Release|x64 13 | Release|x86 = Release|x86 14 | EndGlobalSection 15 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 16 | {0706930F-24DC-493B-B0B9-8AC5BE4FBDCE}.Debug|x64.ActiveCfg = Debug|x64 17 | {0706930F-24DC-493B-B0B9-8AC5BE4FBDCE}.Debug|x64.Build.0 = Debug|x64 18 | {0706930F-24DC-493B-B0B9-8AC5BE4FBDCE}.Debug|x86.ActiveCfg = Debug|Win32 19 | {0706930F-24DC-493B-B0B9-8AC5BE4FBDCE}.Debug|x86.Build.0 = Debug|Win32 20 | {0706930F-24DC-493B-B0B9-8AC5BE4FBDCE}.Release|x64.ActiveCfg = Release|x64 21 | {0706930F-24DC-493B-B0B9-8AC5BE4FBDCE}.Release|x64.Build.0 = Release|x64 22 | {0706930F-24DC-493B-B0B9-8AC5BE4FBDCE}.Release|x86.ActiveCfg = Release|Win32 23 | {0706930F-24DC-493B-B0B9-8AC5BE4FBDCE}.Release|x86.Build.0 = Release|Win32 24 | EndGlobalSection 25 | GlobalSection(SolutionProperties) = preSolution 26 | HideSolutionNode = FALSE 27 | EndGlobalSection 28 | GlobalSection(ExtensibilityGlobals) = postSolution 29 | SolutionGuid = {94CA3522-0610-4E77-9A5E-8FC5CC3D173A} 30 | EndGlobalSection 31 | EndGlobal 32 | -------------------------------------------------------------------------------- /bin/environment.c: -------------------------------------------------------------------------------- 1 | /* Nujel - Copyright (C) 2020-2022 - Benjamin Vincent Schulenburg 2 | * This project uses the MIT license, a copy should be included under /LICENSE */ 3 | #ifndef NUJEL_AMALGAMATION 4 | #include "private.h" 5 | #endif 6 | 7 | #ifndef _MSC_VER 8 | #include 9 | #endif 10 | 11 | /* Add environment key/value pair to tree T */ 12 | static lTree *addVar(const char *e, lTree *t){ 13 | int endOfKey, endOfString; 14 | for(endOfKey=0;e[endOfKey] != '=';endOfKey++){} 15 | for(endOfString=endOfKey+1;e[endOfString];endOfString++){} 16 | lSymbol *sym = lSymSL(e,endOfKey); 17 | lVal v = lValString(&e[endOfKey+1]); 18 | return lTreeInsert(t, sym, v); 19 | } 20 | 21 | #if (defined(__MSYS__)) || (defined(__MINGW32__)) || (defined(_WIN32)) 22 | #include 23 | 24 | /* Windows specific - add Environment args to `environment/variables` */ 25 | void lRedefineEnvironment(lClosure *c){ 26 | lTree *t = NULL; 27 | LPCH env = GetEnvironmentStrings(); 28 | while(*env){ 29 | t = addVar(env,t); 30 | while(*env++){} 31 | } 32 | lDefineClosureSym(c,lSymS("System/Environment"), lValTree(t)); 33 | } 34 | 35 | #else 36 | extern char **environ; 37 | /* Add Environment args to `environment/variables` */ 38 | void lRedefineEnvironment(lClosure *c){ 39 | lTree *t = NULL; 40 | #ifdef __wasi__ 41 | t = addVar("PATH=",t); // Necessary so that tests don't fail 42 | #endif 43 | for(int i=0;environ[i];i++){ 44 | t = addVar(environ[i],t); 45 | } 46 | lDefineClosureSym(c,lSymS("System/Environment"), lValTree(t)); 47 | } 48 | #endif 49 | -------------------------------------------------------------------------------- /tests/slow/day7.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (def real-data (apply array/new (map (split (file/read "tests/slow/day7.input") ",") read/int))) 4 | 5 | (defn fancy/calc () 6 | (def ret (:alloc Array 2000)) 7 | (def acc 0) 8 | (dotimes (i 2000) 9 | (set! acc (+ acc i)) 10 | (set! ret i acc)) 11 | ret) 12 | (def fancy (fancy/calc)) 13 | 14 | (defn calc/mm (data pred) (reduce data (fn (a b) (if (pred b a) b a)) (ref data 0))) 15 | (defn calc/min (data) (calc/mm data <)) 16 | (defn calc/max (data) (calc/mm data >)) 17 | (defn calc/fuel/simple (data pos) (reduce data (fn (a b) (+ a (abs (- b pos)))) 0)) 18 | (defn calc/fuel/complex (data pos) (reduce data (fn (a b) (+ a (ref fancy (abs (- b pos))))) 0)) 19 | (defn calc/optimal (data calc/fuel) 20 | (def cmin (calc/min data)) 21 | (def cmax (calc/max data)) 22 | (def ret-pos cmin) 23 | (def ret-fuel (calc/fuel data cmin)) 24 | (def i (+ 1 cmin)) 25 | (while (< i cmax) 26 | (def new-fuel (calc/fuel data i)) 27 | (when (< new-fuel ret-fuel) 28 | (do (set! ret-pos i) 29 | (set! ret-fuel new-fuel))) 30 | (set! i (add/int i 1))) 31 | {:pos ret-pos :fuel ret-fuel}) 32 | 33 | (def result (calc/optimal real-data calc/fuel/simple)) 34 | (when (not= (ref result :fuel) 355989) 35 | (throw (list :wrong-result "Wrong result" result))) 36 | (def result (calc/optimal real-data calc/fuel/complex)) 37 | (when (not= (ref result :fuel) 102245489) 38 | (throw (list :wrong-result "Wrong result" result))) 39 | 40 | (return :success) 41 | -------------------------------------------------------------------------------- /tests/testsuite/image.nuj: -------------------------------------------------------------------------------- 1 | (-123 (image/deserialize (image/serialize -123))) 2 | (123 (image/deserialize (image/serialize 123))) 3 | (123.321 (image/deserialize (image/serialize 123.321))) 4 | (#f (image/deserialize (image/serialize #f))) 5 | (#t (image/deserialize (image/serialize #t))) 6 | (" 0123" (buffer->string (image/deserialize (image/serialize #m2030313233)))) 7 | ("asdq" (image/deserialize (image/serialize "asdq"))) 8 | ("asdq" (image/deserialize (image/serialize "asdq"))) 9 | ("asd" (image/deserialize (image/serialize "asd"))) 10 | ("" (image/deserialize (image/serialize ""))) 11 | ('(1 2 3) (image/deserialize (image/serialize '(1 2 3)))) 12 | ('(1 "qwe" :asd) (image/deserialize (image/serialize '(1 "qwe" :asd)))) 13 | ([1 2 3] (image/deserialize (image/serialize [1 2 3]))) 14 | ([:a :a :a :a :a] (image/deserialize (image/serialize [:a :a :a :a :a]))) 15 | ([1 "qwe" :asd] (image/deserialize (image/serialize [1 "qwe" :asd]))) 16 | ([['(1 2 3)] "qwe" :asd] (image/deserialize (image/serialize [['(1 2 3)] "qwe" :asd]))) 17 | ({:a 1 :b 2 :c 3} (image/deserialize (image/serialize {:a 1 :b 2 :c 3}))) 18 | (Int (image/deserialize (image/serialize Int))) 19 | (nreverse (image/deserialize (image/serialize nreverse))) 20 | (stdin* (image/deserialize (image/serialize stdin*))) 21 | ('("asd" . "asd") (image/deserialize (image/serialize (let ((t "asd")) (cons t t))))) 22 | (8 (defn double (a) (* a 2)) (:parent! double #nil) ((image/deserialize (image/serialize double)) 4)) 23 | ;(2 ((image/deserialize (image/serialize min)) 2 4)) 24 | ;(let* (defn double (a) (* a 2)) (:parent! double #nil) (write (image/deserialize (image/serialize double)))) 25 | -------------------------------------------------------------------------------- /stdlib_modules/array/2d.nuj: -------------------------------------------------------------------------------- 1 | ;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;; 4 | ;; Contains some routines for working with 2d data 5 | 6 | (defn allocate (width height) 7 | :export 8 | { :data (-> (:alloc Array (* width height)) 9 | (array/fill! 0)) 10 | :width width 11 | :height height}) 12 | 13 | (defn fill! (data v) 14 | :export 15 | (array/fill! (ref data :data) v) 16 | (return data)) 17 | 18 | (defn two-dee-ref (data x y oob-val) 19 | (if (or (>= x (ref data :width)) 20 | (>= y (ref data :height)) 21 | (< x 0) 22 | (< y 0)) 23 | oob-val 24 | (ref (ref data :data) (+ x (* y (ref data :width)))))) 25 | (export ref two-dee-ref) 26 | 27 | (defn set! (data x y val) 28 | :export 29 | (if (or (>= x (ref data :width)) 30 | (>= y (ref data :height)) 31 | (< x 0) 32 | (< y 0)) 33 | (exception :out-of-bounds "Trying to set an array out of bounds" data) 34 | (set! (ref data :data) (+ x (* y (ref data :width))) val)) 35 | (return data)) 36 | 37 | (defn print (data) 38 | :export 39 | (dotimes (y (ref data :height)) 40 | (dotimes (x (ref data :width)) 41 | (display (cat (array/2d/ref data x y) " "))) 42 | (newline)) 43 | (return data)) 44 | 45 | (deftest #t (-> (array/2d/allocate 4 4) (array/2d/set! 1 1 #t) (array/2d/ref 1 1))) 46 | (deftest #t (-> (array/2d/allocate 3 3) (array/2d/fill! #t) (array/2d/ref 1 1))) 47 | -------------------------------------------------------------------------------- /benchmark/compile-stdlib/compile-stdlib.nuj: -------------------------------------------------------------------------------- 1 | (import (green) :ansi) 2 | 3 | (def directories '("binlib" "stdlib")) 4 | (def module_dir "stdlib_modules") 5 | (def output-file "tmp/init.nuji") 6 | 7 | (def env (environment*)) 8 | 9 | (defn define-in-env (v) 10 | (def kw (:keyword (cat v))) 11 | (set! env kw v)) 12 | 13 | (defn compile-in-env (path) 14 | (def code (compile* (cons 'do (read (slurp path))) env)) 15 | (mutable-eval* code env)) 16 | 17 | (defn compile-module-in-env (path) 18 | (def module-name (:keyword (:cut (path/without-extension path) (inc (:length module_dir))))) 19 | (def source `(defmodule/defer ~module-name (def *module* ~module-name) ~@(read (file/read path)))) 20 | (mutable-eval* (compile* source env) env)) 21 | 22 | (defn compile-stdlib () 23 | (-> directories 24 | (map directory/read-recursive) 25 | (flatten) 26 | (filter (path/ext?! "nuj")) 27 | (for-each compile-in-env))) 28 | 29 | (compile-stdlib) 30 | 31 | (-> (:data root-closure) 32 | :values 33 | (filter (fn (v) (or (= NativeFunc (:type-of v)) 34 | (= Type (:type-of v))))) 35 | (for-each define-in-env)) 36 | (set! env :stdin* stdin*) 37 | (set! env :stdout* stdout*) 38 | (set! env :stderr* stderr*) 39 | 40 | (set! env :*module* :core) 41 | (set! env :exports {}) 42 | (:parent! env #nil) 43 | 44 | (compile-stdlib) 45 | 46 | (-> (directory/read-recursive module_dir) 47 | (flatten) 48 | (filter (path/ext?! "nuj")) 49 | (for-each compile-module-in-env)) 50 | 51 | (def img (image/serialize (ref env :init))) 52 | (pfmtln "Image built") 53 | (file/write img output-file) 54 | (exit 0) 55 | -------------------------------------------------------------------------------- /stdlib_modules/app/EventLog.nuj: -------------------------------------------------------------------------------- 1 | (import (TermApp) :term/TermApp) 2 | (import (TextBuffer) :app/termed/buffer) 3 | 4 | (def term (:new TermApp)) 5 | (def events #nil) 6 | 7 | (defn draw-events () 8 | (def ev (filter events (fn (e) (not= e.T :raw-input)))) 9 | (def w (bit-shift-right term.width 1)) 10 | (dotimes (i (- term.height 2)) 11 | (when-not ev (return #nil)) 12 | (def line (pad-end (string/write (car ev)) w)) 13 | (:draw-text term line 1 (+ 2 i) w 1 #xFF) 14 | (cdr! ev))) 15 | 16 | (defn draw-raw-events () 17 | (def ev (filter events (fn (e) (= e.T :raw-input)))) 18 | (def w (bit-shift-right term.width 1)) 19 | (dotimes (i (- term.height 2)) 20 | (when-not ev (return #nil)) 21 | (def line (pad-end (string/write (car ev)) w)) 22 | (:draw-text term line w (+ 2 i) w 1 #xFF) 23 | (cdr! ev))) 24 | 25 | (defn draw-screen () 26 | (def title (fmt " Nujel EventLog - {}" (:length events))) 27 | (:draw-text term (pad-end title term.width) 1 1 term.width 1 #x34) 28 | (draw-events) 29 | (draw-raw-events) 30 | (:flip term)) 31 | 32 | (defn read-input () 33 | (def c (:poll-input term)) 34 | (when (= c #\q) (quit)) 35 | (dotimes (i 100) 36 | (def ev (:get-events term)) 37 | (if ev 38 | (set! events (cons ev events)) 39 | (return #nil)))) 40 | 41 | (defn quit () 42 | (:stop term) 43 | (exit 0)) 44 | 45 | (defn main (args) 46 | :export 47 | (:start term) 48 | (while #t 49 | (draw-screen) 50 | (read-input))) 51 | -------------------------------------------------------------------------------- /stdlib/string/path.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; Some functions for working with paths and file extensions 5 | 6 | (defn path/ext?! (ext) 7 | "Return a predicate that checks if a path ends on EXT" 8 | (case (:type-name ext) 9 | (:string (fn (path) 10 | (= ext (lower-case (path/extension path))))) 11 | (:pair (fn (path) 12 | (def cext (lower-case (path/extension path))) 13 | (reduce ext (fn (α β) (or α (= β cext)))))) 14 | (otherwise (exception :type-error "Expected a :string or :list" ext)))) 15 | 16 | 17 | (defn path/extension (path) 18 | "Return the extension of PATH" 19 | (def last-period (:last-index-of path ".")) 20 | (if (>= last-period 0) 21 | (:cut path (+ 1 last-period) (:length path)) 22 | path)) 23 | 24 | (defn path/without-extension (path) 25 | "Return PATH, but without the extension part" 26 | (def last-period (:last-index-of path ".")) 27 | (if (>= last-period 0) 28 | (:cut path 0 last-period) 29 | path)) 30 | 31 | (defn path/dirname (path) 32 | "Return the directory part of a PATH" 33 | (def last-slash (:last-index-of path "/")) 34 | (if (>= last-slash 0) 35 | (:cut path 0 last-slash) 36 | "")) 37 | 38 | (defn path/basename (path) 39 | "Return the path without the directory part" 40 | (def last-slash (:last-index-of path "/")) 41 | (if (>= last-slash 0) 42 | (:cut path (inc last-slash)) 43 | path)) 44 | -------------------------------------------------------------------------------- /tools/build-image.nuj: -------------------------------------------------------------------------------- 1 | (import (green) :ansi) 2 | 3 | (def directories '("binlib" "stdlib")) 4 | (def module_dir "stdlib_modules") 5 | (def output-file "tmp/init.nuji") 6 | 7 | (def env (environment*)) 8 | (set! env :stdin* stdin*) 9 | (set! env :stdout* stdout*) 10 | (set! env :stderr* stderr*) 11 | (set! env :*module* :core) 12 | (set! env :exports {}) 13 | 14 | (defn define-in-env (v) 15 | (def kw (:keyword (cat v))) 16 | (set! env kw v)) 17 | 18 | (defn compile-in-env (path) 19 | (def code (compile* (cons 'do (read (slurp path))) env)) 20 | (mutable-eval* code env)) 21 | 22 | (defn compile-module-in-env (path) 23 | (def module-name (:keyword (:cut (path/without-extension path) (inc (:length module_dir))))) 24 | (def source `(defmodule/defer ~module-name (def *module* ~module-name) ~@(read (file/read path)))) 25 | (mutable-eval* (compile* source env) env)) 26 | 27 | (defn compile-stdlib () 28 | (-> directories 29 | (map directory/read-recursive) 30 | (flatten) 31 | (filter (path/ext?! "nuj")) 32 | (for-each compile-in-env))) 33 | 34 | (compile-stdlib) 35 | 36 | (-> (:data root-closure) 37 | :values 38 | (filter (fn (v) (or (= NativeFunc (:type-of v)) 39 | (= Type (:type-of v))))) 40 | (for-each define-in-env)) 41 | 42 | (:parent! env #nil) 43 | 44 | (compile-stdlib) 45 | 46 | (-> (directory/read-recursive module_dir) 47 | (flatten) 48 | (filter (path/ext?! "nuj")) 49 | (for-each compile-module-in-env)) 50 | 51 | (def img (image/serialize (ref env :init))) 52 | (pfmtln "{} Final size: {}KB" (green "Image built successfully!") (/ (:length img) 1024)) 53 | (file/write img output-file) 54 | (exit 0) 55 | -------------------------------------------------------------------------------- /tests/fast/day2.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (defn do-commands-1 (name val state) 4 | (case name 5 | (('forward) (set! state :horiz (+ (ref state :horiz) val))) 6 | (('up ) (set! state :depth (- (ref state :depth) val))) 7 | (('down ) (set! state :depth (+ (ref state :depth) val))) 8 | (otherwise (println "Unknown Command, continuing.")))) 9 | 10 | (defn do-commands-2 (name val state) 11 | (case name 12 | (('forward) (set! state :horiz (+ (ref state :horiz) val)) 13 | (set! state :depth (+ (ref state :depth) (* (ref state :aim) val)))) 14 | (('up ) (set! state :aim (- (ref state :aim) val))) 15 | (('down ) (set! state :aim (+ (ref state :aim) val))) 16 | (otherwise (println "Unknown Command, continuing.")))) 17 | 18 | (defn step (l state fun) 19 | (if-not (and l (cdr l)) state 20 | (step (cddr l) (fun (car l) (cadr l) state) fun))) 21 | 22 | (defn calc-result (state) 23 | (* (ref state :depth) (ref state :horiz))) 24 | 25 | (def result (calc-result (step '(forward 5 down 5 forward 8 up 3 down 8 forward 2) {:depth 0 :horiz 0} do-commands-1))) 26 | (when (not= 150 result) (throw (list :wrong-result "Wrong result" result))) 27 | 28 | (def result (calc-result (step (read (file/read "tests/fast/day2.dat")) {:depth 0 :horiz 0} do-commands-1))) 29 | (when (not= 1561344 result) (throw (list :wrong-result "Wrong result" result))) 30 | 31 | (def result (calc-result (step (read (file/read "tests/fast/day2.dat")) {:depth 0 :horiz 0 :aim 0} do-commands-2))) 32 | (when (not= 1848454425 result) (throw (list :wrong-result "Wrong result" result))) 33 | 34 | (return :success) 35 | -------------------------------------------------------------------------------- /bin/misc.c: -------------------------------------------------------------------------------- 1 | /* Nujel - Copyright (C) 2020-2022 - Benjamin Vincent Schulenburg 2 | * This project uses the MIT license, a copy should be included under /LICENSE */ 3 | #ifndef NUJEL_AMALGAMATION 4 | #include "private.h" 5 | #endif 6 | 7 | #if defined(_MSC_VER) 8 | #include 9 | #else 10 | #include 11 | #include 12 | #endif 13 | 14 | #include 15 | 16 | #ifdef __MINGW32__ 17 | #include 18 | #include 19 | #endif 20 | 21 | /* Return true if name is a directory */ 22 | int isDir(const char *name){ 23 | #ifdef _MSC_VER 24 | DWORD ftyp = GetFileAttributesA(name); 25 | return (ftyp != INVALID_FILE_ATTRIBUTES) && (ftyp & FILE_ATTRIBUTE_DIRECTORY); 26 | #else 27 | DIR *dp = opendir(name); 28 | if(dp == NULL){return 0;} 29 | closedir(dp); 30 | return 1; 31 | #endif 32 | } 33 | 34 | /* Create a new directory in a portable manner */ 35 | int makeDir(const char *name){ 36 | if(isDir(name)){return 1;} 37 | #if defined(__MINGW32__) 38 | return mkdir(name); 39 | #elif defined (__EMSCRIPTEN__) 40 | (void)name; 41 | return 1; 42 | #else 43 | return mkdir(name,0755); 44 | #endif 45 | } 46 | 47 | void *loadFile(const char *filename,size_t *len){ 48 | FILE *fp; 49 | size_t filelen,readlen,read; 50 | u8 *buf = NULL; 51 | 52 | fp = fopen(filename,"rb"); 53 | if(fp == NULL){return NULL;} 54 | 55 | fseek(fp,0,SEEK_END); 56 | filelen = ftell(fp); 57 | fseek(fp,0,SEEK_SET); 58 | 59 | buf = malloc(filelen); 60 | if(buf == NULL){return NULL;} 61 | 62 | readlen = 0; 63 | while(readlen < filelen){ 64 | read = fread(buf+readlen,1,filelen-readlen,fp); 65 | if(read == 0){ 66 | free(buf); 67 | return NULL; 68 | } 69 | readlen += read; 70 | } 71 | fclose(fp); 72 | 73 | *len = filelen; 74 | return buf; 75 | } 76 | -------------------------------------------------------------------------------- /tools/c-asset-packer.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; Can be used to create C source files for various binary/text files to be 5 | ;;; included in exceutables 6 | 7 | (def hex-cache (:alloc Array 256)) 8 | (dotimes (i 256) 9 | (set! hex-cache i (fmt "0x{i:02X}, "))) 10 | 11 | (defn create-c-asset (raw out symbol-name) 12 | :export 13 | (typecheck/only symbol-name :string) 14 | 15 | (:block-write out (fmt "unsigned long long int {symbol-name}_len = {};\n" (:length raw))) 16 | (:block-write out (fmt "unsigned char {symbol-name}[] = ")) 17 | (:block-write out "{") 18 | (dotimes (i (:length raw)) 19 | (when (zero? (bit-and i #xF)) 20 | (:block-write out "\n ")) 21 | (:block-write out (ref hex-cache (ref raw i)))) 22 | (:block-write out "};") 23 | (:close! out)) 24 | 25 | (defn create-string-asset (in symbol-name) 26 | :export 27 | (def out (:new StringOutputPort)) 28 | (create-c-asset in out symbol-name) 29 | (:return-string out)) 30 | 31 | (defn main (args) 32 | :export 33 | (def filename (car args)) 34 | (def output-file (cadr args)) 35 | (def symbol-name (caddr args)) 36 | (typecheck/only filename :string) 37 | (typecheck/only output-file :string) 38 | (typecheck/only symbol-name :string) 39 | (pfmtln "Packing {filename} into {output-file} as {symbol-name}") 40 | (def out (:new OutputPort (file/open-output* output-file :replace))) 41 | (:block-write out "/* This file is auto-generated, manual changes will be overwritten! */\n") 42 | (create-c-asset (slurp filename) out symbol-name)) 43 | -------------------------------------------------------------------------------- /tests/slow/day5.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (defn array/2d/new (width height val) 4 | (def ret (:alloc Array width)) 5 | (def x 0) 6 | (while (< x width) 7 | (set! ret x (array/fill! (:alloc Array height) val)) 8 | (inc! x)) 9 | ret) 10 | 11 | (defn parse/point (text) 12 | (tree/zip '(:x :y) (map (split text ",") read/single))) 13 | 14 | (defn line/dir (start end) 15 | (cond ((= start end) 0) 16 | ((< start end) 1) 17 | (#t -1))) 18 | 19 | (defn line/draw (x y end-x end-y) 20 | (def dir-x (line/dir x end-x)) 21 | (def dir-y (line/dir y end-y)) 22 | (while (or (not= x end-x) (not= y end-y)) 23 | (array/++ (ref vents x) y 1) 24 | (inc! x dir-x) 25 | (inc! y dir-y)) 26 | (array/++ (ref vents x) y 1)) 27 | 28 | (defn line/horiz? (line) 29 | (= (ref (ref line :a) :y) 30 | (ref (ref line :b) :y))) 31 | 32 | (defn line/vert? (line) 33 | (= (ref (ref line :a) :x) 34 | (ref (ref line :b) :x))) 35 | 36 | (defn line/draw-vents (line) 37 | (when (or (line/horiz? line) (line/vert? line)) 38 | (line/draw (ref (ref line :a) :x) 39 | (ref (ref line :a) :y) 40 | (ref (ref line :b) :x) 41 | (ref (ref line :b) :y)))) 42 | 43 | (defn points/count (v num) 44 | (reduce v (fn (a b) (+ a (reduce b (fn (a b) (+ a (if (> b num) 1 0))) 0))) 0)) 45 | 46 | (defn parse/line (line) 47 | (line/draw-vents (tree/zip '(:b :a) (map (split line "->") parse/point)))) 48 | 49 | (def vents (array/2d/new 1000 1000 0)) 50 | (def lines (split (file/read "tests/slow/day5.input") "\n")) 51 | (for-each lines parse/line) 52 | (when (not= (points/count vents 1) 3990) 53 | (throw (list :wrong-result "Wrong result" result))) 54 | 55 | (return :success) 56 | -------------------------------------------------------------------------------- /tests/fast/day3.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (def example-data "00100\n11110\n10110\n10111\n10101\n01111\n00111\n11100\n10000\n11001\n00010\n01010") 4 | (def input-data (file/read "tests/fast/day3.dat")) 5 | 6 | (defn read-data (lines) 7 | (map (split lines "\n") 8 | (fn (line) 9 | (car (read (cat "#b" line)))))) 10 | 11 | (defn count-bits/single (number state bit-count) 12 | (def i 0) 13 | (while (< i bit-count) 14 | (def mask (bit-shift-left 1 i)) 15 | (when (zero? (bit-and number mask)) 16 | (set! state i (+ 1 (ref state i)))) 17 | (inc! i))) 18 | 19 | (defn count-bits (numbers bit-count) 20 | (def count 0) 21 | (def state (:alloc Array bit-count)) 22 | (array/fill! state 0) 23 | (while numbers 24 | (count-bits/single (car numbers) state bit-count) 25 | (cdr! numbers) 26 | (inc! count)) 27 | {:bit-count bit-count :count count :zeroes state}) 28 | 29 | (defn calc-γε (state) 30 | (def i 0) 31 | (def γ 0) 32 | (def ε 0) 33 | (def threshold (bit-shift-right (ref state :count) 1)) 34 | (def arr (ref state :zeroes)) 35 | (while (< i (ref state :bit-count)) 36 | (if (< (ref arr i) threshold) 37 | (set! γ (bit-or γ (bit-shift-left 1 i))) 38 | (set! ε (bit-or ε (bit-shift-left 1 i)))) 39 | (inc! i)) 40 | 41 | {:γ γ :ε ε :power-consumption (* ε γ)}) 42 | 43 | (def result (calc-γε (count-bits (read-data example-data) 5))) 44 | (when (not= (ref result :power-consumption) 198) 45 | (throw (list :wrong-result "Wrong result" result))) 46 | 47 | (def result (calc-γε (count-bits (read-data input-data) 12))) 48 | (when (not= (ref result :power-consumption) 4103154) 49 | (throw (list :wrong-result "Wrong result" result))) 50 | 51 | (return :success) 52 | -------------------------------------------------------------------------------- /bin/main.c: -------------------------------------------------------------------------------- 1 | /* Nujel - Copyright (C) 2020-2022 - Benjamin Vincent Schulenburg 2 | * This project uses the MIT license, a copy should be included under /LICENSE */ 3 | #ifndef NUJEL_AMALGAMATION 4 | #include "private.h" 5 | #endif 6 | 7 | static void initBinNativeFuncs(){ 8 | lOperationsIO(); 9 | lOperationsPort(); 10 | lOperationsNet(); 11 | } 12 | 13 | static lClosure *createRootClosureFromExternalImage(const char *filename, lVal *init){ 14 | size_t len = 0; 15 | void *img = loadFile(filename, &len); 16 | lVal imgVal = readImage(img, len, true); 17 | lClosure *imgC = findRoot(imgVal); 18 | if(imgC == NULL){ 19 | fprintf(stderr,"Can't determine root closure of that image, exiting\n"); 20 | exit(131); 21 | } 22 | lClosure *c = lRedefineNativeFuncs(imgC); 23 | *init = imgVal; 24 | free(img); 25 | return c; 26 | } 27 | 28 | /* Initialize the Nujel context with an stdlib as well 29 | * as parsing arguments passed to the runtime */ 30 | static lVal initNujel(int argc, char *argv[]){ 31 | lClosure *c = NULL; 32 | lVal ret = NIL; 33 | lVal init = NIL; 34 | for(int i = argc-1; i >= 0; i--){ 35 | if(strcmp(argv[i], "--base-image") == 0){ 36 | if(c != NULL){ 37 | fprintf(stderr, "You can only specify one image\n"); 38 | exit(124); 39 | } 40 | if(i > (argc-2)){ 41 | fprintf(stderr, "Please specify an image\n"); 42 | exit(125); 43 | } 44 | c = createRootClosureFromExternalImage(argv[i+1], &init); 45 | ret = lCdr(ret); 46 | continue; 47 | } 48 | ret = lCons(lValString(argv[i]), ret); 49 | } 50 | if(c == NULL){ 51 | c = lNewRoot(); 52 | } 53 | lRedefineFileHandles(c); 54 | lRedefineEnvironment(c); 55 | 56 | if(init.type == ltNil){ 57 | init = lGetClosureSym(c, lSymS("init")); 58 | } 59 | return lApply(init, ret); 60 | } 61 | 62 | int main(int argc, char *argv[]){ 63 | setvbuf(stdout, NULL, _IONBF, 0); 64 | setvbuf(stderr, NULL, _IONBF, 0); 65 | lInit(); 66 | initBinNativeFuncs(); 67 | setIOSymbols(); 68 | 69 | initNujel(argc,argv); 70 | return 0; 71 | } 72 | -------------------------------------------------------------------------------- /stdlib_modules/serialization/json.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; Contains subroutines for (de-)serializing JSON 5 | 6 | (defn tree->json (v) 7 | "Converts a tree into a JSON encoded string, you should prefer VAL->JSON" 8 | (cat "{" 9 | (join (map (:keys v) 10 | (fn (k) 11 | (cat "\"" (:string k) "\": " 12 | (val->json (ref v k))))) 13 | ",\n") 14 | "}")) 15 | 16 | (defn val->json (v) 17 | :export-as serialize 18 | "Return V as a JSON encoded string" 19 | (case (:type-name v) 20 | (:nil "null") 21 | ((:int :float) (:string v)) 22 | (:bool (if v "true" "false")) 23 | ((:array :pair) (cat "[" (join (map v val->json) ",") "]")) 24 | (:string (string/write v)) 25 | ((:symbol :keyword) (cat "\"" (:string v) "\"")) 26 | (:tree (tree->json v)) 27 | (otherwise (exception :type-error "Can't encode the value into JSON" v)))) 28 | 29 | (deftest "null" (serialization/json/serialize #nil)) 30 | (deftest "123" (serialization/json/serialize 123)) 31 | (deftest "123.123" (serialization/json/serialize 123.123)) 32 | (deftest "true" (serialization/json/serialize #t)) 33 | (deftest "false" (serialization/json/serialize #f)) 34 | (deftest "[1,2,3]" (serialization/json/serialize [1 2 3])) 35 | (deftest "[1,true,3.0]" (serialization/json/serialize '(1 #t 3.0))) 36 | (deftest "\"asd\"" (serialization/json/serialize 'asd)) 37 | (deftest "\"asd\"" (serialization/json/serialize :asd)) 38 | (deftest "\"asd\"" (serialization/json/serialize "asd")) 39 | (deftest "\"asd\"" (serialization/json/serialize "asd")) 40 | (deftest "{\"asd\": null}" (serialization/json/serialize {:asd #nil})) 41 | (deftest "{\"asd\": \"asd\"}" (serialization/json/serialize {:asd :asd})) 42 | (deftest "{\"asd\": 123}" (serialization/json/serialize {:asd 123})) 43 | -------------------------------------------------------------------------------- /stdlib/bitmanip.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; Some functions manipulating binary date 5 | 6 | (defn bit-test? (test-val bit-pos) 7 | "Test bit at position i 8 | 9 | We check if test-val has a 1 at bit-pos and return #t if that is the case 10 | 11 | test-val: The integer in which to look for the bit 12 | bit-pos: Which bit to look for, with 0 being the least significant digit 13 | 14 | A boolean signifying whether the bit is set or not" 15 | :cat :bitwise-operations 16 | 17 | (typecheck/only test-val :int) 18 | (typecheck/only bit-pos :int) 19 | (not (zero? (bit-and test-val (bit-shift-left 1 bit-pos))))) 20 | 21 | (defn bit-set (cur-val bit-pos) 22 | "Set bit-pos within cur-val to 1 23 | 24 | cur-val: The integer where we set the bit in 25 | bit-pos: The index of the bit we want to change, with 0 being the least significant digit 26 | 27 | An integer cur-val but with a guaranteed 1 at bit-pos" 28 | :cat :bitwise-operations 29 | 30 | (bit-or cur-val (bit-shift-left 1 bit-pos))) 31 | 32 | (defn bit-flip (cur-val bit-pos) 33 | "Flip the bit at bit-pos within cur-val 34 | 35 | cur-val: The integer where we flip the bit in 36 | bit-pos: The index of the bit we want to flip, with 0 being the least significant digit 37 | 38 | An integer cur-val but with the bit at position bit-pos flipped" 39 | :cat :bitwise-operations 40 | 41 | (bit-xor cur-val (bit-shift-left 1 bit-pos))) 42 | 43 | (defn bit-clear (cur-val bit-pos) 44 | "Clear the bit at bit-pos within cur-val 45 | 46 | cur-val: The integer where we clear the bit in 47 | bit-pos: The index of the bit we want to clear, with 0 being the least significant digit 48 | 49 | An integer cur-val but with the bit at position bit-pos forced to 0" 50 | :cat :bitwise-operations 51 | 52 | (bit-and cur-val (bit-not (bit-shift-left 1 bit-pos)))) 53 | -------------------------------------------------------------------------------- /mk/disable_implicit_rules.mk: -------------------------------------------------------------------------------- 1 | .SUFFIXES: 2 | SUFFIXES := 3 | %.out: 4 | %.a: 5 | %.ln: 6 | %.o: 7 | %: %.o 8 | %.c: 9 | %: %.c 10 | %.ln: %.c 11 | %.o: %.c 12 | %.cc: 13 | %: %.cc 14 | %.o: %.cc 15 | %.C: 16 | %: %.C 17 | %.o: %.C 18 | %.cpp: 19 | %: %.cpp 20 | %.o: %.cpp 21 | %.p: 22 | %: %.p 23 | %.o: %.p 24 | %.f: 25 | %: %.f 26 | %.o: %.f 27 | %.F: 28 | %: %.F 29 | %.o: %.F 30 | %.f: %.F 31 | %.r: 32 | %: %.r 33 | %.o: %.r 34 | %.f: %.r 35 | %.y: 36 | %.ln: %.y 37 | %.c: %.y 38 | %.l: 39 | %.ln: %.l 40 | %.c: %.l 41 | %.r: %.l 42 | %.s: 43 | %: %.s 44 | %.o: %.s 45 | %.S: 46 | %: %.S 47 | %.o: %.S 48 | %.s: %.S 49 | %.mod: 50 | %: %.mod 51 | %.o: %.mod 52 | %.sym: 53 | %.def: 54 | %.sym: %.def 55 | %.h: 56 | %.info: 57 | %.dvi: 58 | %.tex: 59 | %.dvi: %.tex 60 | %.texinfo: 61 | %.info: %.texinfo 62 | %.dvi: %.texinfo 63 | %.texi: 64 | %.info: %.texi 65 | %.dvi: %.texi 66 | %.txinfo: 67 | %.info: %.txinfo 68 | %.dvi: %.txinfo 69 | %.w: 70 | %.c: %.w 71 | %.tex: %.w 72 | %.ch: 73 | %.web: 74 | %.p: %.web 75 | %.tex: %.web 76 | %.sh: 77 | %: %.sh 78 | %.elc: 79 | %.el: 80 | (%): % 81 | %.out: % 82 | %.c: %.w %.ch 83 | %.tex: %.w %.ch 84 | %: %,v 85 | %: RCS/%,v 86 | %: RCS/% 87 | %: s.% 88 | %: SCCS/s.% 89 | .web.p: 90 | .l.r: 91 | .dvi: 92 | .F.o: 93 | .l: 94 | .y.ln: 95 | .o: 96 | .y: 97 | .def.sym: 98 | .p.o: 99 | .p: 100 | .txinfo.dvi: 101 | .a: 102 | .l.ln: 103 | .w.c: 104 | .texi.dvi: 105 | .sh: 106 | .cc: 107 | .cc.o: 108 | .def: 109 | .c.o: 110 | .r.o: 111 | .r: 112 | .info: 113 | .elc: 114 | .l.c: 115 | .out: 116 | .C: 117 | .r.f: 118 | .S: 119 | .texinfo.info: 120 | .c: 121 | .w.tex: 122 | .c.ln: 123 | .s.o: 124 | .s: 125 | .texinfo.dvi: 126 | .el: 127 | .texinfo: 128 | .y.c: 129 | .web.tex: 130 | .texi.info: 131 | .DEFAULT: 132 | .h: 133 | .tex.dvi: 134 | .cpp.o: 135 | .cpp: 136 | .C.o: 137 | .ln: 138 | .texi: 139 | .txinfo: 140 | .tex: 141 | .txinfo.info: 142 | .ch: 143 | .S.s: 144 | .mod: 145 | .mod.o: 146 | .F.f: 147 | .w: 148 | .S.o: 149 | .F: 150 | .web: 151 | .sym: 152 | .f: 153 | .f.o: 154 | -------------------------------------------------------------------------------- /tests/fast/day10.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (defn char-to-score (cc) 4 | (case cc 5 | (#\) 3) 6 | (#\] 57) 7 | (#\} 1197) 8 | (#\> 25137) 9 | (otherwise 0))) 10 | 11 | (defn p2-score (cc) 12 | (case cc 13 | (#\) 1) 14 | (#\] 2) 15 | (#\} 3) 16 | (#\> 4) 17 | (otherwise 0))) 18 | 19 | (defn calc-part2-score (stack α) 20 | (if-not stack α 21 | (calc-part2-score (cdr stack) 22 | (+ (* 5 α) 23 | (p2-score (car stack)))))) 24 | 25 | (defn find-first-syntax-error (line) 26 | (def stack #nil) 27 | (try (fn (ε) (if (= (car ε) :return) 28 | (cons :part1 (char-to-score (cadr ε))) 29 | (throw ε))) 30 | (dotimes (i (:length line)) 31 | (def cc (ref line i)) 32 | (case cc 33 | ((#\() (set! stack (cons #\) stack))) 34 | ((#\{) (set! stack (cons #\} stack))) 35 | ((#\[) (set! stack (cons #\] stack))) 36 | ((#\<) (set! stack (cons #\> stack))) 37 | ((#\) #\} #\] #\>) (if (= cc (car stack)) 38 | (set! stack (cdr stack)) 39 | (throw (list :return cc i)))))) 40 | (calc-part2-score stack 0))) 41 | 42 | (def lines (split (file/read "tests/fast/day10.dat") "\n")) 43 | (def res (map lines find-first-syntax-error)) 44 | (def p1-res (reduce res (fn (α β) (if (= :part1 (car β)) (+ α (cdr β)) α)) 0)) 45 | (def incomplete-lines (list/sort (filter res (fn (α) (not= :part1 (car α)))))) 46 | (def p2-res (ref incomplete-lines (div/int (:length incomplete-lines) 2))) 47 | (when (not= p1-res 315693) 48 | (throw (list :wrong-result "Wrong result" p1-res))) 49 | (when (not= p2-res 1870887234) 50 | (throw (list :wrong-result "Wrong result" p2-res))) 51 | (return :success) 52 | -------------------------------------------------------------------------------- /tests/testsuite/arithmetic.nuj: -------------------------------------------------------------------------------- 1 | (3 (+ 1 2)) 2 | (-1 (+ 1 -2)) 3 | (3 (- 4 1)) 4 | (5 (- 4 -1)) 5 | (8 (* 4 2)) 6 | (16 (* 4 4)) 7 | (2.0 (/ 4 2)) 8 | (2 (do 2)) 9 | (4.0 (/ 8 2)) 10 | (1 (rem 5 2)) 11 | (0 (rem 4 2)) 12 | (1 (int (round (rem 4.6 2)))) 13 | (0 (int (round (rem 4.4 2)))) 14 | (39 (+ 42 (- 3))) 15 | (24 (* 4 (- (+ 1 (+ 1 1)) (- 3 3 3)))) 16 | (3.0 (/ 9 3)) 17 | (3.25 (let ((vier -4)) (+ (rem 9 4) (/ -9 vier)))) 18 | (69.0 (+ (* 2 (/ 32 8) (- 16 8)) 5)) 19 | (256 (int (pow 2 8))) 20 | (1 (int (pow 1 8))) 21 | (1 (int (pow 1.0 8))) 22 | ("0.5" (string/write (pow 2.0 -1.0))) 23 | ("0.25" (string/write (pow 2.0 -2.0))) 24 | ("0.125" (string/write (pow 2.0 -3.0))) 25 | (2 (int (sqrt 4))) 26 | (3 (int (sqrt 9))) 27 | (16 (int (* (sqrt 16) (sqrt 16)))) 28 | ("3.0" (string/write (sqrt 9))) 29 | ("2.0" (string/write (ceil 1.3))) 30 | ("1.0" (string/write (round 1.3))) 31 | ("2.0" (string/write (round 1.51))) 32 | ("256.0" (string/write (pow 2.0 8))) 33 | ("2.0" (string/write (/ 1.0 0.5))) 34 | ("0.5" (string/write (/ 1.0 2))) 35 | ("0.1" (string/write (/ 1.0 10))) 36 | ("0.1" (string/write (/ 1.0 10.0))) 37 | (:arity-error (try car (string/write (/ 0.5)))) 38 | (2.0 (cbrt 8)) 39 | ("3.0" (string/write (cbrt 27))) 40 | (2.0 (cbrt 8.0)) 41 | ("3.0" (string/write (cbrt 27.0))) 42 | (14 (def abs (fn (a) (if (neg? a) (- 0 a) a))) (+ (abs -7) (abs 7))) 43 | (3 (abs -3)) 44 | (3 (abs 3)) 45 | (0 (abs 0)) 46 | (0 (abs -0)) 47 | (2.0 (abs -2.0)) 48 | ("1.0" (string/write (sin (/ PI 2)))) 49 | ("-1.0" (string/write (sin (/ PI -2)))) 50 | ("-1.0" (string/write (cos π))) 51 | ("1.0" (string/write (cos (* π 2)))) 52 | ("0.0" (string/write (atan2 0.0 0.0))) 53 | (:type-error (try car (atan2))) 54 | (:type-error (try car (atan2 0))) 55 | (:type-error (try car (atan2 0 "0"))) 56 | ("0.0" (string/write (atan2 0 0))) 57 | ("0.0" (string/write (round (abs (- PI (* (atan2 1.0 0.0) 2.0)))))) 58 | ("0.0" (string/write (round (abs (atan2 0.0 1.0))))) 59 | ("10.0" (string/write (* (sin (atan2 10.0 10.0)) (sqrt (+ (* 10.0 10.0) (* 10.0 10.0)))))) 60 | (0 (bit-shift-right 16 8)) 61 | (1 (bit-shift-right 16 4)) 62 | (16 (bit-shift-right 16 0)) 63 | -------------------------------------------------------------------------------- /bin/net.c: -------------------------------------------------------------------------------- 1 | /* Nujel - Copyright (C) 2020-2022 - Benjamin Vincent Schulenburg 2 | * This project uses the MIT license, a copy should be included under /LICENSE */ 3 | #ifndef NUJEL_AMALGAMATION 4 | #include "private.h" 5 | #endif 6 | 7 | #include 8 | #include 9 | 10 | #if (!defined(_WIN32)) && (!defined(__wasi__)) 11 | #include 12 | #include 13 | #include 14 | #include 15 | #include 16 | #include 17 | #endif 18 | 19 | #if (!defined(_WIN32)) && (!defined(__wasi__)) 20 | static lVal lnfSocketConect(lVal host, lVal port){ 21 | reqString(host); 22 | reqInt(port); 23 | if((port.vInt < 0) || (port.vInt > 0xFFFF)){ 24 | return lValException(lSymError, "Port numbers need to be between 0-65535", port); 25 | } 26 | 27 | struct addrinfo hints, *res, *result; 28 | bzero(&hints, sizeof(hints)); 29 | hints.ai_family = PF_UNSPEC; 30 | hints.ai_socktype = SOCK_STREAM; 31 | hints.ai_flags |= AI_CANONNAME; 32 | 33 | int errcode = getaddrinfo(lBufferData(host.vBuffer), NULL, &hints, &result); 34 | if(errcode != 0){ 35 | return NIL; 36 | } 37 | res = result; 38 | while (res){ 39 | if(res->ai_family == AF_INET){ 40 | ((struct sockaddr_in*)((void *)res->ai_addr))->sin_port = htons(port.vInt); 41 | } else if(res->ai_family == AF_INET6){ 42 | ((struct sockaddr_in6*)((void *)res->ai_addr))->sin6_port = htons(port.vInt); 43 | } else { 44 | continue; 45 | } 46 | int fd = socket(res->ai_family, res->ai_socktype, 0); 47 | if(fd < 0){ 48 | continue; 49 | } 50 | 51 | int rc = connect(fd, res->ai_addr, res->ai_addrlen); 52 | if(rc == 0){ 53 | freeaddrinfo(result); 54 | FILE *fh = fdopen(fd, "rb+"); 55 | if(fh == NULL){ 56 | return NIL; 57 | } 58 | return lValFileHandle(fh); 59 | } 60 | res = res->ai_next; 61 | } 62 | 63 | freeaddrinfo(result); 64 | return NIL; 65 | } 66 | #endif 67 | 68 | 69 | void lOperationsNet(){ 70 | #if (!defined(_WIN32)) && (!defined(__wasi__)) 71 | lAddNativeFuncVV("socket/connect", "(host port)", "Quits with code a", lnfSocketConect, 0); 72 | #endif 73 | } 74 | -------------------------------------------------------------------------------- /stdlib/collections/collection_primitives.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; A bunch of procedurs working on procedures, using type specialized λs 5 | 6 | (defn filter (l p) 7 | "Runs predicate p over every item in collection l and returns a list consiting solely of items where p is true" 8 | (case (:type-name l) 9 | (:nil #nil) 10 | (:pair (list/filter l p)) 11 | (:array (array/filter l p)) 12 | (:tree (tree/filter l p)) 13 | (otherwise (exception :type-error "You can only filter collections" l )))) 14 | 15 | (defn reduce (l f α) 16 | "Combine all elements in collection l using operation F and starting value α" 17 | (case (:type-name l) 18 | (:nil α) 19 | (:tree (tree/reduce l f α)) 20 | (:array (array/reduce l f α)) 21 | (:pair (list/reduce l f α)) 22 | (otherwise (exception :type-error "You can only reduce collections" l )))) 23 | 24 | (defn map (l f) 25 | "Runs f over every item in collection l and returns the resulting list" 26 | (case (:type-name l) 27 | (:nil #nil) 28 | (:pair (list/map l f)) 29 | (:array (array/map l f)) 30 | (otherwise (exception :type-error "You can only use map with a collection" l )))) 31 | 32 | (defn sort (l) 33 | "Sorts the collection L" 34 | (case (:type-name l) 35 | (:nil #nil) 36 | (:pair (list/sort l)) 37 | (:array (array/sort l)) 38 | (otherwise (exception :type-error "You can only use sort with a collection" l )))) 39 | 40 | (defn cut (l start end) 41 | "Return a subcollection of L from START to END" 42 | (case (:type-name l) 43 | (:pair (list/cut l start end)) 44 | (:array (array/cut l start end)) 45 | (:string (:cut l start end)) 46 | (otherwise (exception :type-error "You can only use member with a collection" l )))) 47 | -------------------------------------------------------------------------------- /stdlib/collections/tree.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; Some functions about trees 5 | 6 | (defn tree/zip (keys values) 7 | "Return a tree where KEYS point to VALUES" 8 | (def ret {}) 9 | (doseq (key keys ret) 10 | (set! ret key (car values)) 11 | (cdr! values))) 12 | 13 | (defn tree/+= (t k v) 14 | "Increment value at K in T by V" 15 | (set! t k (+ v (int (or (ref t k) 0))))) 16 | 17 | (defmacro tree/-= (t k v) 18 | "Decrement value at K in T by V" 19 | `(tree/+= ~t ~k (- ~v))) 20 | 21 | (defmacro tree/++ (t k) 22 | "Increment value at K in T by 1" 23 | `(tree/+= ~t ~k 1)) 24 | 25 | (defmacro tree/-- (t k) 26 | "Increment value at K in T by 1" 27 | `(tree/-= ~t ~k 1)) 28 | 29 | (defn tree/equal? (a b) 30 | "Compares two trees for equality" 31 | (if (and (tree? a) 32 | (tree? b)) 33 | (and (= (:key* a) 34 | (:key* b)) 35 | (equal? (:value* a) 36 | (:value* b)) 37 | (tree/equal? (:left* a) 38 | (:left* b)) 39 | (tree/equal? (:right* a) 40 | (:right* b))) 41 | (equal? a b))) 42 | 43 | (defn tree/reduce (l o s) 44 | "Combine all elements in l using operation o and starting value s" 45 | (list/reduce (:values l) o s)) 46 | 47 | (defn tree/filter (l f) 48 | "Return a new tree with all elements from L where F returns true" 49 | (def ret {}) 50 | (doseq (e (:keys l) ret) 51 | (def t (ref l e)) 52 | (when (f t) 53 | (set! ret e t)))) 54 | 55 | (defn tree/merge (a b) 56 | "Merge two trees together, if a key is contained in both trees the on in B gets priority" 57 | (when-not b (return (if a (:clone a) {}))) 58 | (when-not a (return (:clone b))) 59 | (def ret (:clone a)) 60 | (doseq (k (:keys b) ret) 61 | (set! ret k (ref b k)))) 62 | -------------------------------------------------------------------------------- /tests/slow/day12.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (def cave-map {}) 4 | (def big-caves {}) 5 | (defn big-cave? (α) (ref big-caves α)) 6 | (defn add-connections (line) 7 | (def parts (map (split line "-") :symbol)) 8 | (when (cadr parts) 9 | (set! cave-map (car parts) (cons (cadr parts) (ref cave-map (car parts)))) 10 | (set! cave-map (cadr parts) (cons (car parts) (ref cave-map (cadr parts)))) 11 | (set! big-caves (car parts) (< (ref (:string (car parts)) 0) #\a)) 12 | (set! big-caves (cadr parts) (< (ref (:string (cadr parts)) 0) #\a)))) 13 | (defn add-connections (line) 14 | (def parts (map (split line "-") :symbol)) 15 | (when (cadr parts) 16 | (set! cave-map (car parts) (cons (cadr parts) (ref cave-map (car parts)))) 17 | (set! cave-map (cadr parts) (cons (car parts) (ref cave-map (cadr parts)))) 18 | (set! big-caves (car parts) (< (try (fn () 0) (ref (:string (car parts)) 0)) #\a)) 19 | (set! big-caves (cadr parts) (< (try (fn () 0) (ref (:string (cadr parts)) 0)) #\a)))) 20 | (def connections (for-each (split (file/read "tests/slow/day12.input") "\n") add-connections)) 21 | 22 | (def valid-routes 0) 23 | 24 | (defn calc-routes (position s twice) 25 | (if (= position 'start) 26 | (inc! valid-routes) 27 | (when-not (and (= position 'end) 28 | (> (ref s 'end) 0)) 29 | (def routes (ref cave-map position)) 30 | (when-not (big-cave? position) 31 | (when (> (ref s position) 0) 32 | (if twice 33 | (return) 34 | (set! twice #t))) 35 | (set! s (:clone s)) 36 | (tree/++ s position)) 37 | (while routes 38 | (calc-routes (car routes) s twice) 39 | (cdr! routes))))) 40 | 41 | (calc-routes 'end {} #t) 42 | (when (not= valid-routes 4411) 43 | (throw (list :wrong-result "Wrong result" valid-routes))) 44 | 45 | (set! valid-routes 0) 46 | (calc-routes 'end {} #f) 47 | (when (not= valid-routes 136767) 48 | (throw (list :wrong-result "Wrong result" valid-routes))) 49 | 50 | (return :success) 51 | -------------------------------------------------------------------------------- /stdlib/collections/collection.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; A bunch of procedurs that work on all collections where the collection primitives are implemented 5 | 6 | (defn sum (collection) 7 | "Return the sum of every value in collection" 8 | :cat :collection-operations 9 | 10 | (reduce collection + 0)) 11 | 12 | (defn every? (collection predicate?) 13 | "Returns whether predicate? is #t for every member of the collection" 14 | :cat :collection-operations 15 | 16 | (reduce collection (fn (a b) (and a (predicate? b))) #t)) 17 | 18 | (defn count (collection predicate?) 19 | "Count the number of items in the collection where predicate? is #t. 20 | If no predicate is provided, it will count the number of elements instead." 21 | :cat :collection-operations 22 | 23 | (if predicate? 24 | (reduce collection (fn (a b) (+ a (if (predicate? b) 1 0))) 0) 25 | (reduce collection (fn (a b) (+ a 1)) 0))) 26 | 27 | (defn delete (l e) 28 | "Returns a filtered list l with all elements equal to e omitted" 29 | (filter l (fn (a) (not (= a e))))) 30 | 31 | (defn remove (l p) 32 | "Returns a filtered list l with all elements where P equal true removed" 33 | (filter l (fn (a) (not (p a))))) 34 | 35 | (def flatten (let* 36 | (defn flatten-λ (a b) 37 | (cond ((collection? b ) (append (reduce b flatten-λ #nil) a)) 38 | (#t (cons b a)))) 39 | (defn flatten (l) 40 | "Flatten a collection of collections into a simple list" 41 | (if-not (collection? l) l 42 | (nreverse (reduce l flatten-λ #nil)))))) 43 | 44 | (defn join (l glue) 45 | "Join every element of α together into a string with GLUE inbetween" 46 | (when-not glue (set! glue "")) 47 | (when-not l (return "")) 48 | (reduce l (fn (a b) (if a (cat a glue b) b)) #nil)) 49 | 50 | (defn for-each (l f) 51 | "Runs F over every item in collection L" 52 | (def ret #nil) 53 | (doseq (i l ret) 54 | (set! ret (f i)))) 55 | -------------------------------------------------------------------------------- /stdlib_modules/repl.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; The REPL implementation, also parses command line arguments and determines 5 | ;;; which files to load and whether to start a interactive session. 6 | (import (rainbow) :ansi) 7 | 8 | (def *1 #nil) 9 | (def *2 #nil) 10 | (def *3 #nil) 11 | (def line-history #nil) 12 | (def ctx (environment*)) 13 | 14 | (defn exception-handler (error) 15 | (print/error error)) 16 | 17 | (defn push-result (result) 18 | (set! *3 *2) 19 | (set! *2 *1) 20 | (set! *1 result) 21 | (return result)) 22 | 23 | (defn cmd/raw (line) 24 | :export 25 | (try (fn (err) 26 | (if (= (car err) :unmatched-opening-bracket) 27 | (cmd/raw ctx (cat line (readline "... "))) 28 | (throw err))) 29 | (def expr (read line)) 30 | (when (equal? '() expr) 31 | (print "\r") 32 | (return)) 33 | (try exception-handler 34 | (def result (eval-in ctx (cons do expr))) 35 | (push-result result) 36 | (println (if (nil? result) "" (string/display result)))))) 37 | 38 | (defn cmd () 39 | (def buf "") 40 | (def line "") 41 | (while (not= (trim line) "[/cmd]") 42 | (set! buf (cat buf line)) 43 | (set! line (readline))) 44 | (def expr (cons do (read buf))) 45 | (def result (eval-in ctx expr)) 46 | (push-result result) 47 | (println (if (nil? result) "" (string/display result)))) 48 | 49 | (defn prompt () 50 | "> ") 51 | 52 | (defn read-cmd () 53 | (def line (readline (prompt))) 54 | (cons! line line-history) 55 | (when (nil? line) 56 | (println "Adios, cowboy...") 57 | (exit 0)) 58 | (if (= (trim line) "[cmd]") 59 | (cmd) 60 | (cmd/raw line))) 61 | 62 | (defn welcome () 63 | (println (cat (rainbow "Nujel") " REPL is ready for service!"))) 64 | 65 | (defn main (args) 66 | :export 67 | (welcome) 68 | (while #t 69 | (try exception-handler 70 | (read-cmd)))) 71 | -------------------------------------------------------------------------------- /binlib/tiny-repl.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; A very simple REPL, only to be used in emergencies if for some reasons 5 | ;;; you can't use the full REPL module 6 | 7 | (def tiny-repl (let* 8 | (def ctx (environment*)) 9 | 10 | (defn exception-handler (error) 11 | (print/error error)) 12 | 13 | (defn cmd/raw (line) 14 | :export 15 | (try (fn (err) 16 | (if (= (car err) :unmatched-opening-bracket) 17 | (cmd/raw ctx (cat line (readline "... "))) 18 | (throw err))) 19 | (def expr (read line)) 20 | (when (equal? '() expr) 21 | (print "\r") 22 | (return)) 23 | (try exception-handler 24 | (def result (eval-in ctx (cons do expr))) 25 | (display result) 26 | (newline)))) 27 | 28 | (defn cmd () 29 | (def buf "") 30 | (def line "") 31 | (while (not= (trim line) "[/cmd]") 32 | (set! buf (cat buf line)) 33 | (set! line (readline))) 34 | (try exception-handler 35 | (def expr (cons do (read buf))) 36 | (def result (eval-in ctx expr)) 37 | (display result) 38 | (newline))) 39 | 40 | (defn read-cmd () 41 | (def line (readline "> ")) 42 | (when (nil? line) 43 | (println "Adios, cowboy...") 44 | (exit 0)) 45 | (if (= (trim line) "[cmd]") 46 | (cmd) 47 | (cmd/raw line))) 48 | 49 | (defn tiny-repl () 50 | (println "Nujel TinyREPL is ready for service!") 51 | (while #t (read-cmd))) 52 | )) 53 | -------------------------------------------------------------------------------- /stdlib_modules/net/gopher.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | 5 | (defn parse-url (url) 6 | (when (= (:index-of url "gopher://") 0) 7 | (set! url (:cut url 9)) 8 | (def host url) 9 | (def port 70) 10 | (def path "") 11 | 12 | (def first-slash (:index-of url "/")) 13 | (when (>= first-slash 0) 14 | (set! path (:cut url first-slash)) 15 | (set! host (:cut url 0 first-slash))) 16 | 17 | (def first-colon (:index-of host ":")) 18 | (when (>= first-colon 0) 19 | (set! port (read/int (:cut host (inc first-colon)))) 20 | (set! host (:cut host 0 first-colon))) 21 | 22 | (return {:host host :port port :path path :protocol :gopher})) 23 | #nil) 24 | 25 | (defn get* (host path port) 26 | (def buf (buffer/allocate 0)) 27 | (def fh (socket/connect host port)) 28 | (file/write* fh path (:length path)) 29 | (file/write* fh "\r\n" 2) 30 | (file/flush* fh) 31 | (def bytes-read 0) 32 | (def bytes-read-now 1) 33 | (while (not (zero? bytes-read-now)) 34 | (:length! buf (+ 8192 (:length buf))) 35 | (set! bytes-read-now (file/read* fh buf 8192 bytes-read)) 36 | (set! bytes-read (+ bytes-read bytes-read-now))) 37 | (file/close* fh) 38 | (def raw-res (buffer->string buf bytes-read)) 39 | raw-res) 40 | 41 | (defn parse-gopher-map (line) 42 | (def T (:cut line 0 1)) 43 | (when (or (= T ".") 44 | (= T " ") 45 | (= T "")) 46 | (return #nil)) 47 | (def cols (split (:cut line 1) "\t")) 48 | { :type (:keyword T) 49 | :display (or (car cols) "") 50 | :path (or (cadr cols) "") 51 | :host (or (caddr cols) "") 52 | :port (or (cadddr cols) 70)}) 53 | 54 | (defn get (url type) 55 | :export 56 | (when-not type (set! type :1)) 57 | (def info (parse-url url)) 58 | (when-not info (return #nil)) 59 | (def res (get* (ref info :host) (ref info :path) (ref info :port))) 60 | (when-not res (return #nil)) 61 | (if (= type :1) 62 | (-> (split res "\r\n") 63 | (map parse-gopher-map) 64 | (filter identity)) 65 | res)) 66 | -------------------------------------------------------------------------------- /stdlib/core/quasiquote.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; The Nujel implementation for quasiquote, it is important to note that it is 5 | ;;; a macro, not a special form. 6 | 7 | (def quasiquote (let* 8 | (defn quasiquote-real (l depth) 9 | (when-not l (return #nil)) 10 | (if (pair? l) 11 | (if (= (caar l) 'unquote-splicing) 12 | (if (zero? depth) 13 | (list 'append 14 | (cadr (car l)) 15 | (quasiquote-real (cdr l) depth)) 16 | (list 'unquote-splicing 17 | (quasiquote-real (cadr l) (+ -1 depth)))) 18 | (if (= (car l) 'unquote) 19 | (if (zero? depth) 20 | (cadr l) 21 | (list 'unquote 22 | (quasiquote-real (cadr l) (+ -1 depth)))) 23 | (if (= (car l) 'quasiquote) 24 | (quasiquote-real (quasiquote-real (cadr l) (+ 1 depth)) depth) 25 | (if (zero? depth) 26 | (list 'cons 27 | (quasiquote-real (car l) depth) 28 | (quasiquote-real (cdr l) depth)) 29 | (cons (quasiquote-real (car l) depth) 30 | (quasiquote-real (cdr l) depth)))))) 31 | (if (and (zero? depth) (symbol? l)) 32 | (cons 'quote (cons l #nil)) 33 | l))) 34 | 35 | (defmacro quasiquote (l) 36 | (quasiquote-real l 0)))) 37 | 38 | (defn unquote (expr) 39 | (throw (list :unquote-without-quasiquote "unquote should only occur inside a quasiquote, never evaluated directly"))) 40 | 41 | (defn unquote-splicing (expr) 42 | (throw (list :unquote-splicing-without-quasiquote "unquote-splicing should only occur inside a quasiquote, never evaluated directly"))) 43 | -------------------------------------------------------------------------------- /stdlib/compiler/frontend/constant_folding.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | ;;; Contains an optimization pass that does some simple constant folding 5 | ;;; 6 | ;;; To accomplish this we walk an expression tree, searching for pure functions 7 | ;;; with constant arguments, since these should be safe to replace with their 8 | ;;; respective results. 9 | ;;; 10 | ;;; Pure functions are those whose :pure meta value is #t, meaning we trust 11 | ;;; the developer to determine which functions are safe to constant fold, in 12 | ;;; future versions we might be able to infer if a given fn is pure. 13 | 14 | (def constant-fold (let* 15 | (defn constant-fold/constant? (expr) 16 | (and (not (pair? expr)) 17 | (not (symbol? expr)) 18 | #t)) 19 | 20 | (defn constant-fold/pure? (fun) 21 | (:meta fun :pure)) 22 | 23 | (defn constant-fold/resolve (sym) 24 | (when-not (symbol? sym) (return sym)) 25 | (resolve sym)) 26 | 27 | (defn constant-fold/args (expr) 28 | (when-not expr (return expr)) 29 | (if (pair? (car expr)) 30 | (cons (constant-fold (car expr)) 31 | (constant-fold/args (cdr expr))) 32 | (cons (car expr) 33 | (constant-fold/args (cdr expr))))) 34 | 35 | (defn constant-fold (expr env) 36 | ; Will try and evaluate as many constant as possible to make the expression simpler. 37 | :internal 38 | (when-not (pair? expr) (return expr)) 39 | (def folded-fun (car expr)) 40 | (when (= 'quote folded-fun) (return expr)) 41 | (def folded-args (constant-fold/args (cdr expr))) 42 | (if (and (constant-fold/pure? folded-fun) 43 | (every? folded-args constant-fold/constant?)) 44 | (try (fn () (cons folded-fun folded-args)) 45 | (apply (constant-fold/resolve folded-fun) folded-args)) 46 | (cons folded-fun folded-args))))) 47 | -------------------------------------------------------------------------------- /tests/testsuite/language.nuj: -------------------------------------------------------------------------------- 1 | ;;; Contains test cases for (hopefully) all examples from the LANGUAGE.md file, to make sure that these examples never break 2 | 3 | ;; Parentheses 4 | (3 (eval (read/single "(+ 1 2)"))) 5 | (3 (eval (read/single "(+ 1 2)"))) 6 | ('a (eval (read/single "(car '(a . b))"))) 7 | ('b (eval (read/single "(cdr '(a . b))"))) 8 | (1 (eval (read/single "(car (cons 1 2))"))) 9 | (2 (eval (read/single "(cdr (cons 1 2))"))) 10 | 11 | ;; Comments 12 | (4 (eval (read/single "(+ 1 #;2 3)"))) 13 | (4 (eval (read/single "(+ 1 #| 2 |# 3)"))) 14 | (#nil (eval (read/single "(comment (exit 2))"))) 15 | 16 | ;; Numbers 17 | (9 (eval (read/single "9"))) 18 | (1000 (eval (read/single "100,0"))) 19 | (1000 (eval (read/single "1,000"))) 20 | (16 (eval (read/single "#b10000"))) 21 | (16 (eval (read/single "#b0001_0000"))) 22 | (4660 (eval (read/single "#x12_34"))) 23 | (8 (eval (read/single "#o10"))) 24 | (:read-error (try car (read/single "0x123"))) 25 | (-100 (try car (read/single "-100"))) 26 | ('a (eval (read/single "'a"))) 27 | ('(1 2 3) (eval (read/single "'(1 2 3)"))) 28 | ('(1 2 3) (eval (read/single "`(1 2 ~(+ 1 1 1))"))) 29 | 30 | ;; Symbols / Keywords 31 | (:unbound-variable (try car (eval (read "asd")))) 32 | ('asd 'asd) 33 | ('asd (:symbol "asd")) 34 | (#t (= 'asd (:symbol "asd"))) 35 | (#t (= 'asd (:symbol :asd))) 36 | (#t (= 'asd (:symbol 'asd))) 37 | 38 | (:asd :asd) 39 | (:asd (:keyword "asd")) 40 | (#t (= :asd (:keyword "asd"))) 41 | (#t (= :asd (:keyword :asd))) 42 | (#t (= :asd (:keyword 'asd))) 43 | 44 | (:asd (eval (read/single ":asd"))) 45 | (:asd (eval (read/single "asd:"))) 46 | (#t (eval (read/single "(= asd: :asd)"))) 47 | (#t (eval (read/single "(= :asd (:keyword 'asd))"))) 48 | 49 | (4 (eval (read/single "(do (defn double (α) (* α α)) (double 2))"))) 50 | ('(2 4 6) (eval (read/single "(do (defn multiply-vals (val . l) (map l (fn (v) (* v val)))) (multiply-vals 2 1 2 3))"))) 51 | ('(1 2 3 4) (eval (read/single "(do (defn my-list l l) (my-list 1 2 3 4))"))) 52 | 53 | ;; Variables 54 | (:unbound-variable (try car (eval (read/single "my-temp")))) 55 | (123 (eval (read/single "(do (def my-temp 123) my-temp)"))) 56 | (234 (eval (read/single "(do (def my-temp 123)\n my-temp (set! my-temp 234))"))) 57 | (16 (eval (read/single "(do (def double (fn (a) (* a a))) (double 4))"))) 58 | 59 | ;; Arithmetic 60 | (10 (+ 1 2 3 4)) 61 | (10 (+ 1 2 (+ 3 4))) 62 | (10 (+ (+ 1 2) (+ 3 4))) 63 | (-1 (+ 1 -2)) 64 | (-1 (+ 1 (- 2))) 65 | (-1 (+ 1 (- (+ 1 1)))) 66 | (:type-error (try car (eval (read/single "(+ 1 :two \"drei\")")))) 67 | (246 (def my-var 123) (* 2 my-var)) 68 | (:type-error (try car (eval (read/single "(do (def my-string \"tausend\") (* 2 my-string))")))) 69 | -------------------------------------------------------------------------------- /tests/fast/day14.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (defn polymer/read (line) 4 | (def eles {}) 5 | (def pairs {}) 6 | (dotimes (i (:length line)) 7 | (def key-a (:symbol (:cut line i (+ i 1)))) 8 | (if (:has? eles key-a) 9 | (tree/++ eles key-a) 10 | (set! eles key-a 1)) 11 | (when (< i (- (:length line) 1)) 12 | (def key-b (:symbol (:cut line i (+ i 2)))) 13 | (if (:has? pairs key-b) 14 | (tree/++ pairs key-b) 15 | (set! pairs key-b 1)))) 16 | {:pairs pairs :eles eles :combinations '()}) 17 | 18 | (defn combination/parse (recipe last-recipe) 19 | (def source (:symbol (car recipe))) 20 | (def new (:symbol (cadr recipe))) 21 | (def new-α (:symbol (cat (:cut (car recipe) 0 1) (cadr recipe)))) 22 | (def new-β (:symbol (cat (cadr recipe) (:cut (car recipe) 1 2)))) 23 | (fn (α Ω) 24 | (def count (int (or (ref (ref α :pairs) source) 0))) 25 | (tree/+= (ref Ω :eles) new count) 26 | (tree/+= (ref Ω :pairs) source (- count)) 27 | (tree/+= (ref Ω :pairs) new-α count) 28 | (tree/+= (ref Ω :pairs) new-β count) 29 | (if (lambda? last-recipe) (last-recipe α Ω) Ω))) 30 | 31 | (defn combination/add (state recipe) 32 | (set! state :combinations (combination/parse recipe (ref state :combinations)))) 33 | 34 | (defn combinations/read (state lines) 35 | (for-each lines (fn (line) (combination/add state (split line " -> ")))) 36 | state) 37 | 38 | (defn state/read (fn) 39 | (def input-raw (split (file/read fn) "\n")) 40 | (def state (polymer/read (car input-raw))) 41 | (combinations/read state (cddr input-raw))) 42 | 43 | (defn state/dup (α) 44 | {:combinations (ref α :combinations) :pairs (:clone (ref α :pairs)) :eles (:clone (ref α :eles))}) 45 | 46 | (defn state/run/once (α) 47 | ((ref α :combinations) α (state/dup α))) 48 | 49 | (defn state/run/many (α steps) 50 | (if (<= steps 0) α 51 | (state/run/many (state/run/once α) 52 | (- steps 1)))) 53 | 54 | (defn result (state) 55 | (- (apply max (:values (ref state :eles))) 56 | (apply min (:values (ref state :eles))))) 57 | 58 | (def state (state/read "tests/fast/day14.dat")) 59 | (def p1-state (state/run/many state 10)) 60 | (def res-p1 (result p1-state)) 61 | (when (not= res-p1 2010) 62 | (throw (list :wrong-result "Wrong Part 1 result" res-p1))) 63 | (def res-p2 (result (state/run/many p1-state 30))) 64 | (when (not= res-p2 2437698971143) 65 | (throw (list :wrong-result "Wrong Part 2 result" res-p2))) 66 | (return :success) 67 | -------------------------------------------------------------------------------- /tests/slow/day9.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (require :array/2d) 4 | 5 | (defn is-low-point? (data x y) 6 | (def v (array/2d/ref data x y)) 7 | (def top (if (> y 0) 8 | (array/2d/ref data x (- y 1)) 9 | 10)) 10 | (def bottom (if (< y (- (ref data :height) 1)) 11 | (array/2d/ref data x (+ y 1)) 12 | 10)) 13 | (def right (if (< x (- (ref data :width) 1)) 14 | (array/2d/ref data (+ x 1) y) 15 | 10)) 16 | (def left (if (> x 0) 17 | (array/2d/ref data (- x 1) y) 18 | 10)) 19 | (and (< v top) (< v bottom) (< v right) (< v left))) 20 | 21 | (defn count-basin-size (data x y) 22 | (if (or (< x 0) 23 | (>= x (ref data :width)) 24 | (< y 0) 25 | (>= y (ref data :height)) 26 | (= 9 (array/2d/ref data x y))) 27 | 0 28 | (do (array/2d/set! data x y 9) 29 | (+ 1 (count-basin-size data (- x 1) y) 30 | (count-basin-size data (+ x 1) y) 31 | (count-basin-size data x (- y 1)) 32 | (count-basin-size data x (+ y 1)))))) 33 | 34 | (defn array/2d/find-low-points (data) 35 | (def low-point-sum 0) 36 | (def basins #nil) 37 | (dotimes (y (ref data :height)) 38 | (dotimes (x (ref data :width)) 39 | (when (is-low-point? data x y) 40 | (+= low-point-sum (+ 1 (array/2d/ref data x y))) 41 | (set! basins (cons (count-basin-size data x y) basins))) 42 | )) 43 | (def bb (reverse (sort basins))) 44 | (def biggest-3-basins (list (car bb) (cadr bb) (caddr bb))) 45 | {:part1 low-point-sum :part2 (* (car bb) (cadr bb) (caddr bb))}) 46 | 47 | (defn map/set/row (data y line w) 48 | (def cols (map (split line "") read/int)) 49 | (dotimes (x w) 50 | (array/2d/set! data x y (car cols)) 51 | (cdr! cols))) 52 | 53 | (defn map/load (filename w h) 54 | (def ret (array/2d/allocate w h)) 55 | (def lines (split (file/read filename) "\n")) 56 | (dotimes (y h) 57 | (map/set/row ret y (car lines) w) 58 | (cdr! lines)) 59 | ret) 60 | 61 | (def ex-map (map/load "tests/slow/day9.dat" 100 100)) 62 | (def res (array/2d/find-low-points ex-map)) 63 | (def result (ref res :part1)) 64 | (when (not= result 480) 65 | (throw (list :wrong-result "Wrong result" result))) 66 | (def result (ref res :part2)) 67 | (when (not= result 1045660) 68 | (throw (list :wrong-result "Wrong result" result))) 69 | 70 | (return :success) 71 | -------------------------------------------------------------------------------- /stdlib_modules/net/http.nuj: -------------------------------------------------------------------------------- 1 | ;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg 2 | ;;; This project uses the MIT license, a copy should be included under /LICENSE 3 | ;;; 4 | (defn req* (verb host path header) 5 | (set! header (if header (:clone header) {})) 6 | (set! header :Host host) 7 | (set! header :Connection "close") 8 | (set! header :User-Agent "Nujel/0.1") 9 | (def header-lines (join (map (:keys header) 10 | (fn (k) (fmt "{}: {}" 11 | (:string k) 12 | (:string (ref header k))))) 13 | "\r\n")) 14 | (def req (fmt "{verb} {path} HTTP/1.1\r\n{header-lines}\r\n\r\n")) 15 | 16 | (def buf (buffer/allocate 0)) 17 | (def fh (socket/connect host 80)) 18 | (file/write* fh req (:length req)) 19 | (file/flush* fh) 20 | (def bytes-read 0) 21 | (def bytes-read-now 1) 22 | (while (not (zero? bytes-read-now)) 23 | (:length! buf (+ 65536 (:length buf))) 24 | (set! bytes-read-now (file/read* fh buf 65536 bytes-read)) 25 | (set! bytes-read (+ bytes-read bytes-read-now))) 26 | (file/close* fh) 27 | 28 | (def raw-res (buffer->string buf bytes-read)) 29 | (def eosl (:index-of raw-res "\r\n")) 30 | (when (< eosl 0) (return #nil)) 31 | (def eoh (:index-of raw-res "\r\n\r\n")) 32 | (when (< eoh 0) (return #nil)) 33 | 34 | (def headers {}) 35 | (def body (:cut buf (+ 4 eoh))) 36 | (def status-list (split (buffer->string buf eosl) " ")) 37 | (def status-code (read/int (cadr status-list))) 38 | (doseq (header (split (buffer->string buf eoh (+ 2 eosl)) "\r\n")) 39 | (def eok (:index-of header ":")) 40 | (when (>= eok 0) 41 | (def key (:keyword (:cut header 0 eok))) 42 | (def v (trim (:cut header (inc eok)))) 43 | (set! headers key v))) 44 | 45 | { :http-version (car status-list) 46 | :status-code status-code 47 | :status-message (join (cddr status-list) " ") 48 | :headers headers 49 | :body body}) 50 | 51 | (defn get (url) 52 | :export 53 | (when (= (:index-of url "https://") 0) 54 | (error "https is unsupported right now")) 55 | (when (= (:index-of url "http://") 0) 56 | (set! url (:cut url 7)) 57 | (def path-start (:index-of url "/")) 58 | (return (if (>= path-start 0) 59 | (http/req* "GET" 60 | (:cut url 0 path-start) 61 | (:cut url path-start)) 62 | (http/req* "GET" url "/")))) 63 | (error "unsupported scheme")) 64 | -------------------------------------------------------------------------------- /tests/testsuite/reader.nuj: -------------------------------------------------------------------------------- 1 | (1 1) 2 | ('asd 'asd) 3 | (:asd :asd) 4 | (1 (if #t 1 2)) 5 | (2 (if #f 1 2)) 6 | (123 #d123) 7 | (6 #b0110) 8 | (10 #b1010) 9 | (15 #b11_11) 10 | (7 #b01,11) 11 | (192 #b1100_0000) 12 | (255 #xFF) 13 | (255 #xFf) 14 | (160 #xa0) 15 | (31 #x1_F) 16 | (30 #x1,E) 17 | (50 #x32) 18 | (256 #x100) 19 | (0 #o) 20 | (7 #o7) 21 | (10 #o12) 22 | (26 #o32) 23 | (4294967295 #b11111111_11111111_11111111_11111111) 24 | (4294967295 #xFFFFFFFF) 25 | (2 (- (+ 1 #b10) 1)) 26 | (8 (- (+ 1 #o10) 1)) 27 | (16 (- (+ 1 #x10) 1)) 28 | (32 (+ #x10#x10)) 29 | (32 (+ #x10(+ 0#x10))) 30 | (0 (bit-and #xf0 #x0F)) 31 | (-31 #x-1F) 32 | (255 (bit-or #xf0 #x0F)) 33 | (255 (bit-or #xfF #xFF)) 34 | (255 (bit-xor #xf0 #x0F)) 35 | (240 (bit-xor #xff #x0F)) 36 | ('(3) (let ((test-string "3")) (read test-string) (read test-string))) 37 | (:read-error (try (fn (err) (car err)) (read "#b1111-0000"))) 38 | (:read-error (try (fn (err) (car err)) (read "#x1-F"))) 39 | (:read-error (try (fn (err) (car err)) (read "#o12378"))) 40 | (:read-error (try (fn (err) (car err)) (read "#d1F"))) 41 | (:read-error (try (fn (err) (car err)) (read "#qwe"))) 42 | (:read-error (try (fn (err) (car err)) (read "\"\\z\""))) 43 | (:read-error (try (fn (err) (car err)) (read "123kg"))) 44 | (:read-error (try (fn (err) (car err)) (read "123.123m"))) 45 | (:read-error (try (fn (err) (car err)) (read "123.123.123"))) 46 | ;(:read-error (try (fn (err) (car err)) (read "#xF.F"))) 47 | ;(:read-error (try (fn (err) (car err)) (read "#o7.7"))) 48 | ;(:read-error (try (fn (err) (car err)) (read "#b1.1"))) 49 | (:read-error (try (fn (e) (car e)) (read "#inf"))) 50 | (:read-error (try car (read/single "9999999999999999999"))) 51 | (:read-error (try car (read/single "1000000000000000000"))) 52 | (999999999999999999 (read/single "999999999999999999")) 53 | (100000000000000000 (read/single "100000000000000000")) 54 | (:read-error (try car (read "(. b)"))) 55 | (:read-error (try car (read "(a .)"))) 56 | (:read-error (try car (read "(#;a . b)"))) 57 | (:read-error (try car (read "(a . #;b)"))) 58 | (:read-error (try car (read "(#;x #;y . z)"))) 59 | (:read-error (try car (read "(#; #;x #;y . z)"))) 60 | (:read-error (try car (read "(#; #;x . z)"))) 61 | (123 (def i-assaultmegablaster 123) i-assaultmegablaster) 62 | (:dies-ist-ein-test-ob-lange-symbole-funktionieren :dies-ist-ein-test-ob-lange-symbole-funktionieren) 63 | ('(1) (read "#;(\"asd\") 1")) 64 | ('(1) (read "#;(asd) 1")) 65 | ('(1) (read "#;(asd (123)) 1")) 66 | ('(1 2) (read "1 #;(asd (123)) 2")) 67 | ('(1) (read "1 #;(asd (123))")) 68 | (5 (eval (cons 'do (read "(+ 1 #;(* 2 3) 4)")))) 69 | ('(x z) (eval (cons 'do (read "(list 'x #;'y 'z)")))) 70 | (12 (eval (cons 'do (read "(* 3 4 #;(+ 1 2))")))) 71 | (16 (eval (cons 'do (read "(#;sqrt abs -16)")))) 72 | ('(a . c) (eval (cons 'do (read "'(a . #;b c)")))) 73 | ('(a . b) (eval (cons 'do (read "'(a . b #;c)")))) 74 | -------------------------------------------------------------------------------- /tests/fast/day3-2.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (def example-data "00100\n11110\n10110\n10111\n10101\n01111\n00111\n11100\n10000\n11001\n00010\n01010") 4 | (def input-data (file/read "tests/fast/day3.dat")) 5 | 6 | (defn bit-set?! (i) 7 | "Returns a function that checks if bit I is set in the provided number" 8 | (def mask (bit-shift-left 1 i)) 9 | (fn (α) (not (zero? (bit-and α mask))))) 10 | 11 | (defn bit-clear?! (i) 12 | "Returns a function that checks if bit I is clear in the provided number" 13 | (def mask (bit-shift-left 1 i)) 14 | (fn (α) (zero? (bit-and α mask)))) 15 | 16 | (defn read-data (lines) 17 | (map (split lines "\n") 18 | (fn (line) 19 | (car (read (cat "#b" line)))))) 20 | 21 | (defn calc-γε (numbers bit-count) 22 | (def γ 0) 23 | (def ε 0) 24 | (def i 0) 25 | (def threshold (/ (:length numbers) 2)) 26 | (while (< i bit-count) 27 | (if (> (count numbers (bit-set?! i)) threshold) 28 | (set! γ (bit-or γ (bit-shift-left 1 i))) 29 | (set! ε (bit-or ε (bit-shift-left 1 i)))) 30 | (inc! i)) 31 | {:γ γ :ε ε :power-consumption (* γ ε)}) 32 | 33 | (defn calc-real (numbers bit p) 34 | (if (<= (:length numbers) 1) 35 | (car numbers) 36 | (do (when (< bit 0) (stacktrace) (throw :we-dun-goof)) 37 | (def bits (count numbers (bit-set?! bit))) 38 | (def rest (- (:length numbers) bits)) 39 | (if (p bits rest) 40 | (calc-real (filter numbers (bit-set?! bit)) (- bit 1) p) 41 | (if (= bits rest) 42 | (if (= p >) 43 | (calc-real (filter numbers (bit-set?! bit)) (- bit 1) p) 44 | (calc-real (filter numbers (bit-clear?! bit)) (- bit 1) p)) 45 | (calc-real (filter numbers (bit-clear?! bit)) (- bit 1) p)))))) 46 | 47 | (defn calc-oxy-co (numbers bit-count) 48 | (def oxy (calc-real numbers (- bit-count 1) >)) 49 | (def co (calc-real numbers (- bit-count 1) <)) 50 | {:oxy oxy :co co :power-consumption (* oxy co)}) 51 | 52 | (def result (calc-γε (read-data example-data) 5)) 53 | (when (not= (ref result :power-consumption) 198) 54 | (throw (list :wrong-result "Wrong result" result))) 55 | 56 | (def result (calc-γε (read-data input-data) 12)) 57 | (when (not= (ref result :power-consumption) 4103154) 58 | (throw (list :wrong-result "Wrong result" result))) 59 | 60 | (def result (calc-oxy-co (read-data example-data) 5)) 61 | (when (not= (ref result :power-consumption) 230) 62 | (throw (list :wrong-result "Wrong result" result))) 63 | 64 | (def result (calc-oxy-co (read-data input-data) 12)) 65 | (when (not= (ref result :power-consumption) 4245351) 66 | (throw (list :wrong-result "Wrong result" result))) 67 | (return :success) 68 | -------------------------------------------------------------------------------- /tests/testsuite/arrays.nuj: -------------------------------------------------------------------------------- 1 | ("##(2 3 4)" (string/write (-> [1 2 3 4] (delete 1)))) 2 | ("##(1 2 3 #nil)" (string/write (array/push [1 2 3]))) 3 | ("##(1 2 3 \"4\")" (string/write (array/push [1 2 3] "4"))) 4 | ("##(1 2 3 4)" (string/write (array/push [1 2 3] 4))) 5 | ("##(1 2 3 5.2)" (string/write (array/push [1 2 3] 5.2))) 6 | (0 (:length [])) 7 | (1 (:length [1])) 8 | (4 (:length [1 2 3 4])) 9 | (2 (ref [1 2 3 4] 1)) 10 | (3 (:length (:alloc Array 3))) 11 | (#t (array/equal? [1 2 3] [1 2 3])) 12 | (#f (array/equal? [2 2 3] [1 2 3])) 13 | (#f (array/equal? [1 2 3] [1 2 3 4])) 14 | (#f (array/equal? [1 2 3 4] [1 2 3])) 15 | (#t (array/equal? [1.0 2.0 3.0] [1.0 2.0 3.0])) 16 | (#t (array/equal? [:a :b :c] [:a :b :c])) 17 | (#f (array/equal? [:a :b :c] [:a :b :d])) 18 | (#f (array/equal? ["a" "b" "c"] ["a" "b" "d"])) 19 | (#t (array/equal? ["a" "b" "c"] ["a" "b" "c"])) 20 | (#t (array? [1 2 3])) 21 | (#t (array? (:alloc Array 3))) 22 | (#f (array? '(1 2 3))) 23 | (#f (array? {:a 1 :b 2 :c 3})) 24 | (:type-error (try car (def ein-test-arr [1 2 3]) (ref ein-test-arr 2.2))) 25 | ([99 2 3 4] (let ((cur-arr [1 2 3 4])) (set! cur-arr 0 99) cur-arr)) 26 | ([42 42 42 42 42 42] (array/fill! (:alloc Array 6) 42)) 27 | (3 (def ein-test-arr [1 2 3]) (ref ein-test-arr 2)) 28 | (2 (def ein-test-arr [1 2 3]) (ref ein-test-arr 1)) 29 | (:out-of-bounds (try car (def testerle [1 2 3]) (ref testerle 4))) 30 | (:out-of-bounds (try car (def testerle [1 2 3]) (ref testerle 40000))) 31 | ([1 2 3] (def testerle [1 2 3]) testerle) 32 | (:type-error (try car (def testerle [1 2 3]) (ref testerle #t))) 33 | (1 (ref [1 2 3] 0)) 34 | (2 (def arr [1 2 3]) (:length! arr 2) (:length arr)) 35 | (3 (def arr [1 2 3]) (:length! arr 2) (reduce arr + 0)) 36 | ("##(2 4)" (string/write (filter [1 2 3 4] even?))) 37 | ("##(0 0 0)" (string/write (-> (:alloc Array 3) (array/fill! 0)))) 38 | ("##(3 9 0)" (string/write (-> (:alloc Array 3) (array/fill! 0) (set! 1 9) (set! 0 3)))) 39 | (10 (def arr [1 2 3]) (:length! arr 4) (set! arr 3 4) (reduce arr + 0)) 40 | (10 (-> [1 2 3] (:length! 4) (set! 3 4) (reduce + 0))) 41 | ("##(#nil)" (string/write (set! [1] 0 #nil))) 42 | ("##(2)" (string/write (set! [1] 0 2))) 43 | ("##(#t)" (string/write (set! [1] 0 #t))) 44 | ("##(#f)" (string/write (set! [1] 0 #f))) 45 | ("##(1 2 3 4)" (string/write (array/append [1 2] [3 4]))) 46 | ("##(1 2 3)" (string/write (array/append [1 2] [3]))) 47 | ("##(1 2)" (string/write (array/append [1 2] []))) 48 | (:type-error (try car (array/append [1] '(2)))) 49 | (:type-error (try car (array/append '(1) #nil))) 50 | (:type-error (try car (array/append [1]))) 51 | (:type-error (try car (array/append '(1)))) 52 | (:type-error (try car (array/append))) 53 | ("##(1 2 3)" (string/write (let ((o [2 2 3])) (set! o 0 1) (set! (array/dup o) 0 3) o))) 54 | (#f (= [1] [1])) 55 | (#f (= [1] [2])) 56 | (#t (let ((a [1])) (= a a))) 57 | (#t (:has? [1 2 3] 0)) 58 | (#t (:has? [1 2 3] 2)) 59 | (#f (:has? [1 2 3] 3)) 60 | (#f (:has? [1 2 3] -1)) 61 | (#f (:has? [] 0)) 62 | -------------------------------------------------------------------------------- /lib/allocator.c: -------------------------------------------------------------------------------- 1 | /* Nujel - Copyright (C) 2020-2022 - Benjamin Vincent Schulenburg 2 | * This project uses the MIT license, a copy should be included under /LICENSE */ 3 | #ifndef NUJEL_AMALGAMATION 4 | #include "nujel-private.h" 5 | #endif 6 | 7 | bool lGCShouldRunSoon = false; 8 | 9 | #define defineAllocator(T, typeMax) \ 10 | T T##List[typeMax]; \ 11 | uint T##Max = 0; \ 12 | uint T##Active = 0; \ 13 | T * T##FFree = NULL; \ 14 | T * T##AllocRaw (){\ 15 | T *ret;\ 16 | if((T##FFree) == NULL){ \ 17 | if(unlikely(T##Max >= typeMax-1)){ \ 18 | fprintf(stderr, "OOM: static %s heap exhausted \n", #T);\ 19 | exit(123);\ 20 | }else{\ 21 | ret = &(T##List)[(T##Max)++]; \ 22 | }\ 23 | }else{\ 24 | ret = T ## FFree;\ 25 | (T##FFree) = ret->nextFree;\ 26 | }\ 27 | if(unlikely((typeMax - (++T##Active) < 128))){lGCShouldRunSoon = true;} \ 28 | T##MarkMap[ret - T##List] = 0;\ 29 | memset(ret,0,sizeof(T));\ 30 | return ret;\ 31 | } 32 | allocatorTypes() 33 | #undef defineAllocator 34 | 35 | lNFunc lNFuncList[NFN_MAX]; 36 | uint lNFuncMax = 0; 37 | 38 | 39 | int lBufferViewTypeSize(lBufferViewType T){ 40 | switch(T){ 41 | default: 42 | exit(4); 43 | case lbvtU8: 44 | case lbvtS8: 45 | return 1; 46 | case lbvtS16: 47 | case lbvtU16: 48 | return 2; 49 | case lbvtF32: 50 | case lbvtS32: 51 | case lbvtU32: 52 | return 4; 53 | case lbvtF64: 54 | case lbvtS64: 55 | return 8; 56 | } 57 | } 58 | 59 | 60 | lBuffer *lBufferAlloc(size_t length, bool immutable){ 61 | lBuffer *ret = lBufferAllocRaw(); 62 | ret->length = length; 63 | if(immutable){ 64 | ret->flags = BUFFER_IMMUTABLE; 65 | }else{ 66 | ret->buf = calloc(length, 1); 67 | } 68 | return ret; 69 | } 70 | 71 | lBufferView *lBufferViewAlloc(lBuffer *buf, lBufferViewType type, size_t offset, size_t length, bool immutable){ 72 | lBufferView *ret = lBufferViewAllocRaw(); 73 | ret->buf = buf; 74 | ret->offset = offset; 75 | ret->length = length; 76 | ret->flags = immutable; 77 | ret->type = type; 78 | return ret; 79 | } 80 | 81 | lBytecodeArray *lBytecodeArrayAlloc(size_t len){ 82 | lBytecodeArray *ret = lBytecodeArrayAllocRaw(); 83 | ret->data = calloc(len, sizeof(lBytecodeOp)); 84 | if(unlikely(ret->data == NULL)){ 85 | fprintf(stderr, "OOM: Couldn't allocate a new BC array\n"); 86 | exit(134); 87 | } 88 | ret->dataEnd = &ret->data[len]; 89 | return ret; 90 | } 91 | 92 | lArray *lArrayAlloc(size_t len){ 93 | lArray *ret = lArrayAllocRaw(); 94 | ret->data = calloc(len + 1, sizeof(lVal)); 95 | if(unlikely(ret->data == NULL)){ 96 | fprintf(stderr, "OOM: Couldn't allocate a new array"); 97 | exit(135); 98 | } 99 | ret->length = len; 100 | return ret; 101 | } 102 | 103 | lNFunc *lNFuncAlloc(){ 104 | if(unlikely(lNFuncMax >= NFN_MAX-1)){ 105 | exit(124); 106 | } 107 | memset(&lNFuncList[lNFuncMax++], 0, sizeof(ltNativeFunc)); 108 | return &lNFuncList[lNFuncMax++]; 109 | } 110 | -------------------------------------------------------------------------------- /lib/array.c: -------------------------------------------------------------------------------- 1 | /* Nujel - Copyright (C) 2020-2022 - Benjamin Vincent Schulenburg 2 | * This project uses the MIT license, a copy should be included under /LICENSE */ 3 | #ifndef NUJEL_AMALGAMATION 4 | #include "nujel-private.h" 5 | #endif 6 | 7 | static lVal lnmArrayLength(lVal self){ 8 | return lValInt(self.vArray->length); 9 | } 10 | 11 | static lVal lnmArrayLengthSet(lVal self, lVal newLength){ 12 | reqNaturalInt(newLength); 13 | const size_t length = newLength.vInt; 14 | lArray *arr = self.vArray; 15 | 16 | lVal *newData = realloc(arr->data,length * sizeof(lVal)); 17 | if (unlikely(newData == NULL)) { 18 | free(newData); 19 | return lValException(lSymOOM, "(:length Array) couldn't allocate its array", self); 20 | } 21 | arr->data = newData; 22 | if(length > (size_t)arr->length){ 23 | memset(&arr->data[arr->length], 0, (length - arr->length) * sizeof(lVal)); 24 | } 25 | arr->length = length; 26 | return self; 27 | } 28 | 29 | /* Return the length of the list V */ 30 | static int lListLength(lVal v){ 31 | int i = 0; 32 | for(lVal n = v;(n.type == ltPair) && (n.vList->car.type != ltNil); n = n.vList->cdr){ 33 | i++; 34 | } 35 | return i; 36 | } 37 | 38 | lVal lnfArrNew(lVal v){ 39 | int length = lListLength(v); 40 | lVal r = lValAlloc(ltArray, lArrayAlloc(length)); 41 | int key = 0; 42 | for(lVal n = v; n.type == ltPair; n = n.vList->cdr){ 43 | r.vArray->data[key++] = n.vList->car; 44 | } 45 | return r; 46 | } 47 | 48 | static lVal lnmArrayToBytecodeArray(lVal self, lVal aLiterals){ 49 | lArray *arr = self.vArray; 50 | const int len = arr->length; 51 | 52 | reqArray(aLiterals); 53 | lBytecodeOp *ops = malloc(sizeof(lBytecodeOp) * len); 54 | for(int i=0;idata[i].type != ltInt)){ 56 | free(ops); 57 | return lValException(lSymTypeError, "Need an Int", arr->data[i]); 58 | } 59 | ops[i] = arr->data[i].vInt; 60 | } 61 | lVal ret = lValBytecodeArray(ops, len, aLiterals.vArray); 62 | free(ops); 63 | return ret; 64 | } 65 | 66 | static lVal lnmArrayAllocate(lVal self, lVal size){ 67 | (void)self; 68 | reqNaturalInt(size); 69 | lVal r = lValAlloc(ltArray, lArrayAlloc(size.vInt)); 70 | if(unlikely(size.vInt && (r.vArray->data == NULL))){ 71 | return lValException(lSymOOM, "(:alloc Array) couldn't allocate its array", size); 72 | } 73 | return r; 74 | } 75 | 76 | static lVal lnmArrayHas(lVal self, lVal index){ 77 | reqInt(index); 78 | const i64 i = index.vInt; 79 | return lValBool((i >= 0) && (i < self.vArray->length)); 80 | } 81 | 82 | void lOperationsArray(){ 83 | lClass *Array = &lClassList[ltArray]; 84 | lAddNativeMethodV(Array, lSymS("length"), "(self)", lnmArrayLength, 0); 85 | lAddNativeMethodVV(Array, lSymS("length!"), "(self new-size)", lnmArrayLengthSet, 0); 86 | lAddNativeMethodVV(Array, lSymS("bytecode-array"), "(self literals)", lnmArrayToBytecodeArray, 0); 87 | lAddNativeMethodVV(Array, lSymS("has?"), "(self index)", lnmArrayHas, NFUNC_PURE); 88 | 89 | lAddNativeStaticMethodVV(Array, lSymS("alloc"), "(self size)", lnmArrayAllocate, NFUNC_PURE); 90 | } 91 | -------------------------------------------------------------------------------- /tests/testsuite/bytecode.nuj: -------------------------------------------------------------------------------- 1 | (:bytecode-array (:type-name (:bytecode-array [#x0 #x9 #xF #x10 #xFF] []))) 2 | (#x0 (ref (:array (:bytecode-array [#x0 #x9 #xF #x10 #xFF] [])) 0)) 3 | (0 (bytecode-eval* (:bytecode-array [#x2 #x0 #x1] []) (environment*))) 4 | (127 (bytecode-eval* (:bytecode-array [#x2 #x7F #x1] []) (environment*))) 5 | (-1 (bytecode-eval* (:bytecode-array [#x2 #xFF #x1] []) (environment*))) 6 | (-128 (bytecode-eval* (:bytecode-array [#x2 #x80 #x1] []) (environment*))) 7 | (5 (bytecode-eval* (assemble ($push/int 3) ($push/int 2) ($add/int) ($ret)) (environment*))) 8 | (3 (bytecode-eval* (assemble ($push/int 3) ($ret)) (environment*))) 9 | (0 (bytecode-eval* (assemble ($push/int 0) ($ret)) (environment*))) 10 | (-3 (bytecode-eval* (assemble ($push/int -3) ($ret)) (environment*))) 11 | (-128 (bytecode-eval* (assemble ($push/int -128) ($nop) ($ret)) (environment*))) 12 | (127 (bytecode-eval* (assemble ($push/int 127) ($ret)) (environment*))) 13 | ('(123 asd) (asmrun ($push/val '(123 asd)) ($ret))) 14 | ('test (asmrun ($push/val 'test) ($ret))) 15 | (2 ((asmrun ($push/val (fn (a) (+ 1 a))) ($ret)) 1)) 16 | ('(test list) (let ((code (assemble ($push/val (list 'test 'list)) ($ret)))) (bytecode-eval* code (environment*)))) 17 | ;;(5 (asmrun ($push/int 2) ($push/int 3) ($apply 2 add/int) ($ret))) 18 | ;;(4 (asmrun ($push/int 2) ($dup) ($apply 2 add/int) ($ret))) 19 | (26 (asmrun ($nop) ($push/int 26) ($jmp :asd) ($push/int 99) (list :label :asd) ($ret))) 20 | (26 (asmrun ($nop) ($push/int 26) ($push/val #t) ($jt :asd) ($push/int 99) (list :label :asd) ($ret))) 21 | (99 (asmrun ($nop) ($push/int 26) ($push/val #f) ($jt :asd) ($push/int 99) (list :label :asd) ($ret))) 22 | (55 (+ 1 (+ 2 (+ 3 (+ 4 (+ 5 (+ 6 (+ 7 (+ 8 (+ 9 10)))))))))) 23 | (:asd (try (fn (a) (car a)) (throw '(:asd "Test")) :error)) 24 | (:asd (try car (throw '(:asd "Test")) :error)) 25 | (3 (asmrun ($jmp :start) (list :label :ret) ($push/int 3) ($ret) (list :label :start) ($push/int 2) ($jmp :ret) ($ret))) 26 | (5 (asmrun ($jmp :start) (list :label :func) ($push/int 2) ($add/int) ($ret) (list :label :start) ($push/int 3) ($jmp :func))) 27 | ;;('(1 . 2) (asmrun ($push/int 1) ($push/int 2) ($apply 2 cons) ($ret))) 28 | ;;(1 (asmrun ($push/int 1) ($push/int 2) ($apply 2 cons) ($apply 1 car) ($ret))) 29 | ;;(1 (apply (environment*) (apply assemble (list ($push/int 1) ($push/int 2) ($apply 2 cons) ($apply 1 car) ($ret))))) 30 | (37 (asmrun ($push/val +) ($push/int 12) ($push/int 25) ($apply 2) ($ret))) 31 | (3 (bytecode-eval* (:bytecode-array (apply array/new (flatten (list ($push/int 1) ($push/int 2) ($add/int) ($ret)))) []) (environment*))) 32 | ('test (asmrun ($push/val 'test) ($ret))) 33 | (#nil (asmrun ($push/nil) ($ret))) 34 | (:invalid-bc-op (try car (asmrun ($push/val #nil) ($ret)))) 35 | (4 (def min* (fn (a b) (if (< a b) a b))) (+ (min* 1 3) (min* 10 3))) 36 | (:vm-error (try car (apply return '(:test)))) 37 | (1 ((fn () (return 1) 3))) 38 | ;;('(:a :b) (asmrun ($push/val :a) ($push/val '(:b)) ($apply 2 cons) ($ret))) 39 | ('(:a :b) (asmrun ($push/val :a) ($push/val '(:b)) ($cons) ($ret))) 40 | (:a (asmrun ($push/val '(:a :b)) ($car) ($ret))) 41 | ('(:b) (asmrun ($push/val '(:a :b)) ($cdr) ($ret))) 42 | -------------------------------------------------------------------------------- /lib/val.c: -------------------------------------------------------------------------------- 1 | /* Nujel - Copyright (C) 2020-2022 - Benjamin Vincent Schulenburg 2 | * This project uses the MIT license, a copy should be included under /LICENSE */ 3 | #ifndef NUJEL_AMALGAMATION 4 | #include "nujel-private.h" 5 | #endif 6 | 7 | lVal NIL; 8 | 9 | static inline i64 lStringGreater(const lBuffer *a, const lBuffer *b) { 10 | const uint alen = lBufferLength(a); 11 | const uint blen = lBufferLength(b); 12 | const uint len = MIN(alen,blen); 13 | const char *ab = a->data; 14 | const char *bb = b->data; 15 | for(uint i=0;ic, sizeof(a->c)); 27 | const uint blen = strnlen(b->c, sizeof(b->c)); 28 | const uint len = MIN(alen,blen); 29 | const char *ab = a->c; 30 | const char *bb = b->c; 31 | for(uint i=0;i b.vFloat) 50 | ? 1 51 | : 0; 52 | } else if ((a.type == ltFloat) && (b.type == ltInt)) { 53 | return (a.vFloat < ((float)b.vInt)) 54 | ? -1 55 | : (a.vFloat > ((float)b.vInt)) 56 | ? 1 57 | : 0; 58 | } 59 | return 0; 60 | } 61 | switch(a.type){ 62 | default: 63 | return 0; 64 | case ltInt: 65 | return a.vInt - b.vInt; 66 | case ltFloat: 67 | return a.vFloat < b.vFloat ? -1 : 1; 68 | case ltKeyword: 69 | case ltSymbol: 70 | return lSymbolGreater(a.vSymbol, b.vSymbol); 71 | case ltString: 72 | return lStringGreater(a.vString, b.vString); 73 | } 74 | } 75 | 76 | /* Check two values for equality */ 77 | bool lValEqual(const lVal a, const lVal b) { 78 | if (unlikely(a.type != b.type)) { 79 | if ((a.type == ltInt) && (b.type == ltFloat)) { 80 | return ((float)a.vInt) == b.vFloat; 81 | } else if ((a.type == ltFloat) && (b.type == ltInt)) { 82 | return a.vFloat == ((float)b.vInt); 83 | } 84 | return false; 85 | } 86 | switch(a.type){ 87 | case(ltString):{ 88 | const uint alen = lBufferLength(a.vString); 89 | const uint blen = lBufferLength(b.vString); 90 | return (alen == blen) && (memcmp(a.vString->data, b.vString->data, alen) == 0); } 91 | case(ltBool): 92 | return a.vBool == b.vBool; 93 | case(ltInt): 94 | return a.vInt == b.vInt; 95 | case(ltFloat): 96 | return a.vFloat == b.vFloat; 97 | default: 98 | return a.vPointer == b.vPointer; 99 | } 100 | } 101 | 102 | lVal lValException(const lSymbol *symbol, const char *error, lVal v) { 103 | lVal l = lCons(v, NIL); 104 | l = lCons(lValString(error),l); 105 | l = lCons(lValKeywordS(symbol),l); 106 | l.type = ltException; 107 | return l; 108 | } 109 | -------------------------------------------------------------------------------- /tests/slow/day11.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (require :array/2d) 4 | 5 | (def flashes/get) 6 | (def flashes/inc!) 7 | (let ((flashes/counter 0)) 8 | (set! flashes/get (fn () flashes/counter)) 9 | (set! flashes/inc! (fn () (inc! flashes/counter)))) 10 | (def p1-res 0) 11 | (def p2-res 0) 12 | 13 | (defn map/set/row (data y line w) 14 | (def cols (map (split line "") read/int)) 15 | (dotimes (x w) 16 | (array/2d/set! data x y (car cols)) 17 | (cdr! cols))) 18 | 19 | (defn map/load (filename w h) 20 | (def ret (array/2d/allocate w h)) 21 | (def lines (split (file/read filename) "\n")) 22 | (dotimes (y h) 23 | (map/set/row ret y (car lines) w) 24 | (cdr! lines)) 25 | ret) 26 | 27 | (defn step/increase-energy (α β) 28 | (dotimes (x (ref α :width)) 29 | (dotimes (y (ref α :height)) 30 | (array/2d/set! β x y (+ 1 (array/2d/ref α x y)))))) 31 | 32 | (defn step/flash-increase (β flash-map x y) 33 | (when (and (= #f (array/2d/ref flash-map x y)) 34 | (>= x 0) 35 | (>= y 0) 36 | (< x (ref β :width)) 37 | (< y (ref β :height))) 38 | (array/2d/set! β x y (+ 1 (array/2d/ref β x y))) 39 | (step/flash-try β flash-map x y))) 40 | 41 | (defn step/flash-try (β flash-map x y) 42 | (when-not (array/2d/ref flash-map x y) 43 | (when (> (array/2d/ref β x y) 9) 44 | (array/2d/set! β x y 0) 45 | (array/2d/set! flash-map x y #t) 46 | (flashes/inc!) 47 | (def cx (- x 1)) 48 | (while (< cx (+ x 2)) 49 | (def cy (- y 1)) 50 | (while (< cy (+ y 2)) 51 | (step/flash-increase β flash-map cx cy) 52 | (inc! cy)) 53 | (inc! cx))))) 54 | 55 | (defn step/flash (β) 56 | (def flash-map (array/2d/allocate (ref β :width) (ref β :height))) 57 | (array/fill! (ref flash-map :data) #f) 58 | (dotimes (x (ref β :width)) 59 | (dotimes (y (ref β :height)) 60 | (step/flash-try β flash-map x y)))) 61 | 62 | (defn step (α) 63 | (def β (array/2d/allocate (ref α :width) (ref α :height))) 64 | (step/increase-energy α β) 65 | (step/flash β) 66 | β) 67 | 68 | (defn step/do-many (α steps) 69 | (dotimes (i steps) 70 | (if (= i 100) (set! p1-res (flashes/get))) 71 | (def pre-flashes (flashes/get)) 72 | (set! α (step α)) 73 | (when (= 100 (- (flashes/get) pre-flashes)) 74 | (set! p2-res (+ 1 i)) 75 | (throw (list :all-flashes)))) 76 | α) 77 | 78 | (def state (map/load "tests/slow/day11.dat" 10 10)) 79 | (try (fn (ε) (when (not= (car ε) :all-flashes) (throw ε))) 80 | (def ret (step/do-many state 1000))) 81 | (when (not= p1-res 1694) 82 | (throw (list :wrong-result "Wrong result" p1-res))) 83 | (when (not= p2-res 346) 84 | (throw (list :wrong-result "Wrong result" p2-res))) 85 | (return :success) 86 | -------------------------------------------------------------------------------- /tests/slow/day13.nuj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nujel 2 | 3 | (require :array/2d) 4 | 5 | (defn fold/load (filename) 6 | (def points #nil) 7 | (def γ (reduce (split (file/read filename) "\n") 8 | (fn (α β) 9 | (cond ((zero? (:length β)) α) 10 | ((= (ref β 0) #\f) 11 | (set! α :folds (cons (split (caddr (split β " ")) "=") (ref α :folds)))) 12 | (#t (def τ (map (split β ",") read/single)) 13 | (set! points (cons τ points)) 14 | (set! α :width (max (ref α :width) (+ 1 (car τ)))) 15 | (set! α :height (max (ref α :height) (+ 1 (cadr τ))))))) 16 | {:width 0 :height 0 :folds #nil})) 17 | (set! γ :data (-> (:alloc Array (* (ref γ :width) (ref γ :height))) (array/fill! 0))) 18 | (while points 19 | (set! (ref γ :data) (+ (caar points) (* (ref γ :width) (cadar points))) 1) 20 | (cdr! points)) 21 | (set! γ :folds (reverse (ref γ :folds)))) 22 | 23 | (defn fold-y (data y) 24 | (def ret (array/2d/allocate (ref data :width) (div/int (ref data :height) 2))) 25 | (def dh (ref data :height)) 26 | (def rw (ref ret :width)) 27 | (def rh (ref ret :height)) 28 | 29 | (dotimes (y rh) 30 | (dotimes (x rw) 31 | (array/2d/set! ret x y (+ (array/2d/ref data x y) 32 | (array/2d/ref data x (- dh y 1)))))) 33 | (set! ret :folds (cdr (ref data :folds)))) 34 | 35 | (defn fold-x (data y) 36 | (def ret (array/2d/allocate (div/int (ref data :width) 2) (ref data :height))) 37 | (def dw (ref data :width)) 38 | (def rw (ref ret :width)) 39 | (def rh (ref ret :height)) 40 | 41 | (dotimes (y rh) 42 | (dotimes (x rw) 43 | (array/2d/set! ret x y (+ (array/2d/ref data x y) 44 | (array/2d/ref data (- dw x 1) y))))) 45 | (set! ret :folds (cdr (ref data :folds)))) 46 | 47 | (defn do-fold (α) 48 | (if (= (caar (ref α :folds)) "x") 49 | (fold-x α (cadr (ref α :folds))) 50 | (fold-y α (cadr (ref α :folds))))) 51 | 52 | (defn do-all-folds (α) 53 | (while (ref α :folds) 54 | (set! α (do-fold α))) 55 | α) 56 | 57 | (defn dot-count (α) 58 | (def β (ref α :data)) 59 | (def len (:length β)) 60 | (def ret 0) 61 | (dotimes (i len ret) 62 | (when (> (ref β i) 0) (inc! ret)))) 63 | 64 | (defn print-folded (α) 65 | (dotimes (y (ref α :height)) 66 | (dotimes (x (ref α :width)) 67 | (if (zero? (array/2d/ref α x y)) 68 | (display ".") 69 | (display "#"))) 70 | (newline))) 71 | (def res-p1 (dot-count (do-fold (fold/load "tests/slow/day13.input")))) 72 | (def final-map (do-all-folds (fold/load "tests/slow/day13.input"))) 73 | (def res-p2 (dot-count final-map)) 74 | 75 | (when (not= res-p1 842) 76 | (throw (list :wrong-result "Wrong result" res-p1))) 77 | (when (not= res-p2 95) 78 | (throw (list :wrong-result "Wrong result" res-p2))) 79 | 80 | (return :success) 81 | --------------------------------------------------------------------------------