├── tests ├── test.txt ├── incC.mal ├── incA.mal ├── print_argv.mal ├── inc.mal ├── incB.mal ├── docker-build.sh ├── docker-run.sh ├── perf2.mal ├── step5_tco.mal ├── perf1.mal ├── computations.mal ├── perf3.mal ├── step2_eval.mal ├── run_argv_test.sh ├── step0_repl.mal ├── step3_env.mal ├── travis_trigger.sh ├── step8_macros.mal ├── step6_file.mal ├── step1_read_print.mal ├── docker │ └── Dockerfile ├── stepA_mal.mal ├── step7_quote.mal ├── step9_try.mal └── step4_if_fn_do.mal ├── run ├── .gitignore ├── shard.lock ├── step0_repl.cr ├── shard.yml ├── error.cr ├── .vscode └── launch.json ├── .devcontainer ├── devcontainer.json └── Dockerfile ├── grammars ├── lisp.g └── mal.g ├── step1_read_print.cr ├── Dockerfile ├── printer.cr ├── Makefile ├── env.cr ├── types.cr ├── step2_eval.cr ├── README.md ├── step3_env.cr ├── reader.cr ├── peg_reader_mal.cr ├── step4_if_fn_do.cr ├── step5_tco.cr ├── step6_file.cr ├── step7_quote.cr ├── step8_macros.cr ├── step9_try.cr ├── stepA_mal.cr ├── runtest.py └── core.cr /tests/test.txt: -------------------------------------------------------------------------------- 1 | A line of text 2 | -------------------------------------------------------------------------------- /tests/incC.mal: -------------------------------------------------------------------------------- 1 | (def! mymap {"a" 2 | 1}) 3 | -------------------------------------------------------------------------------- /run: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | exec $(dirname $0)/${STEP:-stepA_mal} "${@}" 3 | -------------------------------------------------------------------------------- /tests/incA.mal: -------------------------------------------------------------------------------- 1 | (def! inc4 (fn* (a) (+ 4 a))) 2 | 3 | (prn (inc4 5)) 4 | -------------------------------------------------------------------------------- /tests/print_argv.mal: -------------------------------------------------------------------------------- 1 | ; Used by the run_argv_test.sh test harness 2 | (prn *ARGV*) 3 | -------------------------------------------------------------------------------- /tests/inc.mal: -------------------------------------------------------------------------------- 1 | (def! inc1 (fn* (a) (+ 1 a))) 2 | (def! inc2 (fn* (a) (+ 2 a))) 3 | (def! inc3 (fn* (a) 4 | (+ 3 a))) 5 | -------------------------------------------------------------------------------- /tests/incB.mal: -------------------------------------------------------------------------------- 1 | ;; A comment in a file 2 | (def! inc4 (fn* (a) (+ 4 a))) 3 | (def! inc5 (fn* (a) ;; a comment after code 4 | (+ 5 a))) 5 | 6 | ;; ending comment without final new line -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | lib 2 | bin 3 | step0_repl 4 | step1_read_print 5 | step2_eval 6 | step3_env 7 | step4_if_fn_do 8 | step5_tco 9 | step6_file 10 | step7_quote 11 | step8_macros 12 | step9_try 13 | stepA_mal -------------------------------------------------------------------------------- /tests/docker-build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | IMAGE_NAME=${IMAGE_NAME:-mal-test-ubuntu-utopic} 4 | GIT_TOP=$(git rev-parse --show-toplevel) 5 | 6 | docker build -t "${IMAGE_NAME}" "${GIT_TOP}/tests/docker" 7 | -------------------------------------------------------------------------------- /tests/docker-run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | IMAGE_NAME=${IMAGE_NAME:-mal-test-ubuntu-utopic} 4 | GIT_TOP=$(git rev-parse --show-toplevel) 5 | 6 | docker run -it --rm -u ${EUID} \ 7 | --volume=${GIT_TOP}:/mal \ 8 | ${IMAGE_NAME} \ 9 | "${@}" 10 | -------------------------------------------------------------------------------- /tests/perf2.mal: -------------------------------------------------------------------------------- 1 | (load-file "../lib/load-file-once.mal") 2 | (load-file-once "../tests/computations.mal") ; fib sumdown 3 | (load-file-once "../lib/perf.mal") ; time 4 | 5 | ;;(prn "Start: basic math/recursion test") 6 | 7 | (time (do 8 | (sumdown 10) 9 | (fib 12))) 10 | 11 | ;;(prn "Done: basic math/recursion test") 12 | -------------------------------------------------------------------------------- /shard.lock: -------------------------------------------------------------------------------- 1 | version: 2.0 2 | shards: 3 | arborist: 4 | git: https://github.com/davidkellis/arborist.git 5 | version: 0.5.0+git.commit.9a319d5a6f229d74dd5f2157a00f9a2f7714e5e3 6 | 7 | msgpack: 8 | git: https://github.com/crystal-community/msgpack-crystal.git 9 | version: 0.17.1 10 | 11 | readline: 12 | git: https://github.com/crystal-lang/crystal-readline.git 13 | version: 0.1.0 14 | 15 | -------------------------------------------------------------------------------- /step0_repl.cr: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env crystal run 2 | 3 | require "readline" 4 | 5 | # Note: 6 | # Employed downcase names because Crystal prohibits uppercase names for methods 7 | 8 | def read(x) 9 | x 10 | end 11 | 12 | def eval(x) 13 | x 14 | end 15 | 16 | def print(x) 17 | x 18 | end 19 | 20 | def rep(x) 21 | read(eval(print(x))) 22 | end 23 | 24 | while line = Readline.readline("user> ") 25 | puts rep(line) 26 | end 27 | -------------------------------------------------------------------------------- /shard.yml: -------------------------------------------------------------------------------- 1 | name: mal-crystal 2 | version: 0.1.0 3 | 4 | # authors: 5 | # - name 6 | 7 | # description: | 8 | # Short description of vscode-remote-development-template 9 | 10 | # license: MIT 11 | 12 | dependencies: 13 | readline: 14 | github: crystal-lang/crystal-readline 15 | arborist: 16 | github: davidkellis/arborist 17 | 18 | # development_dependencies: 19 | # webmock: 20 | # github: manastech/webmock.cr 21 | -------------------------------------------------------------------------------- /error.cr: -------------------------------------------------------------------------------- 1 | require "./types" 2 | 3 | module Mal 4 | class ParseException < Exception 5 | end 6 | 7 | class EvalException < Exception 8 | end 9 | 10 | class RuntimeException < Exception 11 | getter :thrown 12 | 13 | def initialize(@thrown : Type) 14 | super() 15 | end 16 | end 17 | end 18 | 19 | def eval_error(msg) 20 | raise Mal::EvalException.new msg 21 | end 22 | 23 | def parse_error(msg) 24 | raise Mal::ParseException.new msg 25 | end 26 | -------------------------------------------------------------------------------- /tests/step5_tco.mal: -------------------------------------------------------------------------------- 1 | ;; Testing recursive tail-call function 2 | 3 | (def! sum2 (fn* (n acc) (if (= n 0) acc (sum2 (- n 1) (+ n acc))))) 4 | 5 | ;; TODO: test let*, and do for TCO 6 | 7 | (sum2 10 0) 8 | ;=>55 9 | 10 | (def! res2 nil) 11 | ;=>nil 12 | (def! res2 (sum2 10000 0)) 13 | res2 14 | ;=>50005000 15 | 16 | 17 | ;; Test mutually recursive tail-call functions 18 | 19 | (def! foo (fn* (n) (if (= n 0) 0 (bar (- n 1))))) 20 | (def! bar (fn* (n) (if (= n 0) 0 (foo (- n 1))))) 21 | 22 | (foo 10000) 23 | ;=>0 24 | -------------------------------------------------------------------------------- /.vscode/launch.json: -------------------------------------------------------------------------------- 1 | { 2 | // Use IntelliSense to learn about possible attributes. 3 | // Hover to view descriptions of existing attributes. 4 | // For more information, visit: https://go.microsoft.com/fwlink/?linkid=830387 5 | "version": "0.1.0", 6 | "configurations": [ 7 | { 8 | "name": "Crystal: Current File", 9 | "type": "cr", 10 | "request": "launch", 11 | "program": "${file}", 12 | "console": "integratedTerminal" 13 | } 14 | ] 15 | } -------------------------------------------------------------------------------- /tests/perf1.mal: -------------------------------------------------------------------------------- 1 | (load-file "../lib/load-file-once.mal") 2 | (load-file-once "../lib/threading.mal") ; -> 3 | (load-file-once "../lib/perf.mal") ; time 4 | (load-file-once "../lib/test_cascade.mal") ; or 5 | 6 | ;;(prn "Start: basic macros performance test") 7 | 8 | (time (do 9 | (or false nil false nil false nil false nil false nil 4) 10 | (cond false 1 nil 2 false 3 nil 4 false 5 nil 6 "else" 7) 11 | (-> (list 1 2 3 4 5 6 7 8 9) rest rest rest rest rest rest first))) 12 | 13 | ;;(prn "Done: basic macros performance test") 14 | -------------------------------------------------------------------------------- /.devcontainer/devcontainer.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "crystal", 3 | "build": { 4 | "context": "..", 5 | "dockerfile": "Dockerfile", 6 | }, 7 | 8 | // Set custom container specific settings.json values on container create 9 | "settings": { 10 | "terminal.integrated.shell.linux": "/bin/zsh", 11 | "terminal.integrated.inheritEnv": false, 12 | }, 13 | 14 | // Add the IDs of extensions you want installed when the container is created 15 | "extensions": [ 16 | "crystal-lang-tools.crystal-lang", 17 | "veelenga.crystal-ameba", 18 | ], 19 | } 20 | -------------------------------------------------------------------------------- /tests/computations.mal: -------------------------------------------------------------------------------- 1 | ;; Some inefficient arithmetic computations for benchmarking. 2 | 3 | ;; Unfortunately not yet available in tests of steps 4 and 5. 4 | 5 | ;; Compute n(n+1)/2 with a non tail-recursive call. 6 | (def! sumdown 7 | (fn* [n] ; non-negative number 8 | (if (= n 0) 9 | 0 10 | (+ n (sumdown (- n 1)))))) 11 | 12 | ;; Compute a Fibonacci number with two recursions. 13 | (def! fib 14 | (fn* [n] ; non-negative number 15 | (if (<= n 1) 16 | n 17 | (+ (fib (- n 1)) (fib (- n 2)))))) 18 | -------------------------------------------------------------------------------- /grammars/lisp.g: -------------------------------------------------------------------------------- 1 | Lisp { 2 | form <- list 3 | / string 4 | / symbol 5 | list <- "(" form* ")" 6 | string <- "\"" char* "\"" 7 | char <- "\\\"" 8 | / "\\\\" 9 | / "\\" ("b" / "f" / "n" / "r" / "t") 10 | / "\\u" hex hex hex hex 11 | / (!"\"" .) 12 | hex <- digit | "a".."f" | "A".."F" 13 | number <- "0" 14 | / "-"? "1".."9" digit* ("." digit*)? 15 | / "-"? "0" ("." digit*)? 16 | digit <- "0".."9" 17 | special_char <- "(" / ")" 18 | / empty 19 | / "\"" 20 | symbol <- (!(special_char / digit / "-").) (!(special_char).)* 21 | } -------------------------------------------------------------------------------- /tests/perf3.mal: -------------------------------------------------------------------------------- 1 | (load-file "../lib/load-file-once.mal") 2 | (load-file-once "../lib/threading.mal") ; -> 3 | (load-file-once "../lib/perf.mal") ; run-fn-for 4 | (load-file-once "../lib/test_cascade.mal") ; or 5 | 6 | ;;(prn "Start: basic macros/atom test") 7 | 8 | (def! atm (atom (list 0 1 2 3 4 5 6 7 8 9))) 9 | 10 | (println "iters over 10 seconds:" 11 | (run-fn-for 12 | (fn* [] 13 | (do 14 | (or false nil false nil false nil false nil false nil (first @atm)) 15 | (cond false 1 nil 2 false 3 nil 4 false 5 nil 6 "else" (first @atm)) 16 | (-> (deref atm) rest rest rest rest rest rest first) 17 | (swap! atm (fn* [a] (concat (rest a) (list (first a))))))) 18 | 10)) 19 | 20 | ;;(prn "Done: basic macros/atom test") 21 | -------------------------------------------------------------------------------- /step1_read_print.cr: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env crystal run 2 | 3 | require "readline" 4 | require "./peg_reader_mal" 5 | require "./printer" 6 | 7 | # Note: 8 | # Employed downcase names because Crystal prohibits uppercase names for methods 9 | 10 | module Mal 11 | extend self 12 | 13 | def read(str) 14 | read_str str 15 | end 16 | 17 | def eval(x) 18 | x 19 | end 20 | 21 | def print(result) 22 | pr_str(result, true) 23 | end 24 | 25 | def rep(str) 26 | print(eval(read(str))) 27 | end 28 | end 29 | 30 | while line = Readline.readline("user> ", true) 31 | begin 32 | puts Mal.rep(line) 33 | rescue e : Mal::RuntimeException 34 | STDERR.puts "Error: #{pr_str(e.thrown, true)}" 35 | rescue e 36 | STDERR.puts "Error: #{e}" 37 | end 38 | end 39 | -------------------------------------------------------------------------------- /tests/step2_eval.mal: -------------------------------------------------------------------------------- 1 | ;; Testing evaluation of arithmetic operations 2 | (+ 1 2) 3 | ;=>3 4 | 5 | (+ 5 (* 2 3)) 6 | ;=>11 7 | 8 | (- (+ 5 (* 2 3)) 3) 9 | ;=>8 10 | 11 | (/ (- (+ 5 (* 2 3)) 3) 4) 12 | ;=>2 13 | 14 | (/ (- (+ 515 (* 87 311)) 302) 27) 15 | ;=>1010 16 | 17 | (* -3 6) 18 | ;=>-18 19 | 20 | (/ (- (+ 515 (* -87 311)) 296) 27) 21 | ;=>-994 22 | 23 | ;;; This should throw an error with no return value 24 | (abc 1 2 3) 25 | ;/.+ 26 | 27 | ;; Testing empty list 28 | () 29 | ;=>() 30 | 31 | ;>>> deferrable=True 32 | ;; 33 | ;; -------- Deferrable Functionality -------- 34 | 35 | ;; Testing evaluation within collection literals 36 | [1 2 (+ 1 2)] 37 | ;=>[1 2 3] 38 | 39 | {"a" (+ 7 8)} 40 | ;=>{"a" 15} 41 | 42 | {:a (+ 7 8)} 43 | ;=>{:a 15} 44 | 45 | ;; Check that evaluation hasn't broken empty collections 46 | [] 47 | ;=>[] 48 | {} 49 | ;=>{} 50 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | FROM ubuntu:18.04 2 | MAINTAINER Joel Martin 3 | 4 | ########################################################## 5 | # General requirements for testing or common across many 6 | # implementations 7 | ########################################################## 8 | 9 | RUN apt-get -y update 10 | 11 | # Required for running tests 12 | RUN apt-get -y install make python 13 | 14 | # Some typical implementation and test requirements 15 | RUN apt-get -y install curl libreadline-dev libedit-dev 16 | 17 | RUN mkdir -p /mal 18 | WORKDIR /mal 19 | 20 | ########################################################## 21 | # Specific implementation requirements 22 | ########################################################## 23 | 24 | # Install g++ for any C/C++ based implementations 25 | RUN apt-get -y install g++ 26 | 27 | # Crystal 28 | RUN apt-get -y install apt-transport-https gnupg 29 | RUN curl http://dist.crystal-lang.org/apt/setup.sh | bash 30 | RUN apt-get -y install crystal 31 | -------------------------------------------------------------------------------- /tests/run_argv_test.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # 4 | # Usage: run_argv_test.sh 5 | # 6 | # Example: run_argv_test.sh python step6_file.py 7 | # 8 | 9 | assert_equal() { 10 | if [ "$1" = "$2" ] ; then 11 | echo "OK: '$1'" 12 | else 13 | echo "FAIL: Expected '$1' but got '$2'" 14 | echo 15 | exit 1 16 | fi 17 | } 18 | 19 | if [ -z "$1" ] ; then 20 | echo "Usage: $0 " 21 | exit 1 22 | fi 23 | 24 | root="$(dirname $0)" 25 | 26 | out="$( $@ $root/print_argv.mal aaa bbb ccc | tr -d '\r' )" 27 | assert_equal '("aaa" "bbb" "ccc")' "$out" 28 | 29 | # Note: The 'make' implementation cannot handle arguments with spaces in them, 30 | # so for now we skip this test. 31 | # 32 | # out="$( $@ $root/print_argv.mal aaa 'bbb ccc' ddd )" 33 | # assert_equal '("aaa" "bbb ccc" "ddd")' "$out" 34 | 35 | out="$( $@ $root/print_argv.mal | tr -d '\r' )" 36 | assert_equal '()' "$out" 37 | 38 | echo 'Passed all *ARGV* tests' 39 | echo 40 | -------------------------------------------------------------------------------- /.devcontainer/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM crystallang/crystal 2 | 3 | # crystalline 4 | 5 | RUN \ 6 | apt-get update -y && \ 7 | apt-get install -y wget 8 | 9 | RUN \ 10 | wget https://github.com/elbywan/crystalline/releases/latest/download/crystalline_linux.gz -O crystalline.gz && \ 11 | gzip -d crystalline.gz && \ 12 | chmod u+x crystalline && \ 13 | cp crystalline /usr/bin 14 | 15 | # ameba 16 | 17 | RUN \ 18 | git clone https://github.com/crystal-ameba/ameba && \ 19 | cd ameba && \ 20 | make install 21 | 22 | # zsh 23 | 24 | RUN \ 25 | apt-get update -y && \ 26 | apt-get install -y zsh curl 27 | 28 | ENV SHELL /bin/zsh 29 | 30 | RUN sh -c "$(curl -fsSL https://raw.github.com/ohmyzsh/ohmyzsh/master/tools/install.sh)" 31 | 32 | RUN git clone https://github.com/veelenga/crystal-zsh.git ~/.oh-my-zsh/custom/plugins/crystal 33 | 34 | # readline 35 | 36 | RUN apt-get install libreadline-dev -y 37 | 38 | RUN \ 39 | git clone https://github.com/crystal-lang-tools/scry.git && \ 40 | cd scry && \ 41 | shards build --verbose --release 42 | 43 | RUN cp scry/bin/scry /usr/bin 44 | 45 | RUN apt-get install python -y -------------------------------------------------------------------------------- /tests/step0_repl.mal: -------------------------------------------------------------------------------- 1 | ;; Testing basic string 2 | abcABC123 3 | ;=>abcABC123 4 | 5 | ;; Testing string containing spaces 6 | hello mal world 7 | ;=>hello mal world 8 | 9 | ;; Testing string containing symbols 10 | []{}"'* ;:() 11 | ;=>[]{}"'* ;:() 12 | 13 | 14 | ;; Test long string 15 | hello world abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789 (;:() []{}"'* ;:() []{}"'* ;:() []{}"'*) 16 | ;=>hello world abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789 (;:() []{}"'* ;:() []{}"'* ;:() []{}"'*) 17 | 18 | ;; Non alphanumeric characters 19 | ! 20 | ;=>! 21 | & 22 | ;=>& 23 | + 24 | ;=>+ 25 | , 26 | ;=>, 27 | - 28 | ;=>- 29 | / 30 | ;=>/ 31 | < 32 | ;=>< 33 | = 34 | ;=>= 35 | > 36 | ;=>> 37 | ? 38 | ;=>? 39 | @ 40 | ;=>@ 41 | ;;; Behaviour of backslash is not specified enough to test anything in step0. 42 | ^ 43 | ;=>^ 44 | _ 45 | ;=>_ 46 | ` 47 | ;=>` 48 | ~ 49 | ;=>~ 50 | 51 | ;>>> soft=True 52 | ;>>> optional=True 53 | ;; ------- Optional Functionality -------------- 54 | ;; ------- (Not needed for self-hosting) ------- 55 | 56 | ;; Non alphanumeric characters 57 | # 58 | ;=># 59 | $ 60 | ;=>$ 61 | % 62 | ;=>% 63 | . 64 | ;=>. 65 | | 66 | ;=>| 67 | -------------------------------------------------------------------------------- /grammars/mal.g: -------------------------------------------------------------------------------- 1 | Mal { 2 | expression_or_comment <- 3 | (empty* expression empty* comment?) 4 | / (empty* comment?) 5 | expression <- list 6 | / vector 7 | / hash_map 8 | / string 9 | / number 10 | / quote 11 | / keyword 12 | / symbol 13 | list <- "(" expression_or_comment* ")" 14 | vector <- "[" expression_or_comment* "]" 15 | hash_map <- "{" empty* pair* "}" 16 | pair <- 17 | (string / keyword) empty* expression empty* comment? 18 | string <- "\"" char* "\"" 19 | char <- "\\\"" 20 | / "\\\\" 21 | / "\\" ("b" / "f" / "n" / "r" / "t") 22 | / "\\u" hex hex hex hex 23 | / (!"\"" .) 24 | hex <- digit | "a".."f" | "A".."F" 25 | number <- "0" 26 | / "-"? "1".."9" digit* ("." digit*)? 27 | / "-"? "0" ("." digit*)? 28 | digit <- "0".."9" 29 | empty <- "\n" / "\r" / "\t" / " " / "," 30 | special_char <- "(" / ")" 31 | / "[" / "]" 32 | / "{" / "}" 33 | / quote_symbol 34 | / empty 35 | / "\"" 36 | / ";" 37 | / ":" 38 | symbol <- 39 | (!(special_char / digit).) (!(special_char).)* 40 | keyword <- ":" symbol 41 | quote_symbol <- "'" / "`" / "~@" / "~" / "@" 42 | quote <- quote_symbol empty* expression 43 | comment <- ";" (!("\n").)* "\n"? 44 | } 45 | -------------------------------------------------------------------------------- /printer.cr: -------------------------------------------------------------------------------- 1 | require "./types" 2 | 3 | def pr_str(value, print_readably = true) 4 | case value 5 | when Nil then "nil" 6 | when Bool then value.to_s 7 | when Int64 then value.to_s 8 | when Float64 then value.to_s 9 | when Mal::List then "(#{value.map { |v| pr_str(v, print_readably).as(String) }.join(" ")})" 10 | when Mal::Vector then "[#{value.map { |v| pr_str(v, print_readably).as(String) }.join(" ")}]" 11 | when Mal::Symbol then value.str.to_s 12 | when Mal::Func then "" 13 | when Mal::Closure then "" 14 | when Mal::HashMap 15 | # step1_read_print.cr requires specifying type 16 | "{#{value.map { |k, v| "#{pr_str(k, print_readably)} #{pr_str(v, print_readably)}".as(String) }.join(" ")}}" 17 | when String 18 | case 19 | when value.empty? 20 | print_readably ? value.inspect : value 21 | when value[0] == '\u029e' 22 | ":#{value[1..-1]}" 23 | else 24 | print_readably ? value.inspect : value 25 | end 26 | when Mal::Atom 27 | "(atom #{pr_str(value.val, print_readably)})" 28 | else 29 | raise "invalid MalType: #{value.to_s}" 30 | end 31 | end 32 | 33 | def pr_str(t : Mal::Type, print_readably = true) 34 | pr_str(t.unwrap, print_readably) + (t.macro? ? " (macro)" : "") 35 | end 36 | -------------------------------------------------------------------------------- /tests/step3_env.mal: -------------------------------------------------------------------------------- 1 | ;; Testing REPL_ENV 2 | (+ 1 2) 3 | ;=>3 4 | (/ (- (+ 5 (* 2 3)) 3) 4) 5 | ;=>2 6 | 7 | 8 | ;; Testing def! 9 | (def! x 3) 10 | ;=>3 11 | x 12 | ;=>3 13 | (def! x 4) 14 | ;=>4 15 | x 16 | ;=>4 17 | (def! y (+ 1 7)) 18 | ;=>8 19 | y 20 | ;=>8 21 | 22 | ;; Verifying symbols are case-sensitive 23 | (def! mynum 111) 24 | ;=>111 25 | (def! MYNUM 222) 26 | ;=>222 27 | mynum 28 | ;=>111 29 | MYNUM 30 | ;=>222 31 | 32 | ;; Check env lookup non-fatal error 33 | (abc 1 2 3) 34 | ;/.*\'?abc\'? not found.* 35 | ;; Check that error aborts def! 36 | (def! w 123) 37 | (def! w (abc)) 38 | w 39 | ;=>123 40 | 41 | ;; Testing let* 42 | (let* (z 9) z) 43 | ;=>9 44 | (let* (x 9) x) 45 | ;=>9 46 | x 47 | ;=>4 48 | (let* (z (+ 2 3)) (+ 1 z)) 49 | ;=>6 50 | (let* (p (+ 2 3) q (+ 2 p)) (+ p q)) 51 | ;=>12 52 | (def! y (let* (z 7) z)) 53 | y 54 | ;=>7 55 | 56 | ;; Testing outer environment 57 | (def! a 4) 58 | ;=>4 59 | (let* (q 9) q) 60 | ;=>9 61 | (let* (q 9) a) 62 | ;=>4 63 | (let* (z 2) (let* (q 9) a)) 64 | ;=>4 65 | 66 | ;>>> deferrable=True 67 | ;; 68 | ;; -------- Deferrable Functionality -------- 69 | 70 | ;; Testing let* with vector bindings 71 | (let* [z 9] z) 72 | ;=>9 73 | (let* [p (+ 2 3) q (+ 2 p)] (+ p q)) 74 | ;=>12 75 | 76 | ;; Testing vector evaluation 77 | (let* (a 5 b 6) [3 4 a [b 7] 8]) 78 | ;=>[3 4 5 [6 7] 8] 79 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | STEPS = step0_repl.cr step1_read_print.cr step2_eval.cr step3_env.cr \ 2 | step4_if_fn_do.cr step5_tco.cr step6_file.cr step7_quote.cr \ 3 | step8_macros.cr step9_try.cr stepA_mal.cr 4 | 5 | STEP1_DEPS = $(STEP0_DEPS) reader.cr printer.cr 6 | STEP2_DEPS = $(STEP1_DEPS) types.cr 7 | STEP3_DEPS = $(STEP2_DEPS) env.cr 8 | STEP4_DEPS = $(STEP3_DEPS) core.cr error.cr 9 | 10 | STEP_BINS = $(STEPS:%.cr=%) 11 | LAST_STEP_BIN = $(word $(words $(STEP_BINS)),$(STEP_BINS)) 12 | 13 | all: $(STEP_BINS) 14 | 15 | dist: mal 16 | 17 | mal: $(LAST_STEP_BIN) 18 | cp $< $@ 19 | 20 | $(STEP_BINS): %: %.cr 21 | crystal build --release --error-trace $< 22 | 23 | step0_repl: $(STEP0_DEPS) 24 | step1_read_print: $(STEP1_DEPS) 25 | step2_eval: $(STEP2_DEPS) 26 | step3_env: $(STEP3_DEPS) 27 | step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal: $(STEP4_DEPS) 28 | 29 | test-mal: 30 | python runtest.py tests/step0_repl.mal ./step0_repl 31 | # python runtest.py tests/step1_read_print.mal ./step1_read_print 32 | python runtest.py tests/step2_eval.mal ./step2_eval 33 | python runtest.py tests/step3_env.mal ./step3_env 34 | python runtest.py tests/step4_if_fn_do.mal ./step4_if_fn_do 35 | python runtest.py tests/step5_tco.mal ./step5_tco 36 | python runtest.py tests/step6_file.mal ./step6_file 37 | python runtest.py tests/step7_quote.mal ./step7_quote 38 | python runtest.py tests/step8_macros.mal ./step8_macros 39 | python runtest.py tests/step9_try.mal ./step9_try 40 | python runtest.py tests/stepA_mal.mal ./stepA_mal 41 | 42 | clean: 43 | rm -rf $(STEP_BINS) mal .crystal 44 | 45 | .PHONY: clean all test-mal default 46 | 47 | default: clean all test-mal 48 | 49 | .DEFAULT_GOAL := default 50 | -------------------------------------------------------------------------------- /env.cr: -------------------------------------------------------------------------------- 1 | require "./types" 2 | require "./error" 3 | 4 | module Mal 5 | class Env 6 | property data 7 | 8 | def initialize(@outer : Env?) 9 | @data = {} of String => Mal::Type 10 | end 11 | 12 | def initialize(@outer : Env, binds, exprs : Array(Mal::Type)) 13 | @data = {} of String => Mal::Type 14 | 15 | eval_error "binds must be list or vector" unless binds.is_a? Array 16 | 17 | # Note: 18 | # Array#zip() can't be used because overload resolution failed 19 | (0...binds.size).each do |idx| 20 | sym = binds[idx].unwrap 21 | eval_error "bind name must be symbol" unless sym.is_a? Mal::Symbol 22 | 23 | if sym.str == "&" 24 | eval_error "missing variable parameter name" if binds.size == idx 25 | next_param = binds[idx + 1].unwrap 26 | eval_error "bind name must be symbol" unless next_param.is_a? Mal::Symbol 27 | var_args = Mal::List.new 28 | exprs[idx..-1].each { |e| var_args << e } if idx < exprs.size 29 | @data[next_param.str] = Mal::Type.new var_args 30 | break 31 | end 32 | 33 | @data[sym.str] = exprs[idx] 34 | end 35 | end 36 | 37 | def dump 38 | puts "ENV BEGIN".colorize.red 39 | @data.each do |k, v| 40 | puts " #{k} -> #{print(v)}".colorize.red 41 | end 42 | puts "ENV END".colorize.red 43 | end 44 | 45 | def set(key, value) 46 | @data[key] = value 47 | end 48 | 49 | def find(key) 50 | return self if @data.has_key? key 51 | 52 | o = @outer 53 | if o 54 | o.find key 55 | else 56 | nil 57 | end 58 | end 59 | 60 | def get(key) 61 | e = find key 62 | eval_error "'#{key}' not found" unless e 63 | e.data[key] 64 | end 65 | end 66 | end 67 | -------------------------------------------------------------------------------- /tests/travis_trigger.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Reference: https://docs.travis-ci.com/user/triggering-builds/ 4 | 5 | set -e 6 | 7 | die() { echo "${*}"; exit 1; } 8 | usage() { 9 | [ "${*}" ] && echo >&2 -e "${*}\n" 10 | echo "Usage: $0 REPO BRANCH [VAR=VAL]... 11 | 12 | Authorization: 13 | 14 | If you have the travis program installed then it will be called 15 | to get an API token (you need to have done 'travis login --org' 16 | in the past). Alternately you can explicity pass a token using 17 | the TRAVIS_TOKEN environment variable. You can see your API 18 | token at https://travis-ci.org/account/preferences. 19 | 20 | Travis .org vs .com: 21 | 22 | By default 'api.travis-ci.org' is used for API calls. This can 23 | be overridden by setting TRAVIS_HOST="api.travis-ci.com" 24 | 25 | Examples: 26 | 27 | Trigger build/test in self-hosted mode: 28 | $0 REPO BRANCH DO_SELF_HOST=1 29 | 30 | Trigger build/test with stop on soft failures: 31 | $0 REPO BRANCH DO_HARD=1 32 | 33 | Trigger build/test using regress mode on stepA: 34 | $0 REPO BRANCH REGRESS=1 STEP=stepA 35 | 36 | Trigger build/test using regress mode on all steps: 37 | $0 REPO BRANCH REGRESS=1 38 | " | sed 's/^ //' >&2 39 | 40 | exit 2 41 | } 42 | 43 | TRAVIS_TOKEN="${TRAVIS_TOKEN:-}" # default to travis program 44 | TRAVIS_HOST="${TRAVIS_HOST:-api.travis-ci.org}" 45 | 46 | REPO="${1}"; shift || usage "REPO required" 47 | BRANCH="${1}"; shift || usage "BRANCH required" 48 | VARS="${*}" 49 | 50 | repo="${REPO/\//%2F}" 51 | vars="" 52 | [ "${VARS}" ] && vars="\"${VARS// /\", \"}\"" 53 | 54 | body="{ 55 | \"request\": { 56 | \"message\": \"Manual build. Settings: ${VARS}\", 57 | \"branch\":\"${BRANCH}\", 58 | \"config\": { 59 | \"env\": { 60 | \"global\": [${vars}] 61 | } 62 | } 63 | } 64 | }" 65 | 66 | if [ -z "${TRAVIS_TOKEN}" ]; then 67 | which travis >/dev/null \ 68 | || die "TRAVIS_TOKEN not set and travis command not found" 69 | TRAVIS_TOKEN="$(travis token --org --no-interactive)" 70 | fi 71 | 72 | curl -X POST \ 73 | -H "Content-Type: application/json" \ 74 | -H "Accept: application/json" \ 75 | -H "Travis-API-Version: 3" \ 76 | -H "Authorization: token ${TRAVIS_TOKEN}" \ 77 | -d "$body" \ 78 | "https://${TRAVIS_HOST}/repo/${repo}/requests" 79 | -------------------------------------------------------------------------------- /types.cr: -------------------------------------------------------------------------------- 1 | require "./printer" 2 | 3 | module Mal 4 | class Type 5 | alias Func = (Array(Type) -> Type) 6 | 7 | property :is_macro, :meta 8 | 9 | def initialize(@val : ValueType) 10 | @is_macro = false 11 | @meta = nil.as(Type | Nil) 12 | end 13 | 14 | def initialize(other : Type) 15 | @val = other.unwrap 16 | @is_macro = other.is_macro 17 | @meta = other.meta 18 | end 19 | 20 | def unwrap 21 | @val 22 | end 23 | 24 | def macro? 25 | @is_macro 26 | end 27 | 28 | def to_s 29 | pr_str(self) 30 | end 31 | 32 | def dup 33 | Type.new(@val).tap do |t| 34 | t.is_macro = @is_macro 35 | t.meta = @meta 36 | end 37 | end 38 | 39 | def ==(other : Type) 40 | @val == other.unwrap 41 | end 42 | 43 | macro rel_op(*ops) 44 | {% for op in ops %} 45 | def {{op.id}}(other : Mal::Type) 46 | l, r = @val, other.unwrap 47 | {% for t in [Int64, Float64, String] %} 48 | if l.is_a?({{t}}) && r.is_a?({{t}}) 49 | return (l) {{op.id}} (r) 50 | end 51 | {% end %} 52 | if l.is_a?(Symbol) && r.is_a?(Symbol) 53 | return l.str {{op.id}} r.str 54 | end 55 | false 56 | end 57 | {% end %} 58 | end 59 | 60 | rel_op :<, :>, :<=, :>= 61 | end 62 | 63 | class Symbol 64 | property :str 65 | 66 | def initialize(@str : String) 67 | end 68 | 69 | def ==(other : Symbol) 70 | @str == other.str 71 | end 72 | end 73 | 74 | class List < Array(Type) 75 | end 76 | 77 | class Vector < Array(Type) 78 | end 79 | 80 | class HashMap < Hash(String, Type) 81 | end 82 | 83 | class Atom 84 | property :val 85 | 86 | def initialize(@val : Type) 87 | end 88 | 89 | def ==(rhs : Atom) 90 | @val == rhs.val 91 | end 92 | end 93 | 94 | class Closure 95 | property :ast, :params, :env, :fn 96 | 97 | def initialize(@ast : Type, @params : Array(Mal::Type) | List | Vector, @env : Env, @fn : Func) 98 | end 99 | end 100 | 101 | alias Type::ValueType = Nil | Bool | Float64 | Int64 | String | Symbol | List | Vector | HashMap | Func | Closure | Atom 102 | alias Func = Type::Func 103 | end 104 | 105 | macro gen_type(t, *args) 106 | Mal::Type.new {{t.id}}.new({{*args}}) 107 | end 108 | 109 | class Array 110 | def to_mal(t = Mal::List) 111 | each_with_object(t.new) { |e, l| l << e } 112 | end 113 | end 114 | -------------------------------------------------------------------------------- /step2_eval.cr: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env crystal run 2 | 3 | require "readline" 4 | require "./peg_reader_mal" 5 | require "./printer" 6 | require "./types" 7 | 8 | # Note: 9 | # Employed downcase names because Crystal prohibits uppercase names for methods 10 | 11 | module Mal 12 | extend self 13 | 14 | def eval_error(msg) 15 | raise Mal::EvalException.new msg 16 | end 17 | 18 | def num_func(func) 19 | ->(args : Array(Mal::Type)) { 20 | x, y = args[0].unwrap, args[1].unwrap 21 | eval_error "invalid arguments" unless x.is_a?(Int64) && y.is_a?(Int64) 22 | Mal::Type.new func.call(x, y) 23 | } 24 | end 25 | 26 | def eval_ast(a, env) 27 | return a.map { |n| eval(n, env).as(Mal::Type) } if a.is_a? Mal::List 28 | return a unless a 29 | 30 | ast = a.unwrap 31 | case ast 32 | when Mal::Symbol 33 | if env.has_key? ast.str 34 | env[ast.str] 35 | else 36 | eval_error "'#{ast.str}' not found" 37 | end 38 | when Mal::List 39 | ast.each_with_object(Mal::List.new) { |n, l| l << eval(n, env) } 40 | when Mal::Vector 41 | ast.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } 42 | when Mal::HashMap 43 | ast.each { |k, v| ast[k] = eval(v, env) } 44 | ast 45 | else 46 | ast 47 | end 48 | end 49 | 50 | def read(str) 51 | read_str str 52 | end 53 | 54 | def eval(t, env) 55 | Mal::Type.new case ast = t.unwrap 56 | when Mal::List 57 | return gen_type Mal::List if ast.empty? 58 | 59 | f = eval_ast(ast.first, env) 60 | ast.shift(1) 61 | args = eval_ast(ast, env) 62 | 63 | if f.is_a?(Mal::Func) 64 | f.call(args) 65 | else 66 | eval_error "expected function symbol as the first symbol of list" 67 | end 68 | else 69 | eval_ast(t, env) 70 | end 71 | end 72 | 73 | def print(result) 74 | pr_str(result, true) 75 | end 76 | 77 | def rep(str) 78 | print(eval(read(str), REPL_ENV)) 79 | end 80 | end 81 | 82 | REPL_ENV = { 83 | "+" => Mal.num_func(->(x : (Float64 | Int64), y : (Float64 | Int64)) { x + y }), 84 | "-" => Mal.num_func(->(x : (Float64 | Int64), y : (Float64 | Int64)) { x - y }), 85 | "*" => Mal.num_func(->(x : (Float64 | Int64), y : (Float64 | Int64)) { x * y }), 86 | "/" => Mal.num_func(->(x : (Float64 | Int64), y : (Float64 | Int64)) { x / y }), 87 | } of String => Mal::Func 88 | 89 | while line = Readline.readline("user> ", true) 90 | begin 91 | puts Mal.rep(line) 92 | rescue e : Mal::RuntimeException 93 | STDERR.puts "Error: #{pr_str(e.thrown, true)}" 94 | rescue e 95 | STDERR.puts "Error: #{e}" 96 | end 97 | end 98 | -------------------------------------------------------------------------------- /tests/step8_macros.mal: -------------------------------------------------------------------------------- 1 | ;; Testing trivial macros 2 | (defmacro! one (fn* () 1)) 3 | (one) 4 | ;=>1 5 | (defmacro! two (fn* () 2)) 6 | (two) 7 | ;=>2 8 | 9 | ;; Testing unless macros 10 | (defmacro! unless (fn* (pred a b) `(if ~pred ~b ~a))) 11 | (unless false 7 8) 12 | ;=>7 13 | (unless true 7 8) 14 | ;=>8 15 | (defmacro! unless2 (fn* (pred a b) (list 'if (list 'not pred) a b))) 16 | (unless2 false 7 8) 17 | ;=>7 18 | (unless2 true 7 8) 19 | ;=>8 20 | 21 | ;; Testing macroexpand 22 | (macroexpand (one)) 23 | ;=>1 24 | (macroexpand (unless PRED A B)) 25 | ;=>(if PRED B A) 26 | (macroexpand (unless2 PRED A B)) 27 | ;=>(if (not PRED) A B) 28 | (macroexpand (unless2 2 3 4)) 29 | ;=>(if (not 2) 3 4) 30 | 31 | ;; Testing evaluation of macro result 32 | (defmacro! identity (fn* (x) x)) 33 | (let* (a 123) (macroexpand (identity a))) 34 | ;=>a 35 | (let* (a 123) (identity a)) 36 | ;=>123 37 | 38 | ;; Test that macros do not break empty list 39 | () 40 | ;=>() 41 | 42 | ;; Test that macros do not break quasiquote 43 | `(1) 44 | ;=>(1) 45 | 46 | ;>>> deferrable=True 47 | ;; 48 | ;; -------- Deferrable Functionality -------- 49 | 50 | ;; Testing non-macro function 51 | (not (= 1 1)) 52 | ;=>false 53 | ;;; This should fail if it is a macro 54 | (not (= 1 2)) 55 | ;=>true 56 | 57 | ;; Testing nth, first and rest functions 58 | 59 | (nth (list 1) 0) 60 | ;=>1 61 | (nth (list 1 2) 1) 62 | ;=>2 63 | (nth (list 1 2 nil) 2) 64 | ;=>nil 65 | (def! x "x") 66 | (def! x (nth (list 1 2) 2)) 67 | x 68 | ;=>"x" 69 | 70 | (first (list)) 71 | ;=>nil 72 | (first (list 6)) 73 | ;=>6 74 | (first (list 7 8 9)) 75 | ;=>7 76 | 77 | (rest (list)) 78 | ;=>() 79 | (rest (list 6)) 80 | ;=>() 81 | (rest (list 7 8 9)) 82 | ;=>(8 9) 83 | 84 | 85 | ;; Testing cond macro 86 | 87 | (macroexpand (cond)) 88 | ;=>nil 89 | (cond) 90 | ;=>nil 91 | (macroexpand (cond X Y)) 92 | ;=>(if X Y (cond)) 93 | (cond true 7) 94 | ;=>7 95 | (cond false 7) 96 | ;=>nil 97 | (macroexpand (cond X Y Z T)) 98 | ;=>(if X Y (cond Z T)) 99 | (cond true 7 true 8) 100 | ;=>7 101 | (cond false 7 true 8) 102 | ;=>8 103 | (cond false 7 false 8 "else" 9) 104 | ;=>9 105 | (cond false 7 (= 2 2) 8 "else" 9) 106 | ;=>8 107 | (cond false 7 false 8 false 9) 108 | ;=>nil 109 | 110 | ;; Testing EVAL in let* 111 | 112 | (let* (x (cond false "no" true "yes")) x) 113 | ;=>"yes" 114 | 115 | 116 | ;; Testing nth, first, rest with vectors 117 | 118 | (nth [1] 0) 119 | ;=>1 120 | (nth [1 2] 1) 121 | ;=>2 122 | (nth [1 2 nil] 2) 123 | ;=>nil 124 | (def! x "x") 125 | (def! x (nth [1 2] 2)) 126 | x 127 | ;=>"x" 128 | 129 | (first []) 130 | ;=>nil 131 | (first nil) 132 | ;=>nil 133 | (first [10]) 134 | ;=>10 135 | (first [10 11 12]) 136 | ;=>10 137 | (rest []) 138 | ;=>() 139 | (rest nil) 140 | ;=>() 141 | (rest [10]) 142 | ;=>() 143 | (rest [10 11 12]) 144 | ;=>(11 12) 145 | (rest (cons 10 [11 12])) 146 | ;=>(11 12) 147 | 148 | ;; Testing EVAL in vector let* 149 | 150 | (let* [x (cond false "no" true "yes")] x) 151 | ;=>"yes" 152 | 153 | ;>>> soft=True 154 | ;>>> optional=True 155 | ;; 156 | ;; ------- Optional Functionality -------------- 157 | ;; ------- (Not needed for self-hosting) ------- 158 | 159 | ;; Test that macros use closures 160 | (def! x 2) 161 | (defmacro! a (fn* [] x)) 162 | (a) 163 | ;=>2 164 | (let* (x 3) (a)) 165 | ;=>2 166 | -------------------------------------------------------------------------------- /tests/step6_file.mal: -------------------------------------------------------------------------------- 1 | ;;; TODO: really a step5 test 2 | ;; 3 | ;; Testing that (do (do)) not broken by TCO 4 | (do (do 1 2)) 5 | ;=>2 6 | 7 | ;; 8 | ;; Testing read-string, eval and slurp 9 | (read-string "(1 2 (3 4) nil)") 10 | ;=>(1 2 (3 4) nil) 11 | 12 | (= nil (read-string "nil")) 13 | ;=>true 14 | 15 | (read-string "(+ 2 3)") 16 | ;=>(+ 2 3) 17 | 18 | (read-string "\"\n\"") 19 | ;=>"\n" 20 | 21 | (read-string "7 ;; comment") 22 | ;=>7 23 | 24 | ;;; Differing output, but make sure no fatal error 25 | (read-string ";; comment") 26 | 27 | 28 | (eval (read-string "(+ 2 3)")) 29 | ;=>5 30 | 31 | (slurp "./tests/test.txt") 32 | ;=>"A line of text\n" 33 | 34 | ;;; Load the same file twice. 35 | (slurp "./tests/test.txt") 36 | ;=>"A line of text\n" 37 | 38 | ;; Testing load-file 39 | 40 | (load-file "./tests/inc.mal") 41 | ;=>nil 42 | (inc1 7) 43 | ;=>8 44 | (inc2 7) 45 | ;=>9 46 | (inc3 9) 47 | ;=>12 48 | 49 | ;; 50 | ;; Testing atoms 51 | 52 | (def! inc3 (fn* (a) (+ 3 a))) 53 | 54 | (def! a (atom 2)) 55 | ;=>(atom 2) 56 | 57 | (atom? a) 58 | ;=>true 59 | 60 | (atom? 1) 61 | ;=>false 62 | 63 | (deref a) 64 | ;=>2 65 | 66 | (reset! a 3) 67 | ;=>3 68 | 69 | (deref a) 70 | ;=>3 71 | 72 | (swap! a inc3) 73 | ;=>6 74 | 75 | (deref a) 76 | ;=>6 77 | 78 | (swap! a (fn* (a) a)) 79 | ;=>6 80 | 81 | (swap! a (fn* (a) (* 2 a))) 82 | ;=>12 83 | 84 | (swap! a (fn* (a b) (* a b)) 10) 85 | ;=>120 86 | 87 | (swap! a + 3) 88 | ;=>123 89 | 90 | ;; Testing swap!/closure interaction 91 | (def! inc-it (fn* (a) (+ 1 a))) 92 | (def! atm (atom 7)) 93 | (def! f (fn* () (swap! atm inc-it))) 94 | (f) 95 | ;=>8 96 | (f) 97 | ;=>9 98 | 99 | ;; Testing whether closures can retain atoms 100 | (def! g (let* (atm (atom 0)) (fn* () (deref atm)))) 101 | (def! atm (atom 1)) 102 | (g) 103 | ;=>0 104 | 105 | ;>>> deferrable=True 106 | ;; 107 | ;; -------- Deferrable Functionality -------- 108 | 109 | ;; Testing reading of large files 110 | (load-file "./tests/computations.mal") 111 | ;=>nil 112 | (sumdown 2) 113 | ;=>3 114 | (fib 2) 115 | ;=>1 116 | 117 | ;; Testing `@` reader macro (short for `deref`) 118 | (def! atm (atom 9)) 119 | @atm 120 | ;=>9 121 | 122 | ;;; TODO: really a step5 test 123 | ;; Testing that vector params not broken by TCO 124 | (def! g (fn* [] 78)) 125 | (g) 126 | ;=>78 127 | (def! g (fn* [a] (+ a 78))) 128 | (g 3) 129 | ;=>81 130 | 131 | ;; 132 | ;; Testing that *ARGV* exists and is an empty list 133 | (list? *ARGV*) 134 | ;=>true 135 | *ARGV* 136 | ;=>() 137 | 138 | ;; 139 | ;; Testing that eval sets aa in root scope, and that it is found in nested scope 140 | (let* (b 12) (do (eval (read-string "(def! aa 7)")) aa )) 141 | ;=>7 142 | 143 | ;>>> soft=True 144 | ;>>> optional=True 145 | ;; 146 | ;; -------- Optional Functionality -------- 147 | 148 | ;; Testing comments in a file 149 | (load-file "./tests/incB.mal") 150 | ;=>nil 151 | (inc4 7) 152 | ;=>11 153 | (inc5 7) 154 | ;=>12 155 | 156 | ;; Testing map literal across multiple lines in a file 157 | (load-file "./tests/incC.mal") 158 | ;=>nil 159 | mymap 160 | ;=>{"a" 1} 161 | 162 | ;; Checking that eval does not use local environments. 163 | (def! a 1) 164 | ;=>1 165 | (let* (a 2) (eval (read-string "a"))) 166 | ;=>1 167 | 168 | ;; Non alphanumeric characters in comments in read-string 169 | (read-string "1;!") 170 | ;=>1 171 | (read-string "1;\"") 172 | ;=>1 173 | (read-string "1;#") 174 | ;=>1 175 | (read-string "1;$") 176 | ;=>1 177 | (read-string "1;%") 178 | ;=>1 179 | (read-string "1;'") 180 | ;=>1 181 | (read-string "1;\\") 182 | ;=>1 183 | (read-string "1;\\\\") 184 | ;=>1 185 | (read-string "1;\\\\\\") 186 | ;=>1 187 | (read-string "1;`") 188 | ;=>1 189 | ;;; Hopefully less problematic characters can be checked together 190 | (read-string "1; &()*+,-./:;<=>?@[]^_{|}~") 191 | ;=>1 192 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # MAL in Crystal 2 | 3 | Forked from https://github.com/kanaka/mal/tree/master/impls/crystal 4 | 5 | ## Why Crystal? 6 | 7 | My previous experiment was to build MAL in Pony. Pony is a nice language, but its type system is a bit "rigid", which slows down me. I want to experiment and iterate fast. 8 | 9 | I want a compiled fast language, but not C. My options are: 10 | 11 | - Go - I don't want to deal with the absence of generics 12 | - Rust - I don't want to deal with the borrow checker 13 | - Chez Scheme or sbcl or clasp - may be, but there is no static type checker? 14 | - Zig 15 | - Crystal 16 | 17 | I decided to go with Crystal because it is a bit more flexible than Zig. Also, I heard that they want to rewrite the Ponylang compiler from C to Crystal, so I was curious. 18 | 19 | ## Ideas 20 | 21 | Ideas I want to explore: 22 | 23 | 1. Write reader with new Pytonish syntax, which would compile input to the SExpressions, that MAL's `eval` expect 24 | 2. ... 25 | 26 | ## About Lisp syntax 27 | 28 | There were a million attempts to create an alternative to SExpressions. See: 29 | 30 | - [History of alternative syntaxes for Lisp](https://github.com/shaunlebron/history-of-lisp-parens/blob/master/alt-syntax.md) 31 | - [Readable Lisp S-expressions Project](https://readable.sourceforge.io/) 32 | - [LISP Infix Syntax Survey](http://xahlee.info/comp/lisp_sans_sexp.html) 33 | - [wisp: Whitespace to Lisp](https://www.draketo.de/english/wisp) 34 | - [Curly infix, Modern-expressions, and Sweet-expressions: A suite of readable formats for Lisp-like languages](https://dwheeler.com/readable/sweet-expressions.html) 35 | - [nonelang](https://nonelang.readthedocs.io/en/latest/dataformat.html) 36 | - [LSIP: An operator-based syntax for Racket programs; O-expressions](http://breuleux.net/blog/liso.html) 37 | - [rhombus-brainstorming](https://github.com/racket/rhombus-brainstorming/issues/3) 38 | 39 | ## Parsers 40 | 41 | ### Crystal libs 42 | 43 | - http://crystalshards.xyz/?filter=parser 44 | - [arborist](https://github.com/davidkellis/arborist) 45 | - [ohm](https://github.com/harc/ohm/blob/master/doc/syntax-reference.md) 46 | - [pars3k](https://github.com/voximity/pars3k) 47 | - [crystal-pegmatite](https://github.com/jemc/crystal-pegmatite) - no documentation 48 | - [pegasus](https://github.com/pawandubey/pegasus) - regexp 49 | 50 | ### Lisp, Sheme, Clojure BNF/EBNF 51 | 52 | - [Clojure.g4](https://github.com/antlr/grammars-v4/blob/master/clojure/Clojure.g4) 53 | - [Clojure.g](https://github.com/ccw-ide/ccw/blob/3738a4fd768bcb0399630b7f6a6427a3066bdaa9/clojure-antlr-grammar/src/Clojure.g) 54 | - [r5rs](https://people.csail.mit.edu/jaffer/r5rs_9.html) 55 | - [Formal Syntax of Scheme](https://www.scheme.com/tspl2d/grammar.html) 56 | 57 | ### Grammars 58 | 59 | - [The Packrat Parsing and Parsing Expression Grammars Page](https://bford.info/packrat/) 60 | - [Language Grammar](https://enqueuezero.com/language-grammar.html) 61 | - [Confluent Orthogonal Drawingfor Syntax Diagrams](http://www.csun.edu/gd2015/slides/Sept25-15-25-Michael_Bannister.pdf) 62 | - [Guy Steele on Computer Science Metanotation](https://www.youtube.com/watch?v=dCuZkaaou0Q) 63 | 64 | ## Brainstorming 65 | 66 | - operator precedence rules is hard to remeber. Pony doesn't have it 67 | - [punctuation-signs as operators are hard to search](https://www.joshwcomeau.com/operator-lookup/) 68 | - I don't think that prefix notation is a problem, almost all functions except math operators and special operators like in [Haskell](https://imada.sdu.dk/~rolf/Edu/DM22/F06/haskell-operatorer.pdf) use it. See: [operators](https://www.fpcomplete.com/haskell/tutorial/operators/) 69 | - In Scheme it is possible to use `[]` and `{}` in addition to `()`, which makes it more readable 70 | - In Clojure `[]` denotes a vector (doesn't evaluate like application), `{}` denotes a hashmap, `:...` denotes a keyword (doesn't evaluate like a variable, more like Ruby's symbol) 71 | -------------------------------------------------------------------------------- /step3_env.cr: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env crystal run 2 | 3 | require "readline" 4 | require "./peg_reader_mal" 5 | require "./printer" 6 | require "./types" 7 | require "./env" 8 | 9 | # Note: 10 | # Employed downcase names because Crystal prohibits uppercase names for methods 11 | 12 | def eval_error(msg) 13 | raise Mal::EvalException.new msg 14 | end 15 | 16 | def num_func(func) 17 | ->(args : Array(Mal::Type)) { 18 | x, y = args[0].unwrap, args[1].unwrap 19 | eval_error "invalid arguments" unless x.is_a?(Int64) && y.is_a?(Int64) 20 | Mal::Type.new func.call(x, y) 21 | } 22 | end 23 | 24 | REPL_ENV = Mal::Env.new nil 25 | REPL_ENV.set("+", Mal::Type.new num_func(->(x : (Float64 | Int64), y : (Float64 | Int64)) { x + y })) 26 | REPL_ENV.set("-", Mal::Type.new num_func(->(x : (Float64 | Int64), y : (Float64 | Int64)) { x - y })) 27 | REPL_ENV.set("*", Mal::Type.new num_func(->(x : (Float64 | Int64), y : (Float64 | Int64)) { x * y })) 28 | REPL_ENV.set("/", Mal::Type.new num_func(->(x : (Float64 | Int64), y : (Float64 | Int64)) { x / y })) 29 | 30 | module Mal 31 | extend self 32 | 33 | def eval_ast(a, env) 34 | return a.map { |n| eval(n, env) } if a.is_a? Array 35 | 36 | Mal::Type.new case ast = a.unwrap 37 | when Mal::Symbol 38 | if e = env.get(ast.str) 39 | e 40 | else 41 | eval_error "'#{ast.str}' not found" 42 | end 43 | when Mal::List 44 | ast.each_with_object(Mal::List.new) { |n, l| l << eval(n, env) } 45 | when Mal::Vector 46 | ast.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } 47 | when Mal::HashMap 48 | new_map = Mal::HashMap.new 49 | ast.each { |k, v| new_map[k] = eval(v, env) } 50 | new_map 51 | else 52 | ast 53 | end 54 | end 55 | 56 | def read(str) 57 | read_str str 58 | end 59 | 60 | def eval(t, env) 61 | ast = t.unwrap 62 | 63 | return eval_ast(t, env) unless ast.is_a?(Mal::List) 64 | return gen_type Mal::List if ast.empty? 65 | 66 | sym = ast.first.unwrap 67 | eval_error "first element of list must be a symbol" unless sym.is_a?(Mal::Symbol) 68 | 69 | Mal::Type.new case sym.str 70 | when "def!" 71 | eval_error "wrong number of argument for 'def!'" unless ast.size == 3 72 | a1 = ast[1].unwrap 73 | eval_error "1st argument of 'def!' must be symbol" unless a1.is_a?(Mal::Symbol) 74 | env.set(a1.str, eval(ast[2], env).as(Mal::Type)) 75 | when "let*" 76 | eval_error "wrong number of argument for 'def!'" unless ast.size == 3 77 | 78 | bindings = ast[1].unwrap 79 | eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a?(Array) 80 | eval_error "size of binding list must be even" unless bindings.size.even? 81 | 82 | new_env = Mal::Env.new env 83 | bindings.each_slice(2) do |binding| 84 | name, value = binding[0].unwrap, binding[1] 85 | eval_error "name of binding must be specified as symbol" unless name.is_a?(Mal::Symbol) 86 | new_env.set(name.str, eval(value, new_env)) 87 | end 88 | 89 | eval(ast[2], new_env) 90 | else 91 | f = eval_ast(ast.first, env) 92 | ast.shift(1) 93 | args = eval_ast(ast, env) 94 | 95 | if f.is_a?(Mal::Type) && (f2 = f.unwrap).is_a?(Mal::Func) 96 | f2.call(args.as(Array(Mal::Type))) 97 | else 98 | eval_error "expected function symbol as the first symbol of list" 99 | end 100 | end 101 | end 102 | 103 | def print(result) 104 | pr_str(result, true) 105 | end 106 | 107 | def rep(str) 108 | print(eval(read(str), REPL_ENV)) 109 | end 110 | end 111 | 112 | while line = Readline.readline("user> ", true) 113 | begin 114 | puts Mal.rep(line) 115 | rescue e : Mal::RuntimeException 116 | STDERR.puts "Error: #{pr_str(e.thrown, true)}" 117 | rescue e 118 | STDERR.puts "Error: #{e}" 119 | end 120 | end 121 | -------------------------------------------------------------------------------- /reader.cr: -------------------------------------------------------------------------------- 1 | require "./types" 2 | require "./error" 3 | 4 | class Reader 5 | def initialize(@tokens : Array(String)) 6 | @pos = 0 7 | end 8 | 9 | def current_token 10 | @tokens[@pos] rescue nil 11 | end 12 | 13 | def peek 14 | t = current_token 15 | 16 | if t && t[0] == ';' 17 | @pos += 1 18 | peek 19 | else 20 | t 21 | end 22 | end 23 | 24 | def next 25 | peek 26 | ensure 27 | @pos += 1 28 | end 29 | 30 | def read_sequence(init, open, close) 31 | token = self.next 32 | parse_error "expected '#{open}', got EOF" unless token 33 | parse_error "expected '#{open}', got #{token}" unless token[0] == open 34 | 35 | loop do 36 | token = peek 37 | parse_error "expected '#{close}', got EOF" unless token 38 | break if token[0] == close 39 | 40 | init << read_form 41 | peek 42 | end 43 | 44 | self.next 45 | init 46 | end 47 | 48 | def read_list 49 | Mal::Type.new read_sequence(Mal::List.new, '(', ')') 50 | end 51 | 52 | def read_vector 53 | Mal::Type.new read_sequence(Mal::Vector.new, '[', ']') 54 | end 55 | 56 | def read_hashmap 57 | types = read_sequence([] of Mal::Type, '{', '}') 58 | 59 | parse_error "odd number of elements for hash-map: #{types.size}" if types.size.odd? 60 | map = Mal::HashMap.new 61 | 62 | types.each_slice(2) do |kv| 63 | k, v = kv[0].unwrap, kv[1] 64 | case k 65 | when String 66 | map[k] = v 67 | else 68 | parse_error("key of hash-map must be string or keyword") 69 | end 70 | end 71 | 72 | Mal::Type.new map 73 | end 74 | 75 | def read_atom 76 | token = self.next 77 | parse_error "expected Atom but got EOF" unless token 78 | 79 | Mal::Type.new case 80 | when token =~ /^-?\d+$/ then token.to_i64 81 | when token =~ /^-?\d+\.\d+$/ then token.to_f64 82 | when token == "true" then true 83 | when token == "false" then false 84 | when token == "nil" then nil 85 | when token =~ /^"(?:\\.|[^\\"])*"$/ 86 | token[1..-2].gsub(/\\(.)/, {"\\\"" => "\"", 87 | "\\n" => "\n", 88 | "\\\\" => "\\"}) 89 | when token[0] == '"' then parse_error "expected '\"', got EOF" 90 | when token[0] == ':' then "\u029e#{token[1..-1]}" 91 | else Mal::Symbol.new token 92 | end 93 | end 94 | 95 | def list_of(symname) 96 | Mal::List.new << gen_type(Mal::Symbol, symname) << read_form 97 | end 98 | 99 | def read_form 100 | token = peek 101 | 102 | parse_error "unexpected EOF" unless token 103 | parse_error "unexpected comment" if token[0] == ';' 104 | 105 | Mal::Type.new case token 106 | when "(" then read_list 107 | when ")" then parse_error "unexpected ')'" 108 | when "[" then read_vector 109 | when "]" then parse_error "unexpected ']'" 110 | when "{" then read_hashmap 111 | when "}" then parse_error "unexpected '}'" 112 | when "'" then self.next; list_of("quote") 113 | when "`" then self.next; list_of("quasiquote") 114 | when "~" then self.next; list_of("unquote") 115 | when "~@" then self.next; list_of("splice-unquote") 116 | when "@" then self.next; list_of("deref") 117 | when "^" 118 | self.next 119 | meta = read_form 120 | list_of("with-meta") << meta 121 | else read_atom 122 | end 123 | end 124 | end 125 | 126 | def tokenize(str) 127 | regex = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/ 128 | str.scan(regex).map { |m| m[1] }.reject(&.empty?) 129 | end 130 | 131 | def read_str(str) 132 | r = Reader.new(tokenize(str)) 133 | begin 134 | r.read_form 135 | ensure 136 | unless r.peek.nil? 137 | raise Mal::ParseException.new "expected EOF, got #{r.peek.to_s}" 138 | end 139 | end 140 | end 141 | -------------------------------------------------------------------------------- /peg_reader_mal.cr: -------------------------------------------------------------------------------- 1 | require "arborist" 2 | require "./types" 3 | require "./error" 4 | 5 | class Reader 6 | include Arborist::DSL 7 | # Arborist::GlobalDebug.enable! 8 | 9 | @@grammar = Arborist::Grammar.new("grammars/mal.g") 10 | @@eval : Arborist::Visitor(Mal::Type?) = self.build_eval 11 | 12 | def self.build_eval 13 | eval = Arborist::Visitor(Mal::Type?).new 14 | 15 | eval.on("number") do |ctx| 16 | Mal::Type.new ctx.text.to_i64 17 | end 18 | 19 | eval.on("string") do |ctx| 20 | # TODO use JSON to unescape 21 | Mal::Type.new ctx.text[1..-2].gsub(/\\(.)/, { 22 | "\\\"" => "\"", 23 | "\\n" => "\n", 24 | "\\\\" => "\\", 25 | }) 26 | end 27 | 28 | eval.on("symbol") do |ctx| 29 | Mal::Type.new case 30 | when ctx.text == "true" then true 31 | when ctx.text == "false" then false 32 | when ctx.text == "nil" then nil 33 | when ctx.text[0] == ':' then "\u029e#{ctx.text[1..-1]}" 34 | else 35 | Mal::Symbol.new ctx.text 36 | end 37 | end 38 | 39 | eval.on("keyword") do |ctx| 40 | Mal::Type.new "\u029e#{ctx.text[1..-1]}" 41 | end 42 | 43 | eval.on("expression") do |ctx| 44 | ctx.captures.first_value[0].visit(eval) 45 | end 46 | 47 | eval.on("quote_symbol") do |ctx| 48 | Mal::Type.new Mal::Symbol.new case ctx.text 49 | when "'" then "quote" 50 | when "`" then "quasiquote" 51 | when "~@" then "splice-unquote" 52 | when "~" then "unquote" 53 | when "@" then "deref" 54 | else 55 | raise "Can't happen" 56 | end 57 | end 58 | 59 | eval.on("quote") do |ctx| 60 | quote_symbol = ctx.captures["quote_symbol"][0].visit(eval).as(Mal::Type) 61 | val = ctx.captures["expression"][0].visit(eval).as(Mal::Type) 62 | Mal::Type.new Mal::List.new << quote_symbol << val 63 | end 64 | 65 | eval.on("expression_or_comment") do |ctx| 66 | if ctx.captures["expression"]? 67 | ctx.capture("expression").visit(eval) 68 | else 69 | # return nil to skip 70 | nil 71 | end 72 | end 73 | 74 | eval.on("list") do |ctx| 75 | list = Mal::List.new 76 | if ctx.captures.first_value? 77 | ctx.captures.first_value.each do |e| 78 | val = e.visit(eval) 79 | if val 80 | list << val 81 | end 82 | end 83 | end 84 | Mal::Type.new list 85 | end 86 | 87 | eval.on("vector") do |ctx| 88 | list = Mal::Vector.new 89 | if ctx.captures.first_value? 90 | ctx.captures.first_value.each do |e| 91 | val = e.visit(eval) 92 | if val 93 | list << val 94 | end 95 | end 96 | end 97 | Mal::Type.new list 98 | end 99 | 100 | eval.on("hash_map") do |ctx| 101 | map = Mal::HashMap.new 102 | 103 | if ctx.captures["pair"]? 104 | ctx.captures["pair"].each do |pair| 105 | key = if pair.captures["string"]? 106 | pair.captures["string"][0].visit(eval).as(Mal::Type).unwrap 107 | else 108 | pair.captures["keyword"][0].visit(eval).as(Mal::Type).unwrap 109 | end 110 | val = pair.captures["expression"][0].visit(eval).as(Mal::Type) 111 | case key 112 | when String 113 | map[key] = val 114 | else 115 | raise "Can't happen" 116 | end 117 | end 118 | end 119 | 120 | Mal::Type.new map 121 | end 122 | 123 | eval 124 | end 125 | 126 | def self.parse(str) 127 | parse_tree = @@grammar.parse(str, :ohm) 128 | if parse_tree 129 | # puts parse_tree.try(&.simple_s_exp) 130 | @@eval.visit(parse_tree) 131 | else 132 | raise Mal::ParseException.new @@grammar.print_match_failure_error 133 | end 134 | end 135 | end 136 | 137 | def read_str(str) : Mal::Type 138 | result = Reader.parse(str) 139 | if result.nil? 140 | Mal::Type.new nil 141 | else 142 | result 143 | end 144 | end 145 | 146 | # Arborist::GlobalDebug.enable! 147 | # puts read_str("").to_s 148 | -------------------------------------------------------------------------------- /step4_if_fn_do.cr: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env crystal run 2 | 3 | require "readline" 4 | require "./peg_reader_mal" 5 | require "./printer" 6 | require "./types" 7 | require "./env" 8 | require "./core" 9 | require "./error" 10 | 11 | # Note: 12 | # Employed downcase names because Crystal prohibits uppercase names for methods 13 | 14 | module Mal 15 | extend self 16 | 17 | def func_of(env, binds, body) 18 | ->(args : Array(Mal::Type)) { 19 | new_env = Mal::Env.new(env, binds, args) 20 | eval(body, new_env) 21 | }.as(Mal::Func) 22 | end 23 | 24 | def eval_ast(ast, env) 25 | return ast.map { |n| eval(n, env).as(Mal::Type) } if ast.is_a? Mal::List 26 | 27 | val = ast.unwrap 28 | 29 | Mal::Type.new case val 30 | when Mal::Symbol 31 | if e = env.get(val.str) 32 | e 33 | else 34 | eval_error "'#{val.str}' not found" 35 | end 36 | when Mal::List 37 | val.each_with_object(Mal::List.new) { |n, l| l << eval(n, env) } 38 | when Mal::Vector 39 | val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } 40 | when Mal::HashMap 41 | val.each { |k, v| val[k] = eval(v, env) } 42 | val 43 | else 44 | val 45 | end 46 | end 47 | 48 | def eval_invocation(list, env) 49 | f = eval(list.first, env).unwrap 50 | eval_error "expected function symbol as the first symbol of list" unless f.is_a? Mal::Func 51 | f.call eval_ast(list[1..-1].each_with_object(Mal::List.new) { |i, l| l << i }, env) 52 | end 53 | 54 | def read(str) 55 | read_str str 56 | end 57 | 58 | def eval(ast, env) 59 | list = ast.unwrap 60 | 61 | return eval_ast(ast, env) unless list.is_a? Mal::List 62 | return gen_type Mal::List if list.empty? 63 | 64 | head = list.first.unwrap 65 | 66 | Mal::Type.new case head 67 | when Mal::Symbol 68 | case head.str 69 | when "def!" 70 | eval_error "wrong number of argument for 'def!'" unless list.size == 3 71 | a1 = list[1].unwrap 72 | eval_error "1st argument of 'def!' must be symbol" unless a1.is_a? Mal::Symbol 73 | env.set(a1.str, eval(list[2], env)) 74 | when "let*" 75 | eval_error "wrong number of argument for 'def!'" unless list.size == 3 76 | 77 | bindings = list[1].unwrap 78 | eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array 79 | eval_error "size of binding list must be even" unless bindings.size.even? 80 | 81 | new_env = Mal::Env.new env 82 | bindings.each_slice(2) do |binding| 83 | key, value = binding 84 | name = key.unwrap 85 | eval_error "name of binding must be specified as symbol" unless name.is_a? Mal::Symbol 86 | new_env.set(name.str, eval(value, new_env)) 87 | end 88 | 89 | eval(list[2], new_env) 90 | when "do" 91 | list.shift 1 92 | eval_ast(list, env).last 93 | when "if" 94 | cond = eval(list[1], env).unwrap 95 | case cond 96 | when Nil 97 | list.size >= 4 ? eval(list[3], env) : nil 98 | when false 99 | list.size >= 4 ? eval(list[3], env) : nil 100 | else 101 | eval(list[2], env) 102 | end 103 | when "fn*" 104 | # Note: 105 | # If writing lambda expression here directly, compiler will fail to infer type of 'list'. (Error 'Nil for empty?') 106 | func_of(env, list[1].unwrap, list[2]) 107 | else 108 | eval_invocation(list, env) 109 | end 110 | else 111 | eval_invocation(list, env) 112 | end 113 | end 114 | 115 | def print(result) 116 | pr_str(result, true) 117 | end 118 | 119 | def rep(str) 120 | print(eval(read(str), REPL_ENV)) 121 | end 122 | end 123 | 124 | REPL_ENV = Mal::Env.new nil 125 | Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } 126 | Mal.rep "(def! not (fn* (a) (if a false true)))" 127 | 128 | while line = Readline.readline("user> ") 129 | begin 130 | puts Mal.rep(line) 131 | rescue e : Mal::RuntimeException 132 | STDERR.puts "Error: #{pr_str(e.thrown, true)}" 133 | rescue e 134 | STDERR.puts "Error: #{e}" 135 | end 136 | end 137 | -------------------------------------------------------------------------------- /tests/step1_read_print.mal: -------------------------------------------------------------------------------- 1 | ;; Testing read of numbers 2 | 1 3 | ;=>1 4 | 7 5 | ;=>7 6 | 7 7 | ;=>7 8 | -123 9 | ;=>-123 10 | 11 | 12 | ;; Testing read of symbols 13 | + 14 | ;=>+ 15 | abc 16 | ;=>abc 17 | abc 18 | ;=>abc 19 | abc5 20 | ;=>abc5 21 | abc-def 22 | ;=>abc-def 23 | 24 | ;; Testing non-numbers starting with a dash. 25 | - 26 | ;=>- 27 | -abc 28 | ;=>-abc 29 | ->> 30 | ;=>->> 31 | 32 | ;; Testing read of lists 33 | (+ 1 2) 34 | ;=>(+ 1 2) 35 | () 36 | ;=>() 37 | ( ) 38 | ;=>() 39 | (nil) 40 | ;=>(nil) 41 | ((3 4)) 42 | ;=>((3 4)) 43 | (+ 1 (+ 2 3)) 44 | ;=>(+ 1 (+ 2 3)) 45 | ( + 1 (+ 2 3 ) ) 46 | ;=>(+ 1 (+ 2 3)) 47 | (* 1 2) 48 | ;=>(* 1 2) 49 | (** 1 2) 50 | ;=>(** 1 2) 51 | (* -3 6) 52 | ;=>(* -3 6) 53 | (()()) 54 | ;=>(() ()) 55 | 56 | ;; Test commas as whitespace 57 | (1 2, 3,,,,),, 58 | ;=>(1 2 3) 59 | 60 | 61 | ;>>> deferrable=True 62 | 63 | ;; 64 | ;; -------- Deferrable Functionality -------- 65 | 66 | ;; Testing read of nil/true/false 67 | nil 68 | ;=>nil 69 | true 70 | ;=>true 71 | false 72 | ;=>false 73 | 74 | ;; Testing read of strings 75 | "abc" 76 | ;=>"abc" 77 | "abc" 78 | ;=>"abc" 79 | "abc (with parens)" 80 | ;=>"abc (with parens)" 81 | "abc\"def" 82 | ;=>"abc\"def" 83 | "" 84 | ;=>"" 85 | "\\" 86 | ;=>"\\" 87 | "\\\\\\\\\\\\\\\\\\" 88 | ;=>"\\\\\\\\\\\\\\\\\\" 89 | "&" 90 | ;=>"&" 91 | "'" 92 | ;=>"'" 93 | "(" 94 | ;=>"(" 95 | ")" 96 | ;=>")" 97 | "*" 98 | ;=>"*" 99 | "+" 100 | ;=>"+" 101 | "," 102 | ;=>"," 103 | "-" 104 | ;=>"-" 105 | "/" 106 | ;=>"/" 107 | ":" 108 | ;=>":" 109 | ";" 110 | ;=>";" 111 | "<" 112 | ;=>"<" 113 | "=" 114 | ;=>"=" 115 | ">" 116 | ;=>">" 117 | "?" 118 | ;=>"?" 119 | "@" 120 | ;=>"@" 121 | "[" 122 | ;=>"[" 123 | "]" 124 | ;=>"]" 125 | "^" 126 | ;=>"^" 127 | "_" 128 | ;=>"_" 129 | "`" 130 | ;=>"`" 131 | "{" 132 | ;=>"{" 133 | "}" 134 | ;=>"}" 135 | "~" 136 | ;=>"~" 137 | 138 | ;; Testing reader errors 139 | (1 2 140 | ;/.*(EOF|end of input|unbalanced).* 141 | [1 2 142 | ;/.*(EOF|end of input|unbalanced).* 143 | 144 | ;;; These should throw some error with no return value 145 | "abc 146 | ;/.*(EOF|end of input|unbalanced).* 147 | " 148 | ;/.*(EOF|end of input|unbalanced).* 149 | "\" 150 | ;/.*(EOF|end of input|unbalanced).* 151 | "\\\\\\\\\\\\\\\\\\\" 152 | ;/.*(EOF|end of input|unbalanced).* 153 | (1 "abc 154 | ;/.*(EOF|end of input|unbalanced).* 155 | (1 "abc" 156 | ;/.*(EOF|end of input|unbalanced).* 157 | 158 | ;; Testing read of quoting 159 | '1 160 | ;=>(quote 1) 161 | '(1 2 3) 162 | ;=>(quote (1 2 3)) 163 | `1 164 | ;=>(quasiquote 1) 165 | `(1 2 3) 166 | ;=>(quasiquote (1 2 3)) 167 | ~1 168 | ;=>(unquote 1) 169 | ~(1 2 3) 170 | ;=>(unquote (1 2 3)) 171 | `(1 ~a 3) 172 | ;=>(quasiquote (1 (unquote a) 3)) 173 | ~@(1 2 3) 174 | ;=>(splice-unquote (1 2 3)) 175 | 176 | 177 | ;; Testing keywords 178 | :kw 179 | ;=>:kw 180 | (:kw1 :kw2 :kw3) 181 | ;=>(:kw1 :kw2 :kw3) 182 | 183 | ;; Testing read of vectors 184 | [+ 1 2] 185 | ;=>[+ 1 2] 186 | [] 187 | ;=>[] 188 | [ ] 189 | ;=>[] 190 | [[3 4]] 191 | ;=>[[3 4]] 192 | [+ 1 [+ 2 3]] 193 | ;=>[+ 1 [+ 2 3]] 194 | [ + 1 [+ 2 3 ] ] 195 | ;=>[+ 1 [+ 2 3]] 196 | ([]) 197 | ;=>([]) 198 | 199 | ;; Testing read of hash maps 200 | {} 201 | ;=>{} 202 | { } 203 | ;=>{} 204 | {"abc" 1} 205 | ;=>{"abc" 1} 206 | {"a" {"b" 2}} 207 | ;=>{"a" {"b" 2}} 208 | {"a" {"b" {"c" 3}}} 209 | ;=>{"a" {"b" {"c" 3}}} 210 | { "a" {"b" { "cde" 3 } }} 211 | ;=>{"a" {"b" {"cde" 3}}} 212 | ;;; The regexp sorcery here ensures that each key goes with the correct 213 | ;;; value and that each key appears only once. 214 | {"a1" 1 "a2" 2 "a3" 3} 215 | ;/{"a([1-3])" \1 "a(?!\1)([1-3])" \2 "a(?!\1)(?!\2)([1-3])" \3} 216 | { :a {:b { :cde 3 } }} 217 | ;=>{:a {:b {:cde 3}}} 218 | {"1" 1} 219 | ;=>{"1" 1} 220 | ({}) 221 | ;=>({}) 222 | 223 | ;; Testing read of comments 224 | ;; whole line comment (not an exception) 225 | 1 ; comment after expression 226 | ;=>1 227 | 1; comment after expression 228 | ;=>1 229 | 230 | ;; Testing read of @/deref 231 | @a 232 | ;=>(deref a) 233 | 234 | ;>>> soft=True 235 | ;>>> optional=True 236 | ;; 237 | ;; -------- Optional Functionality -------- 238 | 239 | ;; Testing read of ^/metadata 240 | ^{"a" 1} [1 2 3] 241 | ;=>(with-meta [1 2 3] {"a" 1}) 242 | 243 | 244 | ;; Non alphanumerice characters in strings 245 | ;;; \t is not specified enough to be tested 246 | "\n" 247 | ;=>"\n" 248 | "#" 249 | ;=>"#" 250 | "$" 251 | ;=>"$" 252 | "%" 253 | ;=>"%" 254 | "." 255 | ;=>"." 256 | "\\" 257 | ;=>"\\" 258 | "|" 259 | ;=>"|" 260 | 261 | ;; Non alphanumeric characters in comments 262 | 1;! 263 | ;=>1 264 | 1;" 265 | ;=>1 266 | 1;# 267 | ;=>1 268 | 1;$ 269 | ;=>1 270 | 1;% 271 | ;=>1 272 | 1;' 273 | ;=>1 274 | 1;\ 275 | ;=>1 276 | 1;\\ 277 | ;=>1 278 | 1;\\\ 279 | ;=>1 280 | 1;` 281 | ;=>1 282 | ;;; Hopefully less problematic characters 283 | 1; &()*+,-./:;<=>?@[]^_{|}~ 284 | 285 | ;; FIXME: These tests have no reasons to be optional, but... 286 | ;; fantom fails this one 287 | "!" 288 | ;=>"!" 289 | -------------------------------------------------------------------------------- /tests/docker/Dockerfile: -------------------------------------------------------------------------------- 1 | # WARNING: This file is deprecated. Each implementation now has its 2 | # own Dockerfile. 3 | 4 | FROM ubuntu:utopic 5 | MAINTAINER Joel Martin 6 | 7 | ENV DEBIAN_FRONTEND noninteractive 8 | 9 | RUN echo "deb http://dl.bintray.com/sbt/debian /" > /etc/apt/sources.list.d/sbt.list 10 | RUN apt-get -y update 11 | 12 | # 13 | # General dependencies 14 | # 15 | VOLUME /mal 16 | 17 | RUN apt-get -y install make wget curl git 18 | 19 | # Deps for compiled languages (C, Go, Rust, Nim, etc) 20 | RUN apt-get -y install gcc pkg-config 21 | 22 | # Deps for Java-based languages (Clojure, Scala, Java) 23 | RUN apt-get -y install openjdk-7-jdk 24 | ENV MAVEN_OPTS -Duser.home=/mal 25 | 26 | # Deps for Mono-based languages (C#, VB.Net) 27 | RUN apt-get -y install mono-runtime mono-mcs mono-vbnc 28 | 29 | # Deps for node.js languages (JavaScript, CoffeeScript, miniMAL, etc) 30 | RUN apt-get -y install nodejs npm 31 | RUN ln -sf nodejs /usr/bin/node 32 | 33 | 34 | # 35 | # Implementation specific installs 36 | # 37 | 38 | # GNU awk 39 | RUN apt-get -y install gawk 40 | 41 | # Bash 42 | RUN apt-get -y install bash 43 | 44 | # C 45 | RUN apt-get -y install libglib2.0 libglib2.0-dev 46 | RUN apt-get -y install libffi-dev libreadline-dev libedit2 libedit-dev 47 | 48 | # C++ 49 | RUN apt-get -y install g++-4.9 libreadline-dev 50 | 51 | # Clojure 52 | ADD https://raw.githubusercontent.com/technomancy/leiningen/stable/bin/lein \ 53 | /usr/local/bin/lein 54 | RUN sudo chmod 0755 /usr/local/bin/lein 55 | ENV LEIN_HOME /mal/.lein 56 | ENV LEIN_JVM_OPTS -Duser.home=/mal 57 | 58 | # CoffeeScript 59 | RUN npm install -g coffee-script 60 | RUN touch /.coffee_history && chmod go+w /.coffee_history 61 | 62 | # C# 63 | RUN apt-get -y install mono-mcs 64 | 65 | # Elixir 66 | RUN wget https://packages.erlang-solutions.com/erlang-solutions_1.0_all.deb \ 67 | && dpkg -i erlang-solutions_1.0_all.deb 68 | RUN apt-get update 69 | RUN apt-get -y install elixir 70 | 71 | # Erlang R17 (so I can use maps) 72 | RUN apt-get -y install build-essential libncurses5-dev libssl-dev 73 | RUN cd /tmp && wget http://www.erlang.org/download/otp_src_17.5.tar.gz \ 74 | && tar -C /tmp -zxf /tmp/otp_src_17.5.tar.gz \ 75 | && cd /tmp/otp_src_17.5 && ./configure && make && make install \ 76 | && rm -rf /tmp/otp_src_17.5 /tmp/otp_src_17.5.tar.gz 77 | # Rebar for building the Erlang implementation 78 | RUN cd /tmp/ && git clone -q https://github.com/rebar/rebar.git \ 79 | && cd /tmp/rebar && ./bootstrap && cp rebar /usr/local/bin \ 80 | && rm -rf /tmp/rebar 81 | 82 | # Forth 83 | RUN apt-get -y install gforth 84 | 85 | # Go 86 | RUN apt-get -y install golang 87 | 88 | # Guile 89 | RUN apt-get -y install libunistring-dev libgc-dev autoconf libtool flex gettext texinfo libgmp-dev 90 | RUN git clone git://git.sv.gnu.org/guile.git /tmp/guile \ 91 | && cd /tmp/guile && ./autogen.sh && ./configure && make && make install 92 | 93 | # Haskell 94 | RUN apt-get -y install ghc haskell-platform libghc-readline-dev libghc-editline-dev 95 | 96 | # Java 97 | RUN apt-get -y install maven2 98 | 99 | # JavaScript 100 | # Already satisfied above 101 | 102 | # Julia 103 | RUN apt-get -y install software-properties-common 104 | RUN apt-add-repository -y ppa:staticfloat/juliareleases 105 | RUN apt-get -y update 106 | RUN apt-get -y install julia 107 | 108 | # Lua 109 | RUN apt-get -y install lua5.1 lua-rex-pcre luarocks 110 | RUN luarocks install linenoise 111 | 112 | # Mal 113 | # N/A: self-hosted on other language implementations 114 | 115 | # GNU Make 116 | # Already satisfied as a based dependency for testing 117 | 118 | # miniMAL 119 | RUN npm install -g minimal-lisp 120 | 121 | # Nim 122 | RUN cd /tmp && wget http://nim-lang.org/download/nim-0.17.0.tar.xz \ 123 | && tar xvJf /tmp/nim-0.17.0.tar.xz && cd nim-0.17.0 \ 124 | && make && sh install.sh /usr/local/bin \ 125 | && rm -r /tmp/nim-0.17.0 126 | 127 | # OCaml 128 | RUN apt-get -y install ocaml-batteries-included 129 | 130 | # perl 131 | RUN apt-get -y install perl 132 | 133 | # PHP 134 | RUN apt-get -y install php5-cli 135 | 136 | # PostScript/ghostscript 137 | RUN apt-get -y install ghostscript 138 | 139 | # python 140 | RUN apt-get -y install python 141 | 142 | # R 143 | RUN apt-get -y install r-base-core 144 | 145 | # Racket 146 | RUN apt-get -y install racket 147 | 148 | # Ruby 149 | RUN apt-get -y install ruby 150 | 151 | # Rust 152 | RUN curl -sf https://raw.githubusercontent.com/brson/multirust/master/blastoff.sh | sh 153 | 154 | # Scala 155 | RUN apt-get -y --force-yes install sbt 156 | RUN apt-get -y install scala 157 | ENV SBT_OPTS -Duser.home=/mal 158 | 159 | # VB.Net 160 | RUN apt-get -y install mono-vbnc 161 | 162 | # TODO: move up 163 | # Factor 164 | RUN apt-get -y install libgtkglext1 165 | RUN cd /usr/lib/x86_64-linux-gnu/ \ 166 | && wget http://downloads.factorcode.org/releases/0.97/factor-linux-x86-64-0.97.tar.gz \ 167 | && tar xvzf factor-linux-x86-64-0.97.tar.gz \ 168 | && ln -sf /usr/lib/x86_64-linux-gnu/factor/factor /usr/bin/factor \ 169 | && rm factor-linux-x86-64-0.97.tar.gz 170 | 171 | # MATLAB is proprietary/licensed. Maybe someday with Octave. 172 | # Swift is XCode/OS X only 173 | ENV SKIP_IMPLS matlab swift 174 | 175 | ENV DEBIAN_FRONTEND newt 176 | ENV HOME / 177 | 178 | WORKDIR /mal 179 | -------------------------------------------------------------------------------- /step5_tco.cr: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env crystal run 2 | 3 | require "readline" 4 | require "./peg_reader_mal" 5 | require "./printer" 6 | require "./types" 7 | require "./env" 8 | require "./core" 9 | require "./error" 10 | 11 | # Note: 12 | # Employed downcase names because Crystal prohibits uppercase names for methods 13 | 14 | module Mal 15 | extend self 16 | 17 | def func_of(env, binds, body) 18 | ->(args : Array(Mal::Type)) { 19 | new_env = Mal::Env.new(env, binds, args) 20 | eval(body, new_env) 21 | }.as(Mal::Func) 22 | end 23 | 24 | def eval_ast(ast, env) 25 | return ast.map { |n| eval(n, env).as(Mal::Type) } if ast.is_a? Mal::List 26 | 27 | val = ast.unwrap 28 | 29 | Mal::Type.new case val 30 | when Mal::Symbol 31 | if e = env.get(val.str) 32 | e 33 | else 34 | eval_error "'#{val.str}' not found" 35 | end 36 | when Mal::List 37 | val.each_with_object(Mal::List.new) { |n, l| l << eval(n, env) } 38 | when Mal::Vector 39 | val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } 40 | when Array(Mal::Type) 41 | val.map { |n| eval(n, env).as(Mal::Type) } 42 | when Mal::HashMap 43 | val.each { |k, v| val[k] = eval(v, env) } 44 | val 45 | else 46 | val 47 | end 48 | end 49 | 50 | def eval_invocation(list, env) 51 | f = eval(list.first, env).unwrap 52 | case f 53 | when Mal::Closure 54 | f.fn.call eval_ast(list[1..-1].each_with_object(Mal::List.new) { |i, l| l << i }, env) 55 | when Mal::Func 56 | f.call eval_ast(list[1..-1].each_with_object(Mal::List.new) { |i, l| l << i }, env) 57 | else 58 | eval_error "expected function as the first argument" 59 | end 60 | end 61 | 62 | def read(str) 63 | read_str str 64 | end 65 | 66 | macro invoke_list(l) 67 | f = eval({{l}}.first, env).unwrap 68 | args = eval_ast({{l}}[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, env) 69 | case f 70 | when Mal::Closure 71 | ast = f.ast 72 | env = Mal::Env.new(f.env, f.params, args) 73 | next # TCO 74 | when Mal::Func 75 | return f.call args 76 | else 77 | eval_error "expected function as the first argument" 78 | end 79 | end 80 | 81 | def eval(ast, env) 82 | # 'next' in 'do...end' has a bug in crystal 0.7.1 83 | # https://github.com/manastech/crystal/issues/659 84 | while true 85 | list = ast.unwrap 86 | 87 | return eval_ast(ast, env) unless list.is_a? Mal::List 88 | return gen_type Mal::List if list.empty? 89 | 90 | head = list.first.unwrap 91 | 92 | unless head.is_a? Mal::Symbol 93 | invoke_list list 94 | end 95 | 96 | return Mal::Type.new case head.str 97 | when "def!" 98 | eval_error "wrong number of argument for 'def!'" unless list.size == 3 99 | a1 = list[1].unwrap 100 | eval_error "1st argument of 'def!' must be symbol" unless a1.is_a? Mal::Symbol 101 | env.set(a1.str, eval(list[2], env)) 102 | when "let*" 103 | eval_error "wrong number of argument for 'def!'" unless list.size == 3 104 | 105 | bindings = list[1].unwrap 106 | eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array 107 | eval_error "size of binding list must be even" unless bindings.size.even? 108 | 109 | new_env = Mal::Env.new env 110 | bindings.each_slice(2) do |binding| 111 | key, value = binding 112 | name = key.unwrap 113 | eval_error "name of binding must be specified as symbol" unless name.is_a? Mal::Symbol 114 | new_env.set(name.str, eval(value, new_env)) 115 | end 116 | 117 | ast, env = list[2], new_env 118 | next # TCO 119 | when "do" 120 | if list.empty? 121 | ast = Mal::Type.new nil 122 | next 123 | end 124 | 125 | eval_ast(list[1..-2].each_with_object(Mal::List.new) { |i, l| l << i }, env) 126 | ast = list.last 127 | next # TCO 128 | when "if" 129 | ast = unless eval(list[1], env).unwrap 130 | list.size >= 4 ? list[3] : Mal::Type.new(nil) 131 | else 132 | list[2] 133 | end 134 | next # TCO 135 | when "fn*" 136 | # Note: 137 | # If writing lambda expression here directly, compiler will fail to infer type of 'list'. (Error 'Nil for empty?') 138 | params = list[1].unwrap 139 | unless params.is_a? Array 140 | eval_error "'fn*' parameters must be list" 141 | end 142 | Mal::Closure.new(list[2], params, env, func_of(env, list[1].unwrap, list[2])) 143 | else 144 | invoke_list list 145 | end 146 | end 147 | end 148 | 149 | def print(result) 150 | pr_str(result, true) 151 | end 152 | 153 | def rep(str) 154 | print(eval(read(str), REPL_ENV)) 155 | end 156 | end 157 | 158 | REPL_ENV = Mal::Env.new nil 159 | Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } 160 | Mal.rep "(def! not (fn* (a) (if a false true)))" 161 | 162 | while line = Readline.readline("user> ", true) 163 | begin 164 | puts Mal.rep(line) 165 | rescue e : Mal::RuntimeException 166 | STDERR.puts "Error: #{pr_str(e.thrown, true)}" 167 | rescue e 168 | STDERR.puts "Error: #{e}" 169 | end 170 | end 171 | -------------------------------------------------------------------------------- /step6_file.cr: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env crystal run 2 | 3 | require "readline" 4 | require "./peg_reader_mal" 5 | require "./printer" 6 | require "./types" 7 | require "./env" 8 | require "./core" 9 | require "./error" 10 | 11 | # Note: 12 | # Employed downcase names because Crystal prohibits uppercase names for methods 13 | 14 | module Mal 15 | extend self 16 | 17 | def func_of(env, binds, body) 18 | ->(args : Array(Mal::Type)) { 19 | new_env = Mal::Env.new(env, binds, args) 20 | eval(body, new_env) 21 | }.as(Mal::Func) 22 | end 23 | 24 | def eval_ast(ast, env) 25 | return ast.map { |n| eval(n, env).as(Mal::Type) } if ast.is_a? Mal::List 26 | 27 | val = ast.unwrap 28 | 29 | Mal::Type.new case val 30 | when Mal::Symbol 31 | if e = env.get(val.str) 32 | e 33 | else 34 | eval_error "'#{val.str}' not found" 35 | end 36 | when Mal::List 37 | val.each_with_object(Mal::List.new) { |n, l| l << eval(n, env) } 38 | when Mal::Vector 39 | val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } 40 | when Array(Mal::Type) 41 | val.map { |n| eval(n, env).as(Mal::Type) } 42 | when Mal::HashMap 43 | val.each { |k, v| val[k] = eval(v, env) } 44 | val 45 | else 46 | val 47 | end 48 | end 49 | 50 | def eval_invocation(list, env) 51 | f = eval(list.first, env).unwrap 52 | case f 53 | when Mal::Closure 54 | f.fn.call eval_ast(list[1..-1].each_with_object(Mal::List.new) { |i, l| l << i }, env) 55 | when Mal::Func 56 | f.call eval_ast(list[1..-1].each_with_object(Mal::List.new) { |i, l| l << i }, env) 57 | else 58 | eval_error "expected function as the first argument" 59 | end 60 | end 61 | 62 | def read(str) 63 | read_str str 64 | end 65 | 66 | macro invoke_list(l, env) 67 | f = eval({{l}}.first, {{env}}).unwrap 68 | args = eval_ast({{l}}[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, {{env}}) 69 | case f 70 | when Mal::Closure 71 | ast = f.ast 72 | {{env}} = Mal::Env.new(f.env, f.params, args) 73 | next # TCO 74 | when Mal::Func 75 | return f.call args 76 | else 77 | eval_error "expected function as the first argument" 78 | end 79 | end 80 | 81 | def eval(ast, env) 82 | # 'next' in 'do...end' has a bug in crystal 0.7.1 83 | # https://github.com/manastech/crystal/issues/659 84 | while true 85 | list = ast.unwrap 86 | 87 | return eval_ast(ast, env) unless list.is_a? Mal::List 88 | return gen_type Mal::List if list.empty? 89 | 90 | head = list.first.unwrap 91 | 92 | unless head.is_a? Mal::Symbol 93 | invoke_list(list, env) 94 | end 95 | 96 | return Mal::Type.new case head.str 97 | when "def!" 98 | eval_error "wrong number of argument for 'def!'" unless list.size == 3 99 | a1 = list[1].unwrap 100 | eval_error "1st argument of 'def!' must be symbol" unless a1.is_a? Mal::Symbol 101 | env.set(a1.str, eval(list[2], env)) 102 | when "let*" 103 | eval_error "wrong number of argument for 'def!'" unless list.size == 3 104 | 105 | bindings = list[1].unwrap 106 | eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array 107 | eval_error "size of binding list must be even" unless bindings.size.even? 108 | 109 | new_env = Mal::Env.new env 110 | bindings.each_slice(2) do |binding| 111 | key, value = binding 112 | name = key.unwrap 113 | eval_error "name of binding must be specified as symbol" unless name.is_a? Mal::Symbol 114 | new_env.set(name.str, eval(value, new_env)) 115 | end 116 | 117 | ast, env = list[2], new_env 118 | next # TCO 119 | when "do" 120 | if list.empty? 121 | ast = Mal::Type.new nil 122 | next 123 | end 124 | 125 | eval_ast(list[1..-2].each_with_object(Mal::List.new) { |i, l| l << i }, env) 126 | ast = list.last 127 | next # TCO 128 | when "if" 129 | ast = unless eval(list[1], env).unwrap 130 | list.size >= 4 ? list[3] : Mal::Type.new(nil) 131 | else 132 | list[2] 133 | end 134 | next # TCO 135 | when "fn*" 136 | params = list[1].unwrap 137 | unless params.is_a? Array 138 | eval_error "'fn*' parameters must be list" 139 | end 140 | Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) 141 | else 142 | invoke_list(list, env) 143 | end 144 | end 145 | end 146 | 147 | def print(result) 148 | pr_str(result, true) 149 | end 150 | 151 | def rep(str) 152 | print(eval(read(str), REPL_ENV)) 153 | end 154 | end 155 | 156 | REPL_ENV = Mal::Env.new nil 157 | Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } 158 | REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0], REPL_ENV) }) 159 | Mal.rep "(def! not (fn* (a) (if a false true)))" 160 | Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" 161 | argv = Mal::List.new 162 | REPL_ENV.set("*ARGV*", Mal::Type.new argv) 163 | 164 | unless ARGV.empty? 165 | if ARGV.size > 1 166 | ARGV[1..-1].each do |a| 167 | argv << Mal::Type.new(a) 168 | end 169 | end 170 | 171 | Mal.rep "(load-file \"#{ARGV[0]}\")" 172 | exit 173 | end 174 | 175 | while line = Readline.readline("user> ", true) 176 | begin 177 | puts Mal.rep(line) 178 | rescue e : Mal::RuntimeException 179 | STDERR.puts "Error: #{pr_str(e.thrown, true)}" 180 | rescue e 181 | STDERR.puts "Error: #{e}" 182 | end 183 | end 184 | -------------------------------------------------------------------------------- /tests/stepA_mal.mal: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; See IMPL/tests/stepA_mal.mal for implementation specific 3 | ;;; interop tests. 4 | ;;; 5 | 6 | 7 | ;; 8 | ;; Testing readline 9 | (readline "mal-user> ") 10 | "hello" 11 | ;=>"\"hello\"" 12 | 13 | ;; 14 | ;; Testing *host-language* 15 | ;;; each impl is different, but this should return false 16 | ;;; rather than throwing an exception 17 | (= "something bogus" *host-language*) 18 | ;=>false 19 | 20 | 21 | ;>>> deferrable=True 22 | ;; 23 | ;; ------- Deferrable Functionality ---------- 24 | ;; ------- (Needed for self-hosting) ------- 25 | 26 | ;; 27 | ;; 28 | ;; Testing hash-map evaluation and atoms (i.e. an env) 29 | (def! e (atom {"+" +})) 30 | (swap! e assoc "-" -) 31 | ( (get @e "+") 7 8) 32 | ;=>15 33 | ( (get @e "-") 11 8) 34 | ;=>3 35 | (swap! e assoc "foo" (list)) 36 | (get @e "foo") 37 | ;=>() 38 | (swap! e assoc "bar" '(1 2 3)) 39 | (get @e "bar") 40 | ;=>(1 2 3) 41 | 42 | ;; Testing for presence of optional functions 43 | (do (list time-ms string? number? seq conj meta with-meta fn?) nil) 44 | ;=>nil 45 | 46 | ;; ------------------------------------------------------------------ 47 | 48 | ;>>> soft=True 49 | ;>>> optional=True 50 | ;; 51 | ;; ------- Optional Functionality -------------- 52 | ;; ------- (Not needed for self-hosting) ------- 53 | 54 | ;; Testing metadata on functions 55 | 56 | ;; 57 | ;; Testing metadata on mal functions 58 | 59 | (meta (fn* (a) a)) 60 | ;=>nil 61 | 62 | (meta (with-meta (fn* (a) a) {"b" 1})) 63 | ;=>{"b" 1} 64 | 65 | (meta (with-meta (fn* (a) a) "abc")) 66 | ;=>"abc" 67 | 68 | (def! l-wm (with-meta (fn* (a) a) {"b" 2})) 69 | (meta l-wm) 70 | ;=>{"b" 2} 71 | 72 | (meta (with-meta l-wm {"new_meta" 123})) 73 | ;=>{"new_meta" 123} 74 | (meta l-wm) 75 | ;=>{"b" 2} 76 | 77 | (def! f-wm (with-meta (fn* [a] (+ 1 a)) {"abc" 1})) 78 | (meta f-wm) 79 | ;=>{"abc" 1} 80 | 81 | (meta (with-meta f-wm {"new_meta" 123})) 82 | ;=>{"new_meta" 123} 83 | (meta f-wm) 84 | ;=>{"abc" 1} 85 | 86 | (def! f-wm2 ^{"abc" 1} (fn* [a] (+ 1 a))) 87 | (meta f-wm2) 88 | ;=>{"abc" 1} 89 | 90 | ;; Meta of native functions should return nil (not fail) 91 | (meta +) 92 | ;=>nil 93 | 94 | ;; 95 | ;; Make sure closures and metadata co-exist 96 | (def! gen-plusX (fn* (x) (with-meta (fn* (b) (+ x b)) {"meta" 1}))) 97 | (def! plus7 (gen-plusX 7)) 98 | (def! plus8 (gen-plusX 8)) 99 | (plus7 8) 100 | ;=>15 101 | (meta plus7) 102 | ;=>{"meta" 1} 103 | (meta plus8) 104 | ;=>{"meta" 1} 105 | (meta (with-meta plus7 {"meta" 2})) 106 | ;=>{"meta" 2} 107 | (meta plus8) 108 | ;=>{"meta" 1} 109 | 110 | ;; 111 | ;; Testing string? function 112 | (string? "") 113 | ;=>true 114 | (string? 'abc) 115 | ;=>false 116 | (string? "abc") 117 | ;=>true 118 | (string? :abc) 119 | ;=>false 120 | (string? (keyword "abc")) 121 | ;=>false 122 | (string? 234) 123 | ;=>false 124 | (string? nil) 125 | ;=>false 126 | 127 | ;; Testing number? function 128 | (number? 123) 129 | ;=>true 130 | (number? -1) 131 | ;=>true 132 | (number? nil) 133 | ;=>false 134 | (number? false) 135 | ;=>false 136 | (number? "123") 137 | ;=>false 138 | 139 | (def! add1 (fn* (x) (+ x 1))) 140 | 141 | ;; Testing fn? function 142 | (fn? +) 143 | ;=>true 144 | (fn? add1) 145 | ;=>true 146 | (fn? cond) 147 | ;=>false 148 | (fn? "+") 149 | ;=>false 150 | (fn? :+) 151 | ;=>false 152 | (fn? ^{"ismacro" true} (fn* () 0)) 153 | ;=>true 154 | 155 | ;; Testing macro? function 156 | (macro? cond) 157 | ;=>true 158 | (macro? +) 159 | ;=>false 160 | (macro? add1) 161 | ;=>false 162 | (macro? "+") 163 | ;=>false 164 | (macro? :+) 165 | ;=>false 166 | (macro? {}) 167 | ;=>false 168 | 169 | 170 | ;; 171 | ;; Testing conj function 172 | (conj (list) 1) 173 | ;=>(1) 174 | (conj (list 1) 2) 175 | ;=>(2 1) 176 | (conj (list 2 3) 4) 177 | ;=>(4 2 3) 178 | (conj (list 2 3) 4 5 6) 179 | ;=>(6 5 4 2 3) 180 | (conj (list 1) (list 2 3)) 181 | ;=>((2 3) 1) 182 | 183 | (conj [] 1) 184 | ;=>[1] 185 | (conj [1] 2) 186 | ;=>[1 2] 187 | (conj [2 3] 4) 188 | ;=>[2 3 4] 189 | (conj [2 3] 4 5 6) 190 | ;=>[2 3 4 5 6] 191 | (conj [1] [2 3]) 192 | ;=>[1 [2 3]] 193 | 194 | ;; 195 | ;; Testing seq function 196 | (seq "abc") 197 | ;=>("a" "b" "c") 198 | (apply str (seq "this is a test")) 199 | ;=>"this is a test" 200 | (seq '(2 3 4)) 201 | ;=>(2 3 4) 202 | (seq [2 3 4]) 203 | ;=>(2 3 4) 204 | 205 | (seq "") 206 | ;=>nil 207 | (seq '()) 208 | ;=>nil 209 | (seq []) 210 | ;=>nil 211 | (seq nil) 212 | ;=>nil 213 | 214 | ;; 215 | ;; Testing metadata on collections 216 | 217 | (meta [1 2 3]) 218 | ;=>nil 219 | 220 | (with-meta [1 2 3] {"a" 1}) 221 | ;=>[1 2 3] 222 | 223 | (meta (with-meta [1 2 3] {"a" 1})) 224 | ;=>{"a" 1} 225 | 226 | (vector? (with-meta [1 2 3] {"a" 1})) 227 | ;=>true 228 | 229 | (meta (with-meta [1 2 3] "abc")) 230 | ;=>"abc" 231 | 232 | (with-meta [] "abc") 233 | ;=>[] 234 | 235 | (meta (with-meta (list 1 2 3) {"a" 1})) 236 | ;=>{"a" 1} 237 | 238 | (list? (with-meta (list 1 2 3) {"a" 1})) 239 | ;=>true 240 | 241 | (with-meta (list) {"a" 1}) 242 | ;=>() 243 | 244 | (empty? (with-meta (list) {"a" 1})) 245 | ;=>true 246 | 247 | (meta (with-meta {"abc" 123} {"a" 1})) 248 | ;=>{"a" 1} 249 | 250 | (map? (with-meta {"abc" 123} {"a" 1})) 251 | ;=>true 252 | 253 | (with-meta {} {"a" 1}) 254 | ;=>{} 255 | 256 | (def! l-wm (with-meta [4 5 6] {"b" 2})) 257 | ;=>[4 5 6] 258 | (meta l-wm) 259 | ;=>{"b" 2} 260 | 261 | (meta (with-meta l-wm {"new_meta" 123})) 262 | ;=>{"new_meta" 123} 263 | (meta l-wm) 264 | ;=>{"b" 2} 265 | 266 | ;; 267 | ;; Testing metadata on builtin functions 268 | (meta +) 269 | ;=>nil 270 | (def! f-wm3 ^{"def" 2} +) 271 | (meta f-wm3) 272 | ;=>{"def" 2} 273 | (meta +) 274 | ;=>nil 275 | 276 | ;; Loading sumdown from computations.mal 277 | (load-file "./tests/computations.mal") 278 | ;=>nil 279 | 280 | ;; 281 | ;; Testing time-ms function 282 | (def! start-time (time-ms)) 283 | (= start-time 0) 284 | ;=>false 285 | (sumdown 10) ; Waste some time 286 | ;=>55 287 | (> (time-ms) start-time) 288 | ;=>true 289 | 290 | ;; 291 | ;; Test that defining a macro does not mutate an existing function. 292 | (def! f (fn* [x] (number? x))) 293 | (defmacro! m f) 294 | (f (+ 1 1)) 295 | ;=>true 296 | (m (+ 1 1)) 297 | ;=>false 298 | -------------------------------------------------------------------------------- /step7_quote.cr: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env crystal run 2 | 3 | require "readline" 4 | require "./peg_reader_mal" 5 | require "./printer" 6 | require "./types" 7 | require "./env" 8 | require "./core" 9 | require "./error" 10 | 11 | # Note: 12 | # Employed downcase names because Crystal prohibits uppercase names for methods 13 | 14 | module Mal 15 | extend self 16 | 17 | def func_of(env, binds, body) 18 | ->(args : Array(Mal::Type)) { 19 | new_env = Mal::Env.new(env, binds, args) 20 | eval(body, new_env) 21 | }.as(Mal::Func) 22 | end 23 | 24 | def eval_ast(ast, env) 25 | return ast.map { |n| eval(n, env).as(Mal::Type) } if ast.is_a? Mal::List 26 | 27 | val = ast.unwrap 28 | 29 | Mal::Type.new case val 30 | when Mal::Symbol 31 | if e = env.get(val.str) 32 | e 33 | else 34 | eval_error "'#{val.str}' not found" 35 | end 36 | when Mal::List 37 | val.each_with_object(Mal::List.new) { |n, l| l << eval(n, env) } 38 | when Mal::Vector 39 | val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } 40 | when Array(Mal::Type) 41 | val.map { |n| eval(n, env).as(Mal::Type) } 42 | when Mal::HashMap 43 | val.each { |k, v| val[k] = eval(v, env) } 44 | val 45 | else 46 | val 47 | end 48 | end 49 | 50 | def read(str) 51 | read_str str 52 | end 53 | 54 | def starts_with(list, symbol) 55 | if list.size == 2 56 | head = list.first.unwrap 57 | head.is_a? Mal::Symbol && head.str == symbol 58 | end 59 | end 60 | 61 | def quasiquote_elts(list) 62 | acc = Mal::Type.new(Mal::List.new) 63 | list.reverse.each do |elt| 64 | elt_val = elt.unwrap 65 | if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote") 66 | acc = Mal::Type.new( 67 | Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc 68 | ) 69 | else 70 | acc = Mal::Type.new( 71 | Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc 72 | ) 73 | end 74 | end 75 | acc 76 | end 77 | 78 | def quasiquote(ast) 79 | ast_val = ast.unwrap 80 | case ast_val 81 | when Mal::List 82 | if starts_with(ast_val,"unquote") 83 | ast_val[1] 84 | else 85 | quasiquote_elts(ast_val) 86 | end 87 | when Mal::Vector 88 | Mal::Type.new( 89 | Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val) 90 | ) 91 | when Mal::HashMap, Mal::Symbol 92 | Mal::Type.new ( 93 | Mal::List.new << gen_type(Mal::Symbol, "quote") << ast 94 | ) 95 | else 96 | ast 97 | end 98 | end 99 | 100 | macro invoke_list(l, env) 101 | f = eval({{l}}.first, {{env}}).unwrap 102 | args = eval_ast({{l}}[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, {{env}}) 103 | case f 104 | when Mal::Closure 105 | ast = f.ast 106 | {{env}} = Mal::Env.new(f.env, f.params, args) 107 | next # TCO 108 | when Mal::Func 109 | return f.call args 110 | else 111 | eval_error "expected function as the first argument" 112 | end 113 | end 114 | 115 | def eval(ast, env) 116 | # 'next' in 'do...end' has a bug in crystal 0.7.1 117 | # https://github.com/manastech/crystal/issues/659 118 | while true 119 | list = ast.unwrap 120 | 121 | return eval_ast(ast, env) unless list.is_a? Mal::List 122 | return gen_type Mal::List if list.empty? 123 | 124 | head = list.first.unwrap 125 | 126 | unless head.is_a? Mal::Symbol 127 | return invoke_list(list, env) 128 | end 129 | 130 | return Mal::Type.new case head.str 131 | when "def!" 132 | eval_error "wrong number of argument for 'def!'" unless list.size == 3 133 | a1 = list[1].unwrap 134 | eval_error "1st argument of 'def!' must be symbol" unless a1.is_a? Mal::Symbol 135 | env.set(a1.str, eval(list[2], env)) 136 | when "let*" 137 | eval_error "wrong number of argument for 'def!'" unless list.size == 3 138 | 139 | bindings = list[1].unwrap 140 | eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array 141 | eval_error "size of binding list must be even" unless bindings.size.even? 142 | 143 | new_env = Mal::Env.new env 144 | bindings.each_slice(2) do |binding| 145 | key, value = binding 146 | name = key.unwrap 147 | eval_error "name of binding must be specified as symbol" unless name.is_a? Mal::Symbol 148 | new_env.set(name.str, eval(value, new_env)) 149 | end 150 | 151 | ast, env = list[2], new_env 152 | next # TCO 153 | when "do" 154 | if list.empty? 155 | ast = Mal::Type.new nil 156 | next 157 | end 158 | 159 | eval_ast(list[1..-2].each_with_object(Mal::List.new) { |i, l| l << i }, env) 160 | ast = list.last 161 | next # TCO 162 | when "if" 163 | ast = unless eval(list[1], env).unwrap 164 | list.size >= 4 ? list[3] : Mal::Type.new(nil) 165 | else 166 | list[2] 167 | end 168 | next # TCO 169 | when "fn*" 170 | params = list[1].unwrap 171 | unless params.is_a? Array 172 | eval_error "'fn*' parameters must be list" 173 | end 174 | Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) 175 | when "quote" 176 | list[1] 177 | when "quasiquoteexpand" 178 | quasiquote list[1] 179 | when "quasiquote" 180 | ast = quasiquote list[1] 181 | next # TCO 182 | else 183 | invoke_list(list, env) 184 | end 185 | end 186 | end 187 | 188 | def print(result) 189 | pr_str(result, true) 190 | end 191 | 192 | def rep(str) 193 | print(eval(read(str), REPL_ENV)) 194 | end 195 | end 196 | 197 | REPL_ENV = Mal::Env.new nil 198 | Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } 199 | REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0], REPL_ENV) }) 200 | Mal.rep "(def! not (fn* (a) (if a false true)))" 201 | Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" 202 | argv = Mal::List.new 203 | REPL_ENV.set("*ARGV*", Mal::Type.new argv) 204 | 205 | unless ARGV.empty? 206 | if ARGV.size > 1 207 | ARGV[1..-1].each do |a| 208 | argv << Mal::Type.new(a) 209 | end 210 | end 211 | 212 | begin 213 | Mal.rep "(load-file \"#{ARGV[0]}\")" 214 | rescue e 215 | STDERR.puts e 216 | end 217 | exit 218 | end 219 | 220 | while line = Readline.readline("user> ", true) 221 | begin 222 | puts Mal.rep(line) 223 | rescue e : Mal::RuntimeException 224 | STDERR.puts "Error: #{pr_str(e.thrown, true)}" 225 | rescue e 226 | STDERR.puts "Error: #{e}" 227 | end 228 | end 229 | -------------------------------------------------------------------------------- /tests/step7_quote.mal: -------------------------------------------------------------------------------- 1 | ;; Testing cons function 2 | (cons 1 (list)) 3 | ;=>(1) 4 | (cons 1 (list 2)) 5 | ;=>(1 2) 6 | (cons 1 (list 2 3)) 7 | ;=>(1 2 3) 8 | (cons (list 1) (list 2 3)) 9 | ;=>((1) 2 3) 10 | 11 | (def! a (list 2 3)) 12 | (cons 1 a) 13 | ;=>(1 2 3) 14 | a 15 | ;=>(2 3) 16 | 17 | ;; Testing concat function 18 | (concat) 19 | ;=>() 20 | (concat (list 1 2)) 21 | ;=>(1 2) 22 | (concat (list 1 2) (list 3 4)) 23 | ;=>(1 2 3 4) 24 | (concat (list 1 2) (list 3 4) (list 5 6)) 25 | ;=>(1 2 3 4 5 6) 26 | (concat (concat)) 27 | ;=>() 28 | (concat (list) (list)) 29 | ;=>() 30 | 31 | (def! a (list 1 2)) 32 | (def! b (list 3 4)) 33 | (concat a b (list 5 6)) 34 | ;=>(1 2 3 4 5 6) 35 | a 36 | ;=>(1 2) 37 | b 38 | ;=>(3 4) 39 | 40 | ;; Testing regular quote 41 | (quote 7) 42 | ;=>7 43 | (quote (1 2 3)) 44 | ;=>(1 2 3) 45 | (quote (1 2 (3 4))) 46 | ;=>(1 2 (3 4)) 47 | 48 | ;; Testing simple quasiquote 49 | (quasiquote nil) 50 | ;=>nil 51 | (quasiquote 7) 52 | ;=>7 53 | (quasiquote a) 54 | ;=>a 55 | (quasiquote {"a" b}) 56 | ;=>{"a" b} 57 | 58 | ;; Testing quasiquote with lists 59 | (quasiquote ()) 60 | ;=>() 61 | (quasiquote (1 2 3)) 62 | ;=>(1 2 3) 63 | (quasiquote (a)) 64 | ;=>(a) 65 | (quasiquote (1 2 (3 4))) 66 | ;=>(1 2 (3 4)) 67 | (quasiquote (nil)) 68 | ;=>(nil) 69 | (quasiquote (1 ())) 70 | ;=>(1 ()) 71 | (quasiquote (() 1)) 72 | ;=>(() 1) 73 | (quasiquote (1 () 2)) 74 | ;=>(1 () 2) 75 | (quasiquote (())) 76 | ;=>(()) 77 | ;; (quasiquote (f () g (h) i (j k) l)) 78 | ;; =>(f () g (h) i (j k) l) 79 | 80 | ;; Testing unquote 81 | (quasiquote (unquote 7)) 82 | ;=>7 83 | (def! a 8) 84 | ;=>8 85 | (quasiquote a) 86 | ;=>a 87 | (quasiquote (unquote a)) 88 | ;=>8 89 | (quasiquote (1 a 3)) 90 | ;=>(1 a 3) 91 | (quasiquote (1 (unquote a) 3)) 92 | ;=>(1 8 3) 93 | (def! b (quote (1 "b" "d"))) 94 | ;=>(1 "b" "d") 95 | (quasiquote (1 b 3)) 96 | ;=>(1 b 3) 97 | (quasiquote (1 (unquote b) 3)) 98 | ;=>(1 (1 "b" "d") 3) 99 | (quasiquote ((unquote 1) (unquote 2))) 100 | ;=>(1 2) 101 | 102 | ;; Quasiquote and environments 103 | (let* (x 0) (quasiquote (unquote x))) 104 | ;=>0 105 | 106 | ;; Testing splice-unquote 107 | (def! c (quote (1 "b" "d"))) 108 | ;=>(1 "b" "d") 109 | (quasiquote (1 c 3)) 110 | ;=>(1 c 3) 111 | (quasiquote (1 (splice-unquote c) 3)) 112 | ;=>(1 1 "b" "d" 3) 113 | (quasiquote (1 (splice-unquote c))) 114 | ;=>(1 1 "b" "d") 115 | (quasiquote ((splice-unquote c) 2)) 116 | ;=>(1 "b" "d" 2) 117 | (quasiquote ((splice-unquote c) (splice-unquote c))) 118 | ;=>(1 "b" "d" 1 "b" "d") 119 | 120 | ;; Testing symbol equality 121 | (= (quote abc) (quote abc)) 122 | ;=>true 123 | (= (quote abc) (quote abcd)) 124 | ;=>false 125 | (= (quote abc) "abc") 126 | ;=>false 127 | (= "abc" (quote abc)) 128 | ;=>false 129 | (= "abc" (str (quote abc))) 130 | ;=>true 131 | (= (quote abc) nil) 132 | ;=>false 133 | (= nil (quote abc)) 134 | ;=>false 135 | 136 | ;>>> deferrable=True 137 | ;; 138 | ;; -------- Deferrable Functionality -------- 139 | 140 | ;; Testing ' (quote) reader macro 141 | '7 142 | ;=>7 143 | '(1 2 3) 144 | ;=>(1 2 3) 145 | '(1 2 (3 4)) 146 | ;=>(1 2 (3 4)) 147 | 148 | ;; Testing cons and concat with vectors 149 | 150 | (cons 1 []) 151 | ;=>(1) 152 | (cons [1] [2 3]) 153 | ;=>([1] 2 3) 154 | (cons 1 [2 3]) 155 | ;=>(1 2 3) 156 | (concat [1 2] (list 3 4) [5 6]) 157 | ;=>(1 2 3 4 5 6) 158 | (concat [1 2]) 159 | ;=>(1 2) 160 | 161 | ;>>> optional=True 162 | ;; 163 | ;; -------- Optional Functionality -------- 164 | 165 | ;; Testing ` (quasiquote) reader macro 166 | `7 167 | ;=>7 168 | `(1 2 3) 169 | ;=>(1 2 3) 170 | `(1 2 (3 4)) 171 | ;=>(1 2 (3 4)) 172 | `(nil) 173 | ;=>(nil) 174 | 175 | ;; Testing ~ (unquote) reader macro 176 | `~7 177 | ;=>7 178 | (def! a 8) 179 | ;=>8 180 | `(1 ~a 3) 181 | ;=>(1 8 3) 182 | (def! b '(1 "b" "d")) 183 | ;=>(1 "b" "d") 184 | `(1 b 3) 185 | ;=>(1 b 3) 186 | `(1 ~b 3) 187 | ;=>(1 (1 "b" "d") 3) 188 | 189 | ;; Testing ~@ (splice-unquote) reader macro 190 | (def! c '(1 "b" "d")) 191 | ;=>(1 "b" "d") 192 | `(1 c 3) 193 | ;=>(1 c 3) 194 | `(1 ~@c 3) 195 | ;=>(1 1 "b" "d" 3) 196 | 197 | ;>>> soft=True 198 | 199 | ;; Testing vec function 200 | 201 | (vec (list)) 202 | ;=>[] 203 | (vec (list 1)) 204 | ;=>[1] 205 | (vec (list 1 2)) 206 | ;=>[1 2] 207 | (vec []) 208 | ;=>[] 209 | (vec [1 2]) 210 | ;=>[1 2] 211 | 212 | ;; Testing that vec does not mutate the original list 213 | (def! a (list 1 2)) 214 | (vec a) 215 | ;=>[1 2] 216 | a 217 | ;=>(1 2) 218 | 219 | ;; Test quine 220 | ((fn* (q) (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* (q) (quasiquote ((unquote q) (quote (unquote q))))))) 221 | ;=>((fn* (q) (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* (q) (quasiquote ((unquote q) (quote (unquote q))))))) 222 | 223 | ;; Testing quasiquote with vectors 224 | (quasiquote []) 225 | ;=>[] 226 | (quasiquote [[]]) 227 | ;=>[[]] 228 | (quasiquote [()]) 229 | ;=>[()] 230 | (quasiquote ([])) 231 | ;=>([]) 232 | (def! a 8) 233 | ;=>8 234 | `[1 a 3] 235 | ;=>[1 a 3] 236 | (quasiquote [a [] b [c] d [e f] g]) 237 | ;=>[a [] b [c] d [e f] g] 238 | 239 | ;; Testing unquote with vectors 240 | `[~a] 241 | ;=>[8] 242 | `[(~a)] 243 | ;=>[(8)] 244 | `([~a]) 245 | ;=>([8]) 246 | `[a ~a a] 247 | ;=>[a 8 a] 248 | `([a ~a a]) 249 | ;=>([a 8 a]) 250 | `[(a ~a a)] 251 | ;=>[(a 8 a)] 252 | 253 | ;; Testing splice-unquote with vectors 254 | (def! c '(1 "b" "d")) 255 | ;=>(1 "b" "d") 256 | `[~@c] 257 | ;=>[1 "b" "d"] 258 | `[(~@c)] 259 | ;=>[(1 "b" "d")] 260 | `([~@c]) 261 | ;=>([1 "b" "d"]) 262 | `[1 ~@c 3] 263 | ;=>[1 1 "b" "d" 3] 264 | `([1 ~@c 3]) 265 | ;=>([1 1 "b" "d" 3]) 266 | `[(1 ~@c 3)] 267 | ;=>[(1 1 "b" "d" 3)] 268 | 269 | ;; Misplaced unquote or splice-unquote 270 | `(0 unquote) 271 | ;=>(0 unquote) 272 | `(0 splice-unquote) 273 | ;=>(0 splice-unquote) 274 | `[unquote 0] 275 | ;=>[unquote 0] 276 | `[splice-unquote 0] 277 | ;=>[splice-unquote 0] 278 | 279 | ;; Debugging quasiquote 280 | (quasiquoteexpand nil) 281 | ;=>nil 282 | (quasiquoteexpand 7) 283 | ;=>7 284 | (quasiquoteexpand a) 285 | ;=>(quote a) 286 | (quasiquoteexpand {"a" b}) 287 | ;=>(quote {"a" b}) 288 | (quasiquoteexpand ()) 289 | ;=>() 290 | (quasiquoteexpand (1 2 3)) 291 | ;=>(cons 1 (cons 2 (cons 3 ()))) 292 | (quasiquoteexpand (a)) 293 | ;=>(cons (quote a) ()) 294 | (quasiquoteexpand (1 2 (3 4))) 295 | ;=>(cons 1 (cons 2 (cons (cons 3 (cons 4 ())) ()))) 296 | (quasiquoteexpand (nil)) 297 | ;=>(cons nil ()) 298 | (quasiquoteexpand (1 ())) 299 | ;=>(cons 1 (cons () ())) 300 | (quasiquoteexpand (() 1)) 301 | ;=>(cons () (cons 1 ())) 302 | (quasiquoteexpand (1 () 2)) 303 | ;=>(cons 1 (cons () (cons 2 ()))) 304 | (quasiquoteexpand (())) 305 | ;=>(cons () ()) 306 | (quasiquoteexpand (f () g (h) i (j k) l)) 307 | ;=>(cons (quote f) (cons () (cons (quote g) (cons (cons (quote h) ()) (cons (quote i) (cons (cons (quote j) (cons (quote k) ())) (cons (quote l) ()))))))) 308 | (quasiquoteexpand (unquote 7)) 309 | ;=>7 310 | (quasiquoteexpand a) 311 | ;=>(quote a) 312 | (quasiquoteexpand (unquote a)) 313 | ;=>a 314 | (quasiquoteexpand (1 a 3)) 315 | ;=>(cons 1 (cons (quote a) (cons 3 ()))) 316 | (quasiquoteexpand (1 (unquote a) 3)) 317 | ;=>(cons 1 (cons a (cons 3 ()))) 318 | (quasiquoteexpand (1 b 3)) 319 | ;=>(cons 1 (cons (quote b) (cons 3 ()))) 320 | (quasiquoteexpand (1 (unquote b) 3)) 321 | ;=>(cons 1 (cons b (cons 3 ()))) 322 | (quasiquoteexpand ((unquote 1) (unquote 2))) 323 | ;=>(cons 1 (cons 2 ())) 324 | (quasiquoteexpand (a (splice-unquote (b c)) d)) 325 | ;=>(cons (quote a) (concat (b c) (cons (quote d) ()))) 326 | (quasiquoteexpand (1 c 3)) 327 | ;=>(cons 1 (cons (quote c) (cons 3 ()))) 328 | (quasiquoteexpand (1 (splice-unquote c) 3)) 329 | ;=>(cons 1 (concat c (cons 3 ()))) 330 | (quasiquoteexpand (1 (splice-unquote c))) 331 | ;=>(cons 1 (concat c ())) 332 | (quasiquoteexpand ((splice-unquote c) 2)) 333 | ;=>(concat c (cons 2 ())) 334 | (quasiquoteexpand ((splice-unquote c) (splice-unquote c))) 335 | ;=>(concat c (concat c ())) 336 | (quasiquoteexpand []) 337 | ;=>(vec ()) 338 | (quasiquoteexpand [[]]) 339 | ;=>(vec (cons (vec ()) ())) 340 | (quasiquoteexpand [()]) 341 | ;=>(vec (cons () ())) 342 | (quasiquoteexpand ([])) 343 | ;=>(cons (vec ()) ()) 344 | (quasiquoteexpand [1 a 3]) 345 | ;=>(vec (cons 1 (cons (quote a) (cons 3 ())))) 346 | (quasiquoteexpand [a [] b [c] d [e f] g]) 347 | ;=>(vec (cons (quote a) (cons (vec ()) (cons (quote b) (cons (vec (cons (quote c) ())) (cons (quote d) (cons (vec (cons (quote e) (cons (quote f) ()))) (cons (quote g) ())))))))) 348 | -------------------------------------------------------------------------------- /tests/step9_try.mal: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; Testing throw 3 | 4 | (throw "err1") 5 | ;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*err1.* 6 | 7 | ;; 8 | ;; Testing try*/catch* 9 | 10 | (try* 123 (catch* e 456)) 11 | ;=>123 12 | 13 | (try* abc (catch* exc (prn "exc is:" exc))) 14 | ;/"exc is:" "'abc' not found" 15 | ;=>nil 16 | 17 | (try* (abc 1 2) (catch* exc (prn "exc is:" exc))) 18 | ;/"exc is:" "'abc' not found" 19 | ;=>nil 20 | 21 | ;; Make sure error from core can be caught 22 | (try* (nth () 1) (catch* exc (prn "exc is:" exc))) 23 | ;/"exc is:".*(length|range|[Bb]ounds|beyond).* 24 | ;=>nil 25 | 26 | (try* (throw "my exception") (catch* exc (do (prn "exc:" exc) 7))) 27 | ;/"exc:" "my exception" 28 | ;=>7 29 | 30 | ;; Test that exception handlers get restored correctly 31 | (try* (do (try* "t1" (catch* e "c1")) (throw "e1")) (catch* e "c2")) 32 | ;=>"c2" 33 | (try* (try* (throw "e1") (catch* e (throw "e2"))) (catch* e "c2")) 34 | ;=>"c2" 35 | 36 | ;;; Test that throw is a function: 37 | (try* (map throw (list "my err")) (catch* exc exc)) 38 | ;=>"my err" 39 | 40 | 41 | ;; 42 | ;; Testing builtin functions 43 | 44 | (symbol? 'abc) 45 | ;=>true 46 | (symbol? "abc") 47 | ;=>false 48 | 49 | (nil? nil) 50 | ;=>true 51 | (nil? true) 52 | ;=>false 53 | 54 | (true? true) 55 | ;=>true 56 | (true? false) 57 | ;=>false 58 | (true? true?) 59 | ;=>false 60 | 61 | (false? false) 62 | ;=>true 63 | (false? true) 64 | ;=>false 65 | 66 | ;; Testing apply function with core functions 67 | (apply + (list 2 3)) 68 | ;=>5 69 | (apply + 4 (list 5)) 70 | ;=>9 71 | (apply prn (list 1 2 "3" (list))) 72 | ;/1 2 "3" \(\) 73 | ;=>nil 74 | (apply prn 1 2 (list "3" (list))) 75 | ;/1 2 "3" \(\) 76 | ;=>nil 77 | (apply list (list)) 78 | ;=>() 79 | (apply symbol? (list (quote two))) 80 | ;=>true 81 | 82 | ;; Testing apply function with user functions 83 | (apply (fn* (a b) (+ a b)) (list 2 3)) 84 | ;=>5 85 | (apply (fn* (a b) (+ a b)) 4 (list 5)) 86 | ;=>9 87 | 88 | ;; Testing map function 89 | (def! nums (list 1 2 3)) 90 | (def! double (fn* (a) (* 2 a))) 91 | (double 3) 92 | ;=>6 93 | (map double nums) 94 | ;=>(2 4 6) 95 | (map (fn* (x) (symbol? x)) (list 1 (quote two) "three")) 96 | ;=>(false true false) 97 | 98 | ;>>> deferrable=True 99 | ;; 100 | ;; ------- Deferrable Functionality ---------- 101 | ;; ------- (Needed for self-hosting) ------- 102 | 103 | ;; Testing throwing a hash-map 104 | (throw {:msg "err2"}) 105 | ;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*msg.*err2.* 106 | 107 | ;; Testing symbol and keyword functions 108 | (symbol? :abc) 109 | ;=>false 110 | (symbol? 'abc) 111 | ;=>true 112 | (symbol? "abc") 113 | ;=>false 114 | (symbol? (symbol "abc")) 115 | ;=>true 116 | (keyword? :abc) 117 | ;=>true 118 | (keyword? 'abc) 119 | ;=>false 120 | (keyword? "abc") 121 | ;=>false 122 | (keyword? "") 123 | ;=>false 124 | (keyword? (keyword "abc")) 125 | ;=>true 126 | 127 | (symbol "abc") 128 | ;=>abc 129 | (keyword "abc") 130 | ;=>:abc 131 | 132 | ;; Testing sequential? function 133 | 134 | (sequential? (list 1 2 3)) 135 | ;=>true 136 | (sequential? [15]) 137 | ;=>true 138 | (sequential? sequential?) 139 | ;=>false 140 | (sequential? nil) 141 | ;=>false 142 | (sequential? "abc") 143 | ;=>false 144 | 145 | ;; Testing apply function with core functions and arguments in vector 146 | (apply + 4 [5]) 147 | ;=>9 148 | (apply prn 1 2 ["3" 4]) 149 | ;/1 2 "3" 4 150 | ;=>nil 151 | (apply list []) 152 | ;=>() 153 | ;; Testing apply function with user functions and arguments in vector 154 | (apply (fn* (a b) (+ a b)) [2 3]) 155 | ;=>5 156 | (apply (fn* (a b) (+ a b)) 4 [5]) 157 | ;=>9 158 | 159 | 160 | ;; Testing map function with vectors 161 | (map (fn* (a) (* 2 a)) [1 2 3]) 162 | ;=>(2 4 6) 163 | 164 | (map (fn* [& args] (list? args)) [1 2]) 165 | ;=>(true true) 166 | 167 | ;; Testing vector functions 168 | 169 | (vector? [10 11]) 170 | ;=>true 171 | (vector? '(12 13)) 172 | ;=>false 173 | (vector 3 4 5) 174 | ;=>[3 4 5] 175 | 176 | (map? {}) 177 | ;=>true 178 | (map? '()) 179 | ;=>false 180 | (map? []) 181 | ;=>false 182 | (map? 'abc) 183 | ;=>false 184 | (map? :abc) 185 | ;=>false 186 | 187 | 188 | ;; 189 | ;; Testing hash-maps 190 | (hash-map "a" 1) 191 | ;=>{"a" 1} 192 | 193 | {"a" 1} 194 | ;=>{"a" 1} 195 | 196 | (assoc {} "a" 1) 197 | ;=>{"a" 1} 198 | 199 | (get (assoc (assoc {"a" 1 } "b" 2) "c" 3) "a") 200 | ;=>1 201 | 202 | (def! hm1 (hash-map)) 203 | ;=>{} 204 | 205 | (map? hm1) 206 | ;=>true 207 | (map? 1) 208 | ;=>false 209 | (map? "abc") 210 | ;=>false 211 | 212 | (get nil "a") 213 | ;=>nil 214 | 215 | (get hm1 "a") 216 | ;=>nil 217 | 218 | (contains? hm1 "a") 219 | ;=>false 220 | 221 | (def! hm2 (assoc hm1 "a" 1)) 222 | ;=>{"a" 1} 223 | 224 | (get hm1 "a") 225 | ;=>nil 226 | 227 | (contains? hm1 "a") 228 | ;=>false 229 | 230 | (get hm2 "a") 231 | ;=>1 232 | 233 | (contains? hm2 "a") 234 | ;=>true 235 | 236 | 237 | ;;; TODO: fix. Clojure returns nil but this breaks mal impl 238 | (keys hm1) 239 | ;=>() 240 | 241 | (keys hm2) 242 | ;=>("a") 243 | 244 | (keys {"1" 1}) 245 | ;=>("1") 246 | 247 | ;;; TODO: fix. Clojure returns nil but this breaks mal impl 248 | (vals hm1) 249 | ;=>() 250 | 251 | (vals hm2) 252 | ;=>(1) 253 | 254 | (count (keys (assoc hm2 "b" 2 "c" 3))) 255 | ;=>3 256 | 257 | ;; Testing keywords as hash-map keys 258 | (get {:abc 123} :abc) 259 | ;=>123 260 | (contains? {:abc 123} :abc) 261 | ;=>true 262 | (contains? {:abcd 123} :abc) 263 | ;=>false 264 | (assoc {} :bcd 234) 265 | ;=>{:bcd 234} 266 | (keyword? (nth (keys {:abc 123 :def 456}) 0)) 267 | ;=>true 268 | (keyword? (nth (vals {"a" :abc "b" :def}) 0)) 269 | ;=>true 270 | 271 | ;; Testing whether assoc updates properly 272 | (def! hm4 (assoc {:a 1 :b 2} :a 3 :c 1)) 273 | (get hm4 :a) 274 | ;=>3 275 | (get hm4 :b) 276 | ;=>2 277 | (get hm4 :c) 278 | ;=>1 279 | 280 | ;; Testing nil as hash-map values 281 | (contains? {:abc nil} :abc) 282 | ;=>true 283 | (assoc {} :bcd nil) 284 | ;=>{:bcd nil} 285 | 286 | ;; 287 | ;; Additional str and pr-str tests 288 | 289 | (str "A" {:abc "val"} "Z") 290 | ;=>"A{:abc val}Z" 291 | 292 | (str true "." false "." nil "." :keyw "." 'symb) 293 | ;=>"true.false.nil.:keyw.symb" 294 | 295 | (pr-str "A" {:abc "val"} "Z") 296 | ;=>"\"A\" {:abc \"val\"} \"Z\"" 297 | 298 | (pr-str true "." false "." nil "." :keyw "." 'symb) 299 | ;=>"true \".\" false \".\" nil \".\" :keyw \".\" symb" 300 | 301 | (def! s (str {:abc "val1" :def "val2"})) 302 | (cond (= s "{:abc val1 :def val2}") true (= s "{:def val2 :abc val1}") true) 303 | ;=>true 304 | 305 | (def! p (pr-str {:abc "val1" :def "val2"})) 306 | (cond (= p "{:abc \"val1\" :def \"val2\"}") true (= p "{:def \"val2\" :abc \"val1\"}") true) 307 | ;=>true 308 | 309 | ;; 310 | ;; Test extra function arguments as Mal List (bypassing TCO with apply) 311 | (apply (fn* (& more) (list? more)) [1 2 3]) 312 | ;=>true 313 | (apply (fn* (& more) (list? more)) []) 314 | ;=>true 315 | (apply (fn* (a & more) (list? more)) [1]) 316 | ;=>true 317 | 318 | ;>>> soft=True 319 | ;>>> optional=True 320 | ;; 321 | ;; ------- Optional Functionality -------------- 322 | ;; ------- (Not needed for self-hosting) ------- 323 | 324 | 325 | ;;;TODO: fix so long lines don't trigger ANSI escape codes ;;;(try* 326 | ;;;(try* (throw ["data" "foo"]) (catch* exc (do (prn "exc is:" exc) 7))) ;;;; 327 | ;;;; "exc is:" ["data" "foo"] ;;;;=>7 328 | ;;;;=>7 329 | 330 | ;; 331 | ;; Testing try* without catch* 332 | (try* xyz) 333 | ;/.*\'?xyz\'? not found.* 334 | 335 | ;; 336 | ;; Testing throwing non-strings 337 | (try* (throw (list 1 2 3)) (catch* exc (do (prn "err:" exc) 7))) 338 | ;/"err:" \(1 2 3\) 339 | ;=>7 340 | 341 | ;; 342 | ;; Testing dissoc 343 | (def! hm3 (assoc hm2 "b" 2)) 344 | (count (keys hm3)) 345 | ;=>2 346 | (count (vals hm3)) 347 | ;=>2 348 | (dissoc hm3 "a") 349 | ;=>{"b" 2} 350 | (dissoc hm3 "a" "b") 351 | ;=>{} 352 | (dissoc hm3 "a" "b" "c") 353 | ;=>{} 354 | (count (keys hm3)) 355 | ;=>2 356 | 357 | (dissoc {:cde 345 :fgh 456} :cde) 358 | ;=>{:fgh 456} 359 | (dissoc {:cde nil :fgh 456} :cde) 360 | ;=>{:fgh 456} 361 | 362 | ;; 363 | ;; Testing equality of hash-maps 364 | (= {} {}) 365 | ;=>true 366 | (= {:a 11 :b 22} (hash-map :b 22 :a 11)) 367 | ;=>true 368 | (= {:a 11 :b [22 33]} (hash-map :b [22 33] :a 11)) 369 | ;=>true 370 | (= {:a 11 :b {:c 33}} (hash-map :b {:c 33} :a 11)) 371 | ;=>true 372 | (= {:a 11 :b 22} (hash-map :b 23 :a 11)) 373 | ;=>false 374 | (= {:a 11 :b 22} (hash-map :a 11)) 375 | ;=>false 376 | (= {:a [11 22]} {:a (list 11 22)}) 377 | ;=>true 378 | (= {:a 11 :b 22} (list :a 11 :b 22)) 379 | ;=>false 380 | (= {} []) 381 | ;=>false 382 | (= [] {}) 383 | ;=>false 384 | 385 | (keyword :abc) 386 | ;=>:abc 387 | (keyword? (first (keys {":abc" 123 ":def" 456}))) 388 | ;=>false 389 | -------------------------------------------------------------------------------- /tests/step4_if_fn_do.mal: -------------------------------------------------------------------------------- 1 | ;; ----------------------------------------------------- 2 | 3 | 4 | ;; Testing list functions 5 | (list) 6 | ;=>() 7 | (list? (list)) 8 | ;=>true 9 | (empty? (list)) 10 | ;=>true 11 | (empty? (list 1)) 12 | ;=>false 13 | (list 1 2 3) 14 | ;=>(1 2 3) 15 | (count (list 1 2 3)) 16 | ;=>3 17 | (count (list)) 18 | ;=>0 19 | (count nil) 20 | ;=>0 21 | (if (> (count (list 1 2 3)) 3) 89 78) 22 | ;=>78 23 | (if (>= (count (list 1 2 3)) 3) 89 78) 24 | ;=>89 25 | 26 | 27 | ;; Testing if form 28 | (if true 7 8) 29 | ;=>7 30 | (if false 7 8) 31 | ;=>8 32 | (if false 7 false) 33 | ;=>false 34 | (if true (+ 1 7) (+ 1 8)) 35 | ;=>8 36 | (if false (+ 1 7) (+ 1 8)) 37 | ;=>9 38 | (if nil 7 8) 39 | ;=>8 40 | (if 0 7 8) 41 | ;=>7 42 | (if (list) 7 8) 43 | ;=>7 44 | (if (list 1 2 3) 7 8) 45 | ;=>7 46 | (= (list) nil) 47 | ;=>false 48 | 49 | 50 | ;; Testing 1-way if form 51 | (if false (+ 1 7)) 52 | ;=>nil 53 | (if nil 8) 54 | ;=>nil 55 | (if nil 8 7) 56 | ;=>7 57 | (if true (+ 1 7)) 58 | ;=>8 59 | 60 | 61 | ;; Testing basic conditionals 62 | (= 2 1) 63 | ;=>false 64 | (= 1 1) 65 | ;=>true 66 | (= 1 2) 67 | ;=>false 68 | (= 1 (+ 1 1)) 69 | ;=>false 70 | (= 2 (+ 1 1)) 71 | ;=>true 72 | (= nil 1) 73 | ;=>false 74 | (= nil nil) 75 | ;=>true 76 | 77 | (> 2 1) 78 | ;=>true 79 | (> 1 1) 80 | ;=>false 81 | (> 1 2) 82 | ;=>false 83 | 84 | (>= 2 1) 85 | ;=>true 86 | (>= 1 1) 87 | ;=>true 88 | (>= 1 2) 89 | ;=>false 90 | 91 | (< 2 1) 92 | ;=>false 93 | (< 1 1) 94 | ;=>false 95 | (< 1 2) 96 | ;=>true 97 | 98 | (<= 2 1) 99 | ;=>false 100 | (<= 1 1) 101 | ;=>true 102 | (<= 1 2) 103 | ;=>true 104 | 105 | 106 | ;; Testing equality 107 | (= 1 1) 108 | ;=>true 109 | (= 0 0) 110 | ;=>true 111 | (= 1 0) 112 | ;=>false 113 | (= true true) 114 | ;=>true 115 | (= false false) 116 | ;=>true 117 | (= nil nil) 118 | ;=>true 119 | 120 | (= (list) (list)) 121 | ;=>true 122 | (= (list 1 2) (list 1 2)) 123 | ;=>true 124 | (= (list 1) (list)) 125 | ;=>false 126 | (= (list) (list 1)) 127 | ;=>false 128 | (= 0 (list)) 129 | ;=>false 130 | (= (list) 0) 131 | ;=>false 132 | (= (list nil) (list)) 133 | ;=>false 134 | 135 | 136 | ;; Testing builtin and user defined functions 137 | (+ 1 2) 138 | ;=>3 139 | ( (fn* (a b) (+ b a)) 3 4) 140 | ;=>7 141 | ( (fn* () 4) ) 142 | ;=>4 143 | 144 | ( (fn* (f x) (f x)) (fn* (a) (+ 1 a)) 7) 145 | ;=>8 146 | 147 | 148 | ;; Testing closures 149 | ( ( (fn* (a) (fn* (b) (+ a b))) 5) 7) 150 | ;=>12 151 | 152 | (def! gen-plus5 (fn* () (fn* (b) (+ 5 b)))) 153 | (def! plus5 (gen-plus5)) 154 | (plus5 7) 155 | ;=>12 156 | 157 | (def! gen-plusX (fn* (x) (fn* (b) (+ x b)))) 158 | (def! plus7 (gen-plusX 7)) 159 | (plus7 8) 160 | ;=>15 161 | 162 | ;; Testing do form 163 | (do (prn 101)) 164 | ;/101 165 | ;=>nil 166 | (do (prn 102) 7) 167 | ;/102 168 | ;=>7 169 | (do (prn 101) (prn 102) (+ 1 2)) 170 | ;/101 171 | ;/102 172 | ;=>3 173 | 174 | (do (def! a 6) 7 (+ a 8)) 175 | ;=>14 176 | a 177 | ;=>6 178 | 179 | ;; Testing special form case-sensitivity 180 | (def! DO (fn* (a) 7)) 181 | (DO 3) 182 | ;=>7 183 | 184 | ;; Testing recursive sumdown function 185 | (def! sumdown (fn* (N) (if (> N 0) (+ N (sumdown (- N 1))) 0))) 186 | (sumdown 1) 187 | ;=>1 188 | (sumdown 2) 189 | ;=>3 190 | (sumdown 6) 191 | ;=>21 192 | 193 | 194 | ;; Testing recursive fibonacci function 195 | (def! fib (fn* (N) (if (= N 0) 1 (if (= N 1) 1 (+ (fib (- N 1)) (fib (- N 2))))))) 196 | (fib 1) 197 | ;=>1 198 | (fib 2) 199 | ;=>2 200 | (fib 4) 201 | ;=>5 202 | 203 | 204 | ;; Testing recursive function in environment. 205 | (let* (cst (fn* (n) (if (= n 0) nil (cst (- n 1))))) (cst 1)) 206 | ;=>nil 207 | (let* (f (fn* (n) (if (= n 0) 0 (g (- n 1)))) g (fn* (n) (f n))) (f 2)) 208 | ;=>0 209 | 210 | 211 | ;>>> deferrable=True 212 | ;; 213 | ;; -------- Deferrable Functionality -------- 214 | 215 | ;; Testing if on strings 216 | 217 | (if "" 7 8) 218 | ;=>7 219 | 220 | ;; Testing string equality 221 | 222 | (= "" "") 223 | ;=>true 224 | (= "abc" "abc") 225 | ;=>true 226 | (= "abc" "") 227 | ;=>false 228 | (= "" "abc") 229 | ;=>false 230 | (= "abc" "def") 231 | ;=>false 232 | (= "abc" "ABC") 233 | ;=>false 234 | (= (list) "") 235 | ;=>false 236 | (= "" (list)) 237 | ;=>false 238 | 239 | ;; Testing variable length arguments 240 | 241 | ( (fn* (& more) (count more)) 1 2 3) 242 | ;=>3 243 | ( (fn* (& more) (list? more)) 1 2 3) 244 | ;=>true 245 | ( (fn* (& more) (count more)) 1) 246 | ;=>1 247 | ( (fn* (& more) (count more)) ) 248 | ;=>0 249 | ( (fn* (& more) (list? more)) ) 250 | ;=>true 251 | ( (fn* (a & more) (count more)) 1 2 3) 252 | ;=>2 253 | ( (fn* (a & more) (count more)) 1) 254 | ;=>0 255 | ( (fn* (a & more) (list? more)) 1) 256 | ;=>true 257 | 258 | 259 | ;; Testing language defined not function 260 | (not false) 261 | ;=>true 262 | (not nil) 263 | ;=>true 264 | (not true) 265 | ;=>false 266 | (not "a") 267 | ;=>false 268 | (not 0) 269 | ;=>false 270 | 271 | 272 | ;; ----------------------------------------------------- 273 | 274 | ;; Testing string quoting 275 | 276 | "" 277 | ;=>"" 278 | 279 | "abc" 280 | ;=>"abc" 281 | 282 | "abc def" 283 | ;=>"abc def" 284 | 285 | "\"" 286 | ;=>"\"" 287 | 288 | "abc\ndef\nghi" 289 | ;=>"abc\ndef\nghi" 290 | 291 | "abc\\def\\ghi" 292 | ;=>"abc\\def\\ghi" 293 | 294 | "\\n" 295 | ;=>"\\n" 296 | 297 | ;; Testing pr-str 298 | 299 | (pr-str) 300 | ;=>"" 301 | 302 | (pr-str "") 303 | ;=>"\"\"" 304 | 305 | (pr-str "abc") 306 | ;=>"\"abc\"" 307 | 308 | (pr-str "abc def" "ghi jkl") 309 | ;=>"\"abc def\" \"ghi jkl\"" 310 | 311 | (pr-str "\"") 312 | ;=>"\"\\\"\"" 313 | 314 | (pr-str (list 1 2 "abc" "\"") "def") 315 | ;=>"(1 2 \"abc\" \"\\\"\") \"def\"" 316 | 317 | (pr-str "abc\ndef\nghi") 318 | ;=>"\"abc\\ndef\\nghi\"" 319 | 320 | (pr-str "abc\\def\\ghi") 321 | ;=>"\"abc\\\\def\\\\ghi\"" 322 | 323 | (pr-str (list)) 324 | ;=>"()" 325 | 326 | ;; Testing str 327 | 328 | (str) 329 | ;=>"" 330 | 331 | (str "") 332 | ;=>"" 333 | 334 | (str "abc") 335 | ;=>"abc" 336 | 337 | (str "\"") 338 | ;=>"\"" 339 | 340 | (str 1 "abc" 3) 341 | ;=>"1abc3" 342 | 343 | (str "abc def" "ghi jkl") 344 | ;=>"abc defghi jkl" 345 | 346 | (str "abc\ndef\nghi") 347 | ;=>"abc\ndef\nghi" 348 | 349 | (str "abc\\def\\ghi") 350 | ;=>"abc\\def\\ghi" 351 | 352 | (str (list 1 2 "abc" "\"") "def") 353 | ;=>"(1 2 abc \")def" 354 | 355 | (str (list)) 356 | ;=>"()" 357 | 358 | ;; Testing prn 359 | (prn) 360 | ;/ 361 | ;=>nil 362 | 363 | (prn "") 364 | ;/"" 365 | ;=>nil 366 | 367 | (prn "abc") 368 | ;/"abc" 369 | ;=>nil 370 | 371 | (prn "abc def" "ghi jkl") 372 | ;/"abc def" "ghi jkl" 373 | 374 | (prn "\"") 375 | ;/"\\"" 376 | ;=>nil 377 | 378 | (prn "abc\ndef\nghi") 379 | ;/"abc\\ndef\\nghi" 380 | ;=>nil 381 | 382 | (prn "abc\\def\\ghi") 383 | ;/"abc\\\\def\\\\ghi" 384 | nil 385 | 386 | (prn (list 1 2 "abc" "\"") "def") 387 | ;/\(1 2 "abc" "\\""\) "def" 388 | ;=>nil 389 | 390 | 391 | ;; Testing println 392 | (println) 393 | ;/ 394 | ;=>nil 395 | 396 | (println "") 397 | ;/ 398 | ;=>nil 399 | 400 | (println "abc") 401 | ;/abc 402 | ;=>nil 403 | 404 | (println "abc def" "ghi jkl") 405 | ;/abc def ghi jkl 406 | 407 | (println "\"") 408 | ;/" 409 | ;=>nil 410 | 411 | (println "abc\ndef\nghi") 412 | ;/abc 413 | ;/def 414 | ;/ghi 415 | ;=>nil 416 | 417 | (println "abc\\def\\ghi") 418 | ;/abc\\def\\ghi 419 | ;=>nil 420 | 421 | (println (list 1 2 "abc" "\"") "def") 422 | ;/\(1 2 abc "\) def 423 | ;=>nil 424 | 425 | 426 | ;; Testing keywords 427 | (= :abc :abc) 428 | ;=>true 429 | (= :abc :def) 430 | ;=>false 431 | (= :abc ":abc") 432 | ;=>false 433 | (= (list :abc) (list :abc)) 434 | ;=>true 435 | 436 | ;; Testing vector truthiness 437 | (if [] 7 8) 438 | ;=>7 439 | 440 | ;; Testing vector printing 441 | (pr-str [1 2 "abc" "\""] "def") 442 | ;=>"[1 2 \"abc\" \"\\\"\"] \"def\"" 443 | 444 | (pr-str []) 445 | ;=>"[]" 446 | 447 | (str [1 2 "abc" "\""] "def") 448 | ;=>"[1 2 abc \"]def" 449 | 450 | (str []) 451 | ;=>"[]" 452 | 453 | 454 | ;; Testing vector functions 455 | (count [1 2 3]) 456 | ;=>3 457 | (empty? [1 2 3]) 458 | ;=>false 459 | (empty? []) 460 | ;=>true 461 | (list? [4 5 6]) 462 | ;=>false 463 | 464 | ;; Testing vector equality 465 | (= [] (list)) 466 | ;=>true 467 | (= [7 8] [7 8]) 468 | ;=>true 469 | (= [:abc] [:abc]) 470 | ;=>true 471 | (= (list 1 2) [1 2]) 472 | ;=>true 473 | (= (list 1) []) 474 | ;=>false 475 | (= [] [1]) 476 | ;=>false 477 | (= 0 []) 478 | ;=>false 479 | (= [] 0) 480 | ;=>false 481 | (= [] "") 482 | ;=>false 483 | (= "" []) 484 | ;=>false 485 | 486 | ;; Testing vector parameter lists 487 | ( (fn* [] 4) ) 488 | ;=>4 489 | ( (fn* [f x] (f x)) (fn* [a] (+ 1 a)) 7) 490 | ;=>8 491 | 492 | ;; Nested vector/list equality 493 | (= [(list)] (list [])) 494 | ;=>true 495 | (= [1 2 (list 3 4 [5 6])] (list 1 2 [3 4 (list 5 6)])) 496 | ;=>true 497 | -------------------------------------------------------------------------------- /step8_macros.cr: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env crystal run 2 | 3 | require "readline" 4 | require "./peg_reader_mal" 5 | require "./printer" 6 | require "./types" 7 | require "./env" 8 | require "./core" 9 | require "./error" 10 | 11 | # Note: 12 | # Employed downcase names because Crystal prohibits uppercase names for methods 13 | 14 | module Mal 15 | extend self 16 | 17 | def func_of(env, binds, body) 18 | ->(args : Array(Mal::Type)) { 19 | new_env = Mal::Env.new(env, binds, args) 20 | eval(body, new_env) 21 | }.as(Mal::Func) 22 | end 23 | 24 | def eval_ast(ast, env) 25 | return ast.map { |n| eval(n, env).as(Mal::Type) } if ast.is_a? Mal::List 26 | 27 | val = ast.unwrap 28 | 29 | Mal::Type.new case val 30 | when Mal::Symbol 31 | if e = env.get(val.str) 32 | e 33 | else 34 | eval_error "'#{val.str}' not found" 35 | end 36 | when Mal::List 37 | val.each_with_object(Mal::List.new) { |n, l| l << eval(n, env) } 38 | when Mal::Vector 39 | val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } 40 | when Array(Mal::Type) 41 | val.map { |n| eval(n, env).as(Mal::Type) } 42 | when Mal::HashMap 43 | val.each { |k, v| val[k] = eval(v, env) } 44 | val 45 | else 46 | val 47 | end 48 | end 49 | 50 | def read(str) 51 | read_str str 52 | end 53 | 54 | def starts_with(list, symbol) 55 | if list.size == 2 56 | head = list.first.unwrap 57 | head.is_a? Mal::Symbol && head.str == symbol 58 | end 59 | end 60 | 61 | def quasiquote_elts(list) 62 | acc = Mal::Type.new(Mal::List.new) 63 | list.reverse.each do |elt| 64 | elt_val = elt.unwrap 65 | if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote") 66 | acc = Mal::Type.new( 67 | Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc 68 | ) 69 | else 70 | acc = Mal::Type.new( 71 | Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc 72 | ) 73 | end 74 | end 75 | acc 76 | end 77 | 78 | def quasiquote(ast) 79 | ast_val = ast.unwrap 80 | case ast_val 81 | when Mal::List 82 | if starts_with(ast_val,"unquote") 83 | ast_val[1] 84 | else 85 | quasiquote_elts(ast_val) 86 | end 87 | when Mal::Vector 88 | Mal::Type.new( 89 | Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val) 90 | ) 91 | when Mal::HashMap, Mal::Symbol 92 | Mal::Type.new ( 93 | Mal::List.new << gen_type(Mal::Symbol, "quote") << ast 94 | ) 95 | else 96 | ast 97 | end 98 | end 99 | 100 | def macro_call?(ast, env) 101 | list = ast.unwrap 102 | return false unless list.is_a? Mal::List 103 | return false if list.empty? 104 | 105 | sym = list.first.unwrap 106 | return false unless sym.is_a? Mal::Symbol 107 | 108 | func = env.find(sym.str).try(&.data[sym.str]) 109 | return false unless func && func.macro? 110 | 111 | true 112 | end 113 | 114 | def macroexpand(ast, env) 115 | while macro_call?(ast, env) 116 | # Already checked in macro_call? 117 | list = ast.unwrap.as(Mal::List) 118 | func_sym = list[0].unwrap.as(Mal::Symbol) 119 | func = env.get(func_sym.str).unwrap 120 | 121 | case func 122 | when Mal::Func 123 | ast = func.call(list[1..-1]) 124 | when Mal::Closure 125 | ast = func.fn.call(list[1..-1]) 126 | else 127 | eval_error "macro '#{func_sym.str}' must be function: #{ast}" 128 | end 129 | end 130 | 131 | ast 132 | end 133 | 134 | macro invoke_list(l, env) 135 | f = eval({{l}}.first, {{env}}).unwrap 136 | args = eval_ast({{l}}[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, {{env}}) 137 | case f 138 | when Mal::Closure 139 | ast = f.ast 140 | {{env}} = Mal::Env.new(f.env, f.params, args) 141 | next # TCO 142 | when Mal::Func 143 | return f.call args 144 | else 145 | eval_error "expected function as the first argument: #{f}" 146 | end 147 | end 148 | 149 | def eval(ast, env) 150 | # 'next' in 'do...end' has a bug in crystal 0.7.1 151 | # https://github.com/manastech/crystal/issues/659 152 | while true 153 | list = ast.unwrap 154 | 155 | return eval_ast(ast, env) unless list.is_a? Mal::List 156 | return ast if list.empty? 157 | 158 | ast = macroexpand(ast, env) 159 | 160 | list = ast.unwrap 161 | 162 | return eval_ast(ast, env) unless list.is_a? Mal::List 163 | return ast if list.empty? 164 | 165 | head = list.first.unwrap 166 | 167 | return invoke_list(list, env) unless head.is_a? Mal::Symbol 168 | 169 | return Mal::Type.new case head.str 170 | when "def!" 171 | eval_error "wrong number of argument for 'def!'" unless list.size == 3 172 | a1 = list[1].unwrap 173 | eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol 174 | env.set(a1.str, eval(list[2], env)) 175 | when "let*" 176 | eval_error "wrong number of argument for 'def!'" unless list.size == 3 177 | 178 | bindings = list[1].unwrap 179 | eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array 180 | eval_error "size of binding list must be even" unless bindings.size.even? 181 | 182 | new_env = Mal::Env.new env 183 | bindings.each_slice(2) do |binding| 184 | key, value = binding 185 | name = key.unwrap 186 | eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol 187 | new_env.set(name.str, eval(value, new_env)) 188 | end 189 | 190 | ast, env = list[2], new_env 191 | next # TCO 192 | when "do" 193 | if list.empty? 194 | ast = Mal::Type.new nil 195 | next 196 | end 197 | 198 | eval_ast(list[1..-2].each_with_object(Mal::List.new) { |i, l| l << i }, env) 199 | ast = list.last 200 | next # TCO 201 | when "if" 202 | ast = unless eval(list[1], env).unwrap 203 | list.size >= 4 ? list[3] : Mal::Type.new(nil) 204 | else 205 | list[2] 206 | end 207 | next # TCO 208 | when "fn*" 209 | params = list[1].unwrap 210 | unless params.is_a? Array 211 | eval_error "'fn*' parameters must be list or vector: #{params}" 212 | end 213 | Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) 214 | when "quote" 215 | list[1] 216 | when "quasiquoteexpand" 217 | quasiquote list[1] 218 | when "quasiquote" 219 | ast = quasiquote list[1] 220 | next # TCO 221 | when "defmacro!" 222 | eval_error "wrong number of argument for 'defmacro!'" unless list.size == 3 223 | a1 = list[1].unwrap 224 | eval_error "1st argument of 'defmacro!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol 225 | env.set(a1.str, eval(list[2], env).tap { |n| n.is_macro = true }) 226 | when "macroexpand" 227 | macroexpand(list[1], env) 228 | else 229 | invoke_list(list, env) 230 | end 231 | end 232 | end 233 | 234 | def print(result) 235 | pr_str(result, true) 236 | end 237 | 238 | def rep(str) 239 | print(eval(read(str), REPL_ENV)) 240 | end 241 | end 242 | 243 | REPL_ENV = Mal::Env.new nil 244 | Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } 245 | REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0], REPL_ENV) }) 246 | Mal.rep "(def! not (fn* (a) (if a false true)))" 247 | Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" 248 | Mal.rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" 249 | 250 | argv = Mal::List.new 251 | REPL_ENV.set("*ARGV*", Mal::Type.new argv) 252 | 253 | unless ARGV.empty? 254 | if ARGV.size > 1 255 | ARGV[1..-1].each do |a| 256 | argv << Mal::Type.new(a) 257 | end 258 | end 259 | 260 | begin 261 | Mal.rep "(load-file \"#{ARGV[0]}\")" 262 | rescue e 263 | STDERR.puts e 264 | end 265 | exit 266 | end 267 | 268 | while line = Readline.readline("user> ", true) 269 | begin 270 | puts Mal.rep(line) 271 | rescue e : Mal::RuntimeException 272 | STDERR.puts "Error: #{pr_str(e.thrown, true)}" 273 | rescue e 274 | STDERR.puts "Error: #{e}" 275 | end 276 | end 277 | -------------------------------------------------------------------------------- /step9_try.cr: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env crystal run 2 | 3 | require "readline" 4 | require "./peg_reader_mal" 5 | require "./printer" 6 | require "./types" 7 | require "./env" 8 | require "./core" 9 | require "./error" 10 | 11 | # Note: 12 | # Employed downcase names because Crystal prohibits uppercase names for methods 13 | 14 | module Mal 15 | extend self 16 | 17 | def func_of(env, binds, body) 18 | ->(args : Array(Mal::Type)) { 19 | new_env = Mal::Env.new(env, binds, args) 20 | eval(body, new_env) 21 | }.as(Mal::Func) 22 | end 23 | 24 | def eval_ast(ast, env) 25 | return ast.map { |n| eval(n, env).as(Mal::Type) } if ast.is_a? Mal::List 26 | 27 | val = ast.unwrap 28 | 29 | Mal::Type.new case val 30 | when Mal::Symbol 31 | if e = env.get(val.str) 32 | e 33 | else 34 | eval_error "'#{val.str}' not found" 35 | end 36 | when Mal::List 37 | val.each_with_object(Mal::List.new) { |n, l| l << eval(n, env) } 38 | when Mal::Vector 39 | val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } 40 | when Array(Mal::Type) 41 | val.map { |n| eval(n, env).as(Mal::Type) } 42 | when Mal::HashMap 43 | val.each { |k, v| val[k] = eval(v, env) } 44 | val 45 | else 46 | val 47 | end 48 | end 49 | 50 | def read(str) 51 | read_str str 52 | end 53 | 54 | def starts_with(list, symbol) 55 | if list.size == 2 56 | head = list.first.unwrap 57 | head.is_a? Mal::Symbol && head.str == symbol 58 | end 59 | end 60 | 61 | def quasiquote_elts(list) 62 | acc = Mal::Type.new(Mal::List.new) 63 | list.reverse.each do |elt| 64 | elt_val = elt.unwrap 65 | if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote") 66 | acc = Mal::Type.new( 67 | Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc 68 | ) 69 | else 70 | acc = Mal::Type.new( 71 | Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc 72 | ) 73 | end 74 | end 75 | acc 76 | end 77 | 78 | def quasiquote(ast) 79 | ast_val = ast.unwrap 80 | case ast_val 81 | when Mal::List 82 | if starts_with(ast_val,"unquote") 83 | ast_val[1] 84 | else 85 | quasiquote_elts(ast_val) 86 | end 87 | when Mal::Vector 88 | Mal::Type.new( 89 | Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val) 90 | ) 91 | when Mal::HashMap, Mal::Symbol 92 | Mal::Type.new ( 93 | Mal::List.new << gen_type(Mal::Symbol, "quote") << ast 94 | ) 95 | else 96 | ast 97 | end 98 | end 99 | 100 | def macro_call?(ast, env) 101 | list = ast.unwrap 102 | return false unless list.is_a? Mal::List 103 | return false if list.empty? 104 | 105 | sym = list.first.unwrap 106 | return false unless sym.is_a? Mal::Symbol 107 | 108 | func = env.find(sym.str).try(&.data[sym.str]) 109 | return false unless func && func.macro? 110 | 111 | true 112 | end 113 | 114 | def macroexpand(ast, env) 115 | while macro_call?(ast, env) 116 | # Already checked in macro_call? 117 | list = ast.unwrap.as(Mal::List) 118 | func_sym = list[0].unwrap.as(Mal::Symbol) 119 | func = env.get(func_sym.str).unwrap 120 | 121 | case func 122 | when Mal::Func 123 | ast = func.call(list[1..-1]) 124 | when Mal::Closure 125 | ast = func.fn.call(list[1..-1]) 126 | else 127 | eval_error "macro '#{func_sym.str}' must be function: #{ast}" 128 | end 129 | end 130 | 131 | ast 132 | end 133 | 134 | macro invoke_list(l, env) 135 | f = eval({{l}}.first, {{env}}).unwrap 136 | args = eval_ast({{l}}[1..-1].to_mal, {{env}}) 137 | case f 138 | when Mal::Closure 139 | ast = f.ast 140 | {{env}} = Mal::Env.new(f.env, f.params, args) 141 | next # TCO 142 | when Mal::Func 143 | return f.call args 144 | else 145 | eval_error "expected function as the first argument: #{f}" 146 | end 147 | end 148 | 149 | def eval(ast, env) 150 | # 'next' in 'do...end' has a bug in crystal 0.7.1 151 | # https://github.com/manastech/crystal/issues/659 152 | while true 153 | list = ast.unwrap 154 | 155 | return eval_ast(ast, env) unless list.is_a? Mal::List 156 | return ast if list.empty? 157 | 158 | ast = macroexpand(ast, env) 159 | 160 | list = ast.unwrap 161 | 162 | return eval_ast(ast, env) unless list.is_a? Mal::List 163 | return ast if list.empty? 164 | 165 | head = list.first.unwrap 166 | 167 | return invoke_list(list, env) unless head.is_a? Mal::Symbol 168 | 169 | return Mal::Type.new case head.str 170 | when "def!" 171 | eval_error "wrong number of argument for 'def!'" unless list.size == 3 172 | a1 = list[1].unwrap 173 | eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol 174 | env.set(a1.str, eval(list[2], env)) 175 | when "let*" 176 | eval_error "wrong number of argument for 'def!'" unless list.size == 3 177 | 178 | bindings = list[1].unwrap 179 | eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array 180 | eval_error "size of binding list must be even" unless bindings.size.even? 181 | 182 | new_env = Mal::Env.new env 183 | bindings.each_slice(2) do |binding| 184 | key, value = binding 185 | name = key.unwrap 186 | eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol 187 | new_env.set(name.str, eval(value, new_env)) 188 | end 189 | 190 | ast, env = list[2], new_env 191 | next # TCO 192 | when "do" 193 | if list.empty? 194 | ast = Mal::Type.new nil 195 | next 196 | end 197 | 198 | eval_ast(list[1..-2].to_mal, env) 199 | ast = list.last 200 | next # TCO 201 | when "if" 202 | ast = unless eval(list[1], env).unwrap 203 | list.size >= 4 ? list[3] : Mal::Type.new(nil) 204 | else 205 | list[2] 206 | end 207 | next # TCO 208 | when "fn*" 209 | params = list[1].unwrap 210 | unless params.is_a? Array 211 | eval_error "'fn*' parameters must be list or vector: #{params}" 212 | end 213 | Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) 214 | when "quote" 215 | list[1] 216 | when "quasiquoteexpand" 217 | quasiquote list[1] 218 | when "quasiquote" 219 | ast = quasiquote list[1] 220 | next # TCO 221 | when "defmacro!" 222 | eval_error "wrong number of argument for 'defmacro!'" unless list.size == 3 223 | a1 = list[1].unwrap 224 | eval_error "1st argument of 'defmacro!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol 225 | env.set(a1.str, eval(list[2], env).tap { |n| n.is_macro = true }) 226 | when "macroexpand" 227 | macroexpand(list[1], env) 228 | when "try*" 229 | catch_list = list.size >= 3 ? list[2].unwrap : Mal::Type.new(nil) 230 | return eval(list[1], env) unless catch_list.is_a? Mal::List 231 | 232 | catch_head = catch_list.first.unwrap 233 | return eval(list[1], env) unless catch_head.is_a? Mal::Symbol 234 | return eval(list[1], env) unless catch_head.str == "catch*" 235 | 236 | begin 237 | eval(list[1], env) 238 | rescue e : Mal::RuntimeException 239 | new_env = Mal::Env.new(env, [catch_list[1]], [e.thrown]) 240 | eval(catch_list[2], new_env) 241 | rescue e 242 | new_env = Mal::Env.new(env, [catch_list[1]], [Mal::Type.new e.message]) 243 | eval(catch_list[2], new_env) 244 | end 245 | else 246 | invoke_list(list, env) 247 | end 248 | end 249 | end 250 | 251 | def print(result) 252 | pr_str(result, true) 253 | end 254 | 255 | def rep(str) 256 | print(eval(read(str), REPL_ENV)) 257 | end 258 | end 259 | 260 | REPL_ENV = Mal::Env.new nil 261 | Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } 262 | REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0], REPL_ENV) }) 263 | Mal.rep "(def! not (fn* (a) (if a false true)))" 264 | Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" 265 | Mal.rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" 266 | 267 | argv = Mal::List.new 268 | REPL_ENV.set("*ARGV*", Mal::Type.new argv) 269 | 270 | unless ARGV.empty? 271 | if ARGV.size > 1 272 | ARGV[1..-1].each do |a| 273 | argv << Mal::Type.new(a) 274 | end 275 | end 276 | 277 | begin 278 | Mal.rep "(load-file \"#{ARGV[0]}\")" 279 | rescue e 280 | STDERR.puts e 281 | end 282 | exit 283 | end 284 | 285 | while line = Readline.readline("user> ", true) 286 | begin 287 | puts Mal.rep(line) 288 | rescue e : Mal::RuntimeException 289 | STDERR.puts "Error: #{pr_str(e.thrown, true)}" 290 | rescue e 291 | STDERR.puts "Error: #{e}" 292 | end 293 | end 294 | -------------------------------------------------------------------------------- /stepA_mal.cr: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env crystal run 2 | 3 | require "colorize" 4 | 5 | require "readline" 6 | require "./peg_reader_mal" 7 | require "./printer" 8 | require "./types" 9 | require "./env" 10 | require "./core" 11 | require "./error" 12 | 13 | # Note: 14 | # Employed downcase names because Crystal prohibits uppercase names for methods 15 | 16 | module Mal 17 | extend self 18 | 19 | def func_of(env, binds, body) 20 | ->(args : Array(Mal::Type)) { 21 | new_env = Mal::Env.new(env, binds, args) 22 | eval(body, new_env) 23 | }.as(Mal::Func) 24 | end 25 | 26 | def eval_ast(ast, env) 27 | return ast.map { |n| eval(n, env).as(Mal::Type) } if ast.is_a? Array 28 | 29 | val = ast.unwrap 30 | 31 | Mal::Type.new case val 32 | when Mal::Symbol 33 | if e = env.get(val.str) 34 | e 35 | else 36 | eval_error "'#{val.str}' not found" 37 | end 38 | when Mal::List 39 | val.each_with_object(Mal::List.new) { |n, l| l << eval(n, env) } 40 | when Mal::Vector 41 | val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } 42 | when Mal::HashMap 43 | new_map = Mal::HashMap.new 44 | val.each { |k, v| new_map[k] = eval(v, env) } 45 | new_map 46 | else 47 | val 48 | end 49 | end 50 | 51 | def read(str) 52 | read_str str 53 | end 54 | 55 | def starts_with(list, symbol) 56 | if list.size == 2 57 | head = list.first.unwrap 58 | head.is_a? Mal::Symbol && head.str == symbol 59 | end 60 | end 61 | 62 | def quasiquote_elts(list) 63 | acc = Mal::Type.new(Mal::List.new) 64 | list.reverse.each do |elt| 65 | elt_val = elt.unwrap 66 | if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote") 67 | acc = Mal::Type.new( 68 | Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc 69 | ) 70 | else 71 | acc = Mal::Type.new( 72 | Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc 73 | ) 74 | end 75 | end 76 | acc 77 | end 78 | 79 | def quasiquote(ast) 80 | ast_val = ast.unwrap 81 | case ast_val 82 | when Mal::List 83 | if starts_with(ast_val,"unquote") 84 | ast_val[1] 85 | else 86 | quasiquote_elts(ast_val) 87 | end 88 | when Mal::Vector 89 | Mal::Type.new( 90 | Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val) 91 | ) 92 | when Mal::HashMap, Mal::Symbol 93 | Mal::Type.new ( 94 | Mal::List.new << gen_type(Mal::Symbol, "quote") << ast 95 | ) 96 | else 97 | ast 98 | end 99 | end 100 | 101 | def macro_call?(ast, env) 102 | list = ast.unwrap 103 | return false unless list.is_a? Mal::List 104 | return false if list.empty? 105 | 106 | sym = list.first.unwrap 107 | return false unless sym.is_a? Mal::Symbol 108 | 109 | func = env.find(sym.str).try(&.data[sym.str]) 110 | return false unless func && func.macro? 111 | 112 | true 113 | end 114 | 115 | def macroexpand(ast, env) 116 | while macro_call?(ast, env) 117 | # Already checked in macro_call? 118 | list = ast.unwrap.as(Mal::List) 119 | func_sym = list[0].unwrap.as(Mal::Symbol) 120 | func = env.get(func_sym.str).unwrap 121 | 122 | case func 123 | when Mal::Func 124 | ast = func.call(list[1..-1]) 125 | when Mal::Closure 126 | ast = func.fn.call(list[1..-1]) 127 | else 128 | eval_error "macro '#{func_sym.str}' must be function: #{ast}" 129 | end 130 | end 131 | 132 | ast 133 | end 134 | 135 | macro invoke_list(l, env) 136 | f = eval({{l}}.first, {{env}}).unwrap 137 | args = eval_ast({{l}}[1..-1], {{env}}).as(Array) 138 | 139 | case f 140 | when Mal::Closure 141 | ast = f.ast 142 | {{env}} = Mal::Env.new(f.env, f.params, args) 143 | next # TCO 144 | when Mal::Func 145 | return f.call args 146 | else 147 | eval_error "expected function as the first argument: #{f}" 148 | end 149 | end 150 | 151 | def debug(ast) 152 | puts print(ast).colorize.red 153 | end 154 | 155 | def eval(ast, env) 156 | # 'next' in 'do...end' has a bug in crystal 0.7.1 157 | # https://github.com/manastech/crystal/issues/659 158 | while true 159 | list = ast.unwrap 160 | 161 | return eval_ast(ast, env) unless list.is_a? Mal::List 162 | return ast if list.empty? 163 | 164 | ast = macroexpand(ast, env) 165 | 166 | list = ast.unwrap 167 | 168 | return eval_ast(ast, env) unless list.is_a? Mal::List 169 | return ast if list.empty? 170 | 171 | head = list.first.unwrap 172 | 173 | return invoke_list(list, env) unless head.is_a? Mal::Symbol 174 | 175 | return Mal::Type.new case head.str 176 | when "def!" 177 | eval_error "wrong number of argument for 'def!'" unless list.size == 3 178 | a1 = list[1].unwrap 179 | eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol 180 | env.set(a1.str, eval(list[2], env)) 181 | when "let*" 182 | eval_error "wrong number of argument for 'def!'" unless list.size == 3 183 | 184 | bindings = list[1].unwrap 185 | eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array 186 | eval_error "size of binding list must be even" unless bindings.size.even? 187 | 188 | new_env = Mal::Env.new env 189 | bindings.each_slice(2) do |binding| 190 | key, value = binding 191 | name = key.unwrap 192 | eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol 193 | new_env.set(name.str, eval(value, new_env)) 194 | end 195 | 196 | ast, env = list[2], new_env 197 | next # TCO 198 | when "do" 199 | if list.empty? 200 | ast = Mal::Type.new nil 201 | next 202 | end 203 | 204 | eval_ast(list[1..-2].to_mal, env) 205 | ast = list.last 206 | next # TCO 207 | when "if" 208 | ast = unless eval(list[1], env).unwrap 209 | list.size >= 4 ? list[3] : Mal::Type.new(nil) 210 | else 211 | list[2] 212 | end 213 | next # TCO 214 | when "fn*" 215 | params = list[1].unwrap 216 | unless params.is_a? Array 217 | eval_error "'fn*' parameters must be list or vector: #{params}" 218 | end 219 | Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) 220 | when "quote" 221 | list[1] 222 | when "quasiquoteexpand" 223 | quasiquote list[1] 224 | when "quasiquote" 225 | ast = quasiquote list[1] 226 | next # TCO 227 | when "defmacro!" 228 | eval_error "wrong number of argument for 'defmacro!'" unless list.size == 3 229 | a1 = list[1].unwrap 230 | eval_error "1st argument of 'defmacro!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol 231 | env.set(a1.str, eval(list[2], env).tap { |n| n.is_macro = true }) 232 | when "macroexpand" 233 | macroexpand(list[1], env) 234 | when "try*" 235 | catch_list = list.size >= 3 ? list[2].unwrap : Mal::Type.new(nil) 236 | return eval(list[1], env) unless catch_list.is_a? Mal::List 237 | 238 | catch_head = catch_list.first.unwrap 239 | return eval(list[1], env) unless catch_head.is_a? Mal::Symbol 240 | return eval(list[1], env) unless catch_head.str == "catch*" 241 | 242 | begin 243 | eval(list[1], env) 244 | rescue e : Mal::RuntimeException 245 | new_env = Mal::Env.new(env, [catch_list[1]], [e.thrown]) 246 | eval(catch_list[2], new_env) 247 | rescue e 248 | new_env = Mal::Env.new(env, [catch_list[1]], [Mal::Type.new e.message]) 249 | eval(catch_list[2], new_env) 250 | end 251 | else 252 | invoke_list(list, env) 253 | end 254 | end 255 | end 256 | 257 | def print(result) 258 | pr_str(result, true) 259 | end 260 | 261 | def rep(str) 262 | print(eval(read(str), REPL_ENV)) 263 | end 264 | end 265 | 266 | REPL_ENV = Mal::Env.new nil 267 | Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } 268 | REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0], REPL_ENV) }) 269 | Mal.rep "(def! not (fn* (a) (if a false true)))" 270 | Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" 271 | Mal.rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" 272 | Mal.rep("(def! *host-language* \"crystal\")") 273 | 274 | argv = Mal::List.new 275 | REPL_ENV.set("*ARGV*", Mal::Type.new argv) 276 | 277 | unless ARGV.empty? 278 | if ARGV.size > 1 279 | ARGV[1..-1].each do |a| 280 | argv << Mal::Type.new(a) 281 | end 282 | end 283 | 284 | begin 285 | Mal.rep "(load-file \"#{ARGV[0]}\")" 286 | rescue e 287 | STDERR.puts e 288 | end 289 | exit 290 | end 291 | 292 | Mal.rep("(println (str \"Mal [\" *host-language* \"]\"))") 293 | 294 | while line = Readline.readline("user> ", true) 295 | begin 296 | puts Mal.rep(line) 297 | rescue e : Mal::RuntimeException 298 | STDERR.puts "Error: #{pr_str(e.thrown, true)}" 299 | rescue e 300 | STDERR.puts "Error: #{e}" 301 | end 302 | end 303 | -------------------------------------------------------------------------------- /runtest.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | 3 | from __future__ import print_function 4 | import os, sys, re 5 | import argparse, time 6 | import signal, atexit 7 | 8 | from subprocess import Popen, STDOUT, PIPE 9 | from select import select 10 | 11 | # Pseudo-TTY and terminal manipulation 12 | import pty, array, fcntl, termios 13 | 14 | IS_PY_3 = sys.version_info[0] == 3 15 | 16 | debug_file = None 17 | log_file = None 18 | 19 | def debug(data): 20 | if debug_file: 21 | debug_file.write(data) 22 | debug_file.flush() 23 | 24 | def log(data, end='\n'): 25 | if log_file: 26 | log_file.write(data + end) 27 | log_file.flush() 28 | print(data, end=end) 29 | sys.stdout.flush() 30 | 31 | sep = "\n" 32 | rundir = None 33 | 34 | parser = argparse.ArgumentParser( 35 | description="Run a test file against a Mal implementation") 36 | parser.add_argument('--rundir', 37 | help="change to the directory before running tests") 38 | parser.add_argument('--start-timeout', default=10, type=int, 39 | help="default timeout for initial prompt") 40 | parser.add_argument('--test-timeout', default=20, type=int, 41 | help="default timeout for each individual test action") 42 | parser.add_argument('--pre-eval', default=None, type=str, 43 | help="Mal code to evaluate prior to running the test") 44 | parser.add_argument('--no-pty', action='store_true', 45 | help="Use direct pipes instead of pseudo-tty") 46 | parser.add_argument('--log-file', type=str, 47 | help="Write messages to the named file in addition the screen") 48 | parser.add_argument('--debug-file', type=str, 49 | help="Write all test interaction the named file") 50 | parser.add_argument('--hard', action='store_true', 51 | help="Turn soft tests (soft, deferrable, optional) into hard failures") 52 | 53 | # Control whether deferrable and optional tests are executed 54 | parser.add_argument('--deferrable', dest='deferrable', action='store_true', 55 | help="Enable deferrable tests that follow a ';>>> deferrable=True'") 56 | parser.add_argument('--no-deferrable', dest='deferrable', action='store_false', 57 | help="Disable deferrable tests that follow a ';>>> deferrable=True'") 58 | parser.set_defaults(deferrable=True) 59 | parser.add_argument('--optional', dest='optional', action='store_true', 60 | help="Enable optional tests that follow a ';>>> optional=True'") 61 | parser.add_argument('--no-optional', dest='optional', action='store_false', 62 | help="Disable optional tests that follow a ';>>> optional=True'") 63 | parser.set_defaults(optional=True) 64 | 65 | parser.add_argument('test_file', type=str, 66 | help="a test file formatted as with mal test data") 67 | parser.add_argument('mal_cmd', nargs="*", 68 | help="Mal implementation command line. Use '--' to " 69 | "specify a Mal command line with dashed options.") 70 | parser.add_argument('--crlf', dest='crlf', action='store_true', 71 | help="Write \\r\\n instead of \\n to the input") 72 | 73 | class Runner(): 74 | def __init__(self, args, no_pty=False, line_break="\n"): 75 | #print "args: %s" % repr(args) 76 | self.no_pty = no_pty 77 | 78 | # Cleanup child process on exit 79 | atexit.register(self.cleanup) 80 | 81 | self.p = None 82 | env = os.environ 83 | env['TERM'] = 'dumb' 84 | env['INPUTRC'] = '/dev/null' 85 | env['PERL_RL'] = 'false' 86 | if no_pty: 87 | self.p = Popen(args, bufsize=0, 88 | stdin=PIPE, stdout=PIPE, stderr=STDOUT, 89 | preexec_fn=os.setsid, 90 | env=env) 91 | self.stdin = self.p.stdin 92 | self.stdout = self.p.stdout 93 | else: 94 | # provide tty to get 'interactive' readline to work 95 | master, slave = pty.openpty() 96 | 97 | # Set terminal size large so that readline will not send 98 | # ANSI/VT escape codes when the lines are long. 99 | buf = array.array('h', [100, 200, 0, 0]) 100 | fcntl.ioctl(master, termios.TIOCSWINSZ, buf, True) 101 | 102 | self.p = Popen(args, bufsize=0, 103 | stdin=slave, stdout=slave, stderr=STDOUT, 104 | preexec_fn=os.setsid, 105 | env=env) 106 | # Now close slave so that we will get an exception from 107 | # read when the child exits early 108 | # http://stackoverflow.com/questions/11165521 109 | os.close(slave) 110 | self.stdin = os.fdopen(master, 'r+b', 0) 111 | self.stdout = self.stdin 112 | 113 | #print "started" 114 | self.buf = "" 115 | self.last_prompt = "" 116 | 117 | self.line_break = line_break 118 | 119 | def read_to_prompt(self, prompts, timeout): 120 | end_time = time.time() + timeout 121 | while time.time() < end_time: 122 | [outs,_,_] = select([self.stdout], [], [], 1) 123 | if self.stdout in outs: 124 | new_data = self.stdout.read(1) 125 | new_data = new_data.decode("utf-8") if IS_PY_3 else new_data 126 | #print("new_data: '%s'" % new_data) 127 | debug(new_data) 128 | # Perform newline cleanup 129 | self.buf += new_data.replace("\r", "") 130 | for prompt in prompts: 131 | regexp = re.compile(prompt) 132 | match = regexp.search(self.buf) 133 | if match: 134 | end = match.end() 135 | buf = self.buf[0:match.start()] 136 | self.buf = self.buf[end:] 137 | self.last_prompt = prompt 138 | return buf 139 | return None 140 | 141 | def writeline(self, str): 142 | def _to_bytes(s): 143 | return bytes(s, "utf-8") if IS_PY_3 else s 144 | 145 | self.stdin.write(_to_bytes(str.replace('\r', '\x16\r') + self.line_break)) 146 | 147 | def cleanup(self): 148 | #print "cleaning up" 149 | if self.p: 150 | try: 151 | os.killpg(self.p.pid, signal.SIGTERM) 152 | except OSError: 153 | pass 154 | self.p = None 155 | 156 | class TestReader: 157 | def __init__(self, test_file): 158 | self.line_num = 0 159 | f = open(test_file, newline='') if IS_PY_3 else open(test_file) 160 | self.data = f.read().split('\n') 161 | self.soft = False 162 | self.deferrable = False 163 | self.optional = False 164 | 165 | def next(self): 166 | self.msg = None 167 | self.form = None 168 | self.out = "" 169 | self.ret = None 170 | 171 | while self.data: 172 | self.line_num += 1 173 | line = self.data.pop(0) 174 | if re.match(r"^\s*$", line): # blank line 175 | continue 176 | elif line[0:3] == ";;;": # ignore comment 177 | continue 178 | elif line[0:2] == ";;": # output comment 179 | self.msg = line[3:] 180 | return True 181 | elif line[0:5] == ";>>> ": # settings/commands 182 | settings = {} 183 | exec(line[5:], {}, settings) 184 | if 'soft' in settings: 185 | self.soft = settings['soft'] 186 | if 'deferrable' in settings and settings['deferrable']: 187 | self.deferrable = "\nSkipping deferrable and optional tests" 188 | return True 189 | if 'optional' in settings and settings['optional']: 190 | self.optional = "\nSkipping optional tests" 191 | return True 192 | continue 193 | elif line[0:1] == ";": # unexpected comment 194 | raise Exception("Test data error at line %d:\n%s" % (self.line_num, line)) 195 | self.form = line # the line is a form to send 196 | 197 | # Now find the output and return value 198 | while self.data: 199 | line = self.data[0] 200 | if line[0:3] == ";=>": 201 | self.ret = line[3:] 202 | self.line_num += 1 203 | self.data.pop(0) 204 | break 205 | elif line[0:2] == ";/": 206 | self.out = self.out + line[2:] + sep 207 | self.line_num += 1 208 | self.data.pop(0) 209 | else: 210 | self.ret = "" 211 | break 212 | if self.ret != None: break 213 | 214 | if self.out[-1:] == sep and not self.ret: 215 | # If there is no return value, output should not end in 216 | # separator 217 | self.out = self.out[0:-1] 218 | return self.form 219 | 220 | args = parser.parse_args(sys.argv[1:]) 221 | # Workaround argparse issue with two '--' on command line 222 | if sys.argv.count('--') > 0: 223 | args.mal_cmd = sys.argv[sys.argv.index('--')+1:] 224 | 225 | if args.rundir: os.chdir(args.rundir) 226 | 227 | if args.log_file: log_file = open(args.log_file, "a") 228 | if args.debug_file: debug_file = open(args.debug_file, "a") 229 | 230 | print(args.mal_cmd) 231 | r = Runner(args.mal_cmd, no_pty=args.no_pty, line_break="\r\n" if args.crlf else "\n") 232 | t = TestReader(args.test_file) 233 | 234 | 235 | def assert_prompt(runner, prompts, timeout): 236 | # Wait for the initial prompt 237 | header = runner.read_to_prompt(prompts, timeout=timeout) 238 | if not header == None: 239 | if header: 240 | log("Started with:\n%s" % header) 241 | else: 242 | log("Did not receive one of following prompt(s): %s" % repr(prompts)) 243 | log(" Got : %s" % repr(r.buf)) 244 | sys.exit(1) 245 | 246 | 247 | # Wait for the initial prompt 248 | try: 249 | assert_prompt(r, ['[^\s()<>]+> '], args.start_timeout) 250 | except: 251 | _, exc, _ = sys.exc_info() 252 | log("\nException: %s" % repr(exc)) 253 | log("Output before exception:\n%s" % r.buf) 254 | sys.exit(1) 255 | 256 | # Send the pre-eval code if any 257 | if args.pre_eval: 258 | sys.stdout.write("RUNNING pre-eval: %s" % args.pre_eval) 259 | r.writeline(args.pre_eval) 260 | assert_prompt(r, ['[^\s()<>]+> '], args.test_timeout) 261 | 262 | test_cnt = 0 263 | pass_cnt = 0 264 | fail_cnt = 0 265 | soft_fail_cnt = 0 266 | failures = [] 267 | 268 | class TestTimeout(Exception): 269 | pass 270 | 271 | while t.next(): 272 | if args.deferrable == False and t.deferrable: 273 | log(t.deferrable) 274 | break 275 | 276 | if args.optional == False and t.optional: 277 | log(t.optional) 278 | break 279 | 280 | if t.msg != None: 281 | log(t.msg) 282 | continue 283 | 284 | if t.form == None: continue 285 | 286 | log("TEST: %s -> [%s,%s]" % (repr(t.form), repr(t.out), t.ret), end='') 287 | 288 | # The repeated form is to get around an occasional OS X issue 289 | # where the form is repeated. 290 | # https://github.com/kanaka/mal/issues/30 291 | expects = [".*%s%s%s" % (sep, t.out, re.escape(t.ret)), 292 | ".*%s.*%s%s%s" % (sep, sep, t.out, re.escape(t.ret))] 293 | 294 | r.writeline(t.form) 295 | try: 296 | test_cnt += 1 297 | res = r.read_to_prompt(['\r\n[^\s()<>]+> ', '\n[^\s()<>]+> '], 298 | timeout=args.test_timeout) 299 | #print "%s,%s,%s" % (idx, repr(p.before), repr(p.after)) 300 | if (res == None): 301 | log(" -> TIMEOUT (line %d)" % t.line_num) 302 | raise TestTimeout("TIMEOUT (line %d)" % t.line_num) 303 | elif (t.ret == "" and t.out == ""): 304 | log(" -> SUCCESS (result ignored)") 305 | pass_cnt += 1 306 | elif (re.search(expects[0], res, re.S) or 307 | re.search(expects[1], res, re.S)): 308 | log(" -> SUCCESS") 309 | pass_cnt += 1 310 | else: 311 | if t.soft and not args.hard: 312 | log(" -> SOFT FAIL (line %d):" % t.line_num) 313 | soft_fail_cnt += 1 314 | fail_type = "SOFT " 315 | else: 316 | log(" -> FAIL (line %d):" % t.line_num) 317 | fail_cnt += 1 318 | fail_type = "" 319 | log(" Expected : %s" % repr(expects[0])) 320 | log(" Got : %s" % repr(res)) 321 | failed_test = """%sFAILED TEST (line %d): %s -> [%s,%s]: 322 | Expected : %s 323 | Got : %s""" % (fail_type, t.line_num, t.form, repr(t.out), 324 | t.ret, repr(expects[0]), repr(res)) 325 | failures.append(failed_test) 326 | except: 327 | _, exc, _ = sys.exc_info() 328 | log("\nException: %s" % repr(exc)) 329 | log("Output before exception:\n%s" % r.buf) 330 | sys.exit(1) 331 | 332 | if len(failures) > 0: 333 | log("\nFAILURES:") 334 | for f in failures: 335 | log(f) 336 | 337 | results = """ 338 | TEST RESULTS (for %s): 339 | %3d: soft failing tests 340 | %3d: failing tests 341 | %3d: passing tests 342 | %3d: total tests 343 | """ % (args.test_file, soft_fail_cnt, fail_cnt, 344 | pass_cnt, test_cnt) 345 | log(results) 346 | 347 | debug("\n") # add some separate to debug log 348 | 349 | if fail_cnt > 0: 350 | sys.exit(1) 351 | sys.exit(0) 352 | -------------------------------------------------------------------------------- /core.cr: -------------------------------------------------------------------------------- 1 | require "time" 2 | 3 | require "readline" 4 | require "./types" 5 | require "./error" 6 | require "./printer" 7 | require "./peg_reader_mal" 8 | 9 | module Mal 10 | macro calc_op(op) 11 | -> (args : Array(Mal::Type)) { 12 | x, y = args[0].unwrap, args[1].unwrap 13 | eval_error "invalid arguments for binary operator {{op.id}}" unless x.is_a?(Int64) && y.is_a?(Int64) 14 | Mal::Type.new(x {{op.id}} y) 15 | } 16 | end 17 | 18 | def self.list(args) 19 | args.to_mal 20 | end 21 | 22 | def self.list?(args) 23 | args.first.unwrap.is_a? Mal::List 24 | end 25 | 26 | def self.empty?(args) 27 | a = args.first.unwrap 28 | a.is_a?(Array) ? a.empty? : false 29 | end 30 | 31 | def self.count(args) 32 | a = args.first.unwrap 33 | case a 34 | when Array 35 | a.size.to_i64 36 | when Nil 37 | 0i64 38 | else 39 | eval_error "invalid argument for function 'count'" 40 | end 41 | end 42 | 43 | def self.pr_str_(args) 44 | args.map { |a| pr_str(a) }.join(" ") 45 | end 46 | 47 | def self.str(args) 48 | args.map { |a| pr_str(a, false) }.join 49 | end 50 | 51 | def self.prn(args) 52 | puts self.pr_str_(args) 53 | nil 54 | end 55 | 56 | def self.println(args) 57 | puts args.map { |a| pr_str(a, false) }.join(" ") 58 | nil 59 | end 60 | 61 | def self.read_string(args) 62 | head = args.first.unwrap 63 | eval_error "argument of read-str must be string" unless head.is_a? String 64 | read_str head 65 | end 66 | 67 | def self.slurp(args) 68 | head = args.first.unwrap 69 | eval_error "argument of slurp must be string" unless head.is_a? String 70 | begin 71 | File.read head 72 | rescue e : IO::Error 73 | eval_error "no such file" 74 | end 75 | end 76 | 77 | def self.cons(args) 78 | head, tail = args[0].as(Mal::Type), args[1].unwrap 79 | eval_error "2nd arg of cons must be list" unless tail.is_a? Array 80 | ([head] + tail).to_mal 81 | end 82 | 83 | def self.concat(args) 84 | args.each_with_object(Mal::List.new) do |arg, list| 85 | a = arg.unwrap 86 | eval_error "arguments of concat must be list" unless a.is_a?(Array) 87 | a.each { |e| list << e } 88 | end 89 | end 90 | 91 | def self.vec(args) 92 | arg = args.first.unwrap 93 | arg.is_a? Array || eval_error "argument of vec must be a sequence" 94 | arg.to_mal(Mal::Vector) 95 | end 96 | 97 | def self.nth(args) 98 | a0, a1 = args[0].unwrap, args[1].unwrap 99 | eval_error "1st argument of nth must be list or vector" unless a0.is_a? Array 100 | eval_error "2nd argument of nth must be integer" unless a1.is_a? Int64 101 | a0[a1] 102 | end 103 | 104 | def self.first(args) 105 | a0 = args[0].unwrap 106 | 107 | return nil if a0.nil? 108 | eval_error "1st argument of first must be list or vector or nil" unless a0.is_a? Array 109 | a0.empty? ? nil : a0.first 110 | end 111 | 112 | def self.rest(args) 113 | a0 = args[0].unwrap 114 | 115 | return Mal::List.new if a0.nil? 116 | eval_error "1st argument of first must be list or vector or nil" unless a0.is_a? Array 117 | return Mal::List.new if a0.empty? 118 | a0[1..-1].to_mal 119 | end 120 | 121 | def self.apply(args) 122 | eval_error "apply must take at least 2 arguments" unless args.size >= 2 123 | 124 | head = args.first.unwrap 125 | last = args.last.unwrap 126 | 127 | eval_error "last argument of apply must be list or vector" unless last.is_a? Array 128 | 129 | case head 130 | when Mal::Closure 131 | head.fn.call(args[1..-2] + last) 132 | when Mal::Func 133 | head.call(args[1..-2] + last) 134 | else 135 | eval_error "1st argument of apply must be function or closure" 136 | end 137 | end 138 | 139 | def self.map(args) 140 | func = args.first.unwrap 141 | list = args[1].unwrap 142 | 143 | eval_error "2nd argument of map must be list or vector" unless list.is_a? Array 144 | 145 | f = case func 146 | when Mal::Closure then func.fn 147 | when Mal::Func then func 148 | else eval_error "1st argument of map must be function" 149 | end 150 | 151 | list.each_with_object(Mal::List.new) do |elem, mapped| 152 | mapped << f.call([elem]) 153 | end 154 | end 155 | 156 | def self.nil_value?(args) 157 | args.first.unwrap.nil? 158 | end 159 | 160 | def self.true?(args) 161 | a = args.first.unwrap 162 | a.is_a?(Bool) && a 163 | end 164 | 165 | def self.false?(args) 166 | a = args.first.unwrap 167 | a.is_a?(Bool) && !a 168 | end 169 | 170 | def self.symbol?(args) 171 | args.first.unwrap.is_a?(Mal::Symbol) 172 | end 173 | 174 | def self.symbol(args) 175 | head = args.first.unwrap 176 | eval_error "1st argument of symbol function must be string" unless head.is_a? String 177 | Mal::Symbol.new head 178 | end 179 | 180 | def self.string?(args) 181 | head = args.first.unwrap 182 | head.is_a?(String) && (head.empty? || head[0] != '\u029e') 183 | end 184 | 185 | def self.keyword(args) 186 | head = args.first.unwrap 187 | eval_error "1st argument of symbol function must be string" unless head.is_a? String 188 | "\u029e" + head 189 | end 190 | 191 | def self.keyword?(args) 192 | head = args.first.unwrap 193 | head.is_a?(String) && !head.empty? && head[0] == '\u029e' 194 | end 195 | 196 | def self.number?(args) 197 | args.first.unwrap.is_a?(Float64 | Int64) 198 | end 199 | 200 | def self.fn?(args) 201 | return false if args.first.macro? 202 | head = args.first.unwrap 203 | head.is_a?(Mal::Func) || head.is_a?(Mal::Closure) 204 | end 205 | 206 | def self.macro?(args) 207 | args.first.macro? 208 | end 209 | 210 | def self.vector(args) 211 | args.to_mal(Mal::Vector) 212 | end 213 | 214 | def self.vector?(args) 215 | args.first.unwrap.is_a? Mal::Vector 216 | end 217 | 218 | def self.hash_map(args) 219 | eval_error "hash-map must take even number of arguments" unless args.size.even? 220 | map = Mal::HashMap.new 221 | args.each_slice(2) do |kv| 222 | k = kv[0].unwrap 223 | eval_error "key must be string" unless k.is_a? String 224 | map[k] = kv[1] 225 | end 226 | map 227 | end 228 | 229 | def self.map?(args) 230 | args.first.unwrap.is_a? Mal::HashMap 231 | end 232 | 233 | def self.assoc(args) 234 | head = args.first.unwrap 235 | eval_error "1st argument of assoc must be hashmap" unless head.is_a? Mal::HashMap 236 | eval_error "assoc must take a list and even number of arguments" unless (args.size - 1).even? 237 | 238 | map = Mal::HashMap.new 239 | head.each { |k, v| map[k] = v } 240 | 241 | args[1..-1].each_slice(2) do |kv| 242 | k = kv[0].unwrap 243 | eval_error "key must be string" unless k.is_a? String 244 | map[k] = kv[1] 245 | end 246 | 247 | map 248 | end 249 | 250 | def self.dissoc(args) 251 | head = args.first.unwrap 252 | eval_error "1st argument of assoc must be hashmap" unless head.is_a? Mal::HashMap 253 | 254 | map = Mal::HashMap.new 255 | head.each { |k, v| map[k] = v } 256 | 257 | args[1..-1].each do |arg| 258 | key = arg.unwrap 259 | eval_error "key must be string" unless key.is_a? String 260 | map.delete key 261 | end 262 | 263 | map 264 | end 265 | 266 | def self.get(args) 267 | a0, a1 = args[0].unwrap, args[1].unwrap 268 | return nil unless a0.is_a? Mal::HashMap 269 | eval_error "2nd argument of get must be string" unless a1.is_a? String 270 | 271 | # a0[a1]? isn't available because type ofa0[a1] is infered NoReturn 272 | a0.has_key?(a1) ? a0[a1] : nil 273 | end 274 | 275 | def self.contains?(args) 276 | a0, a1 = args[0].unwrap, args[1].unwrap 277 | eval_error "1st argument of get must be hashmap" unless a0.is_a? Mal::HashMap 278 | eval_error "2nd argument of get must be string" unless a1.is_a? String 279 | a0.has_key? a1 280 | end 281 | 282 | def self.keys(args) 283 | head = args.first.unwrap 284 | eval_error "1st argument of assoc must be hashmap" unless head.is_a? Mal::HashMap 285 | head.keys.each_with_object(Mal::List.new) { |e, l| l << Mal::Type.new(e) } 286 | end 287 | 288 | def self.vals(args) 289 | head = args.first.unwrap 290 | eval_error "1st argument of assoc must be hashmap" unless head.is_a? Mal::HashMap 291 | head.values.to_mal 292 | end 293 | 294 | def self.sequential?(args) 295 | args.first.unwrap.is_a? Array 296 | end 297 | 298 | def self.readline(args) 299 | head = args.first.unwrap 300 | eval_error "1st argument of readline must be string" unless head.is_a? String 301 | Readline.readline(head, true) 302 | end 303 | 304 | def self.meta(args) 305 | m = args.first.meta 306 | m.nil? ? nil : m 307 | end 308 | 309 | def self.with_meta(args) 310 | t = args.first.dup 311 | t.meta = args[1] 312 | t 313 | end 314 | 315 | def self.atom(args) 316 | Mal::Atom.new args.first 317 | end 318 | 319 | def self.atom?(args) 320 | args.first.unwrap.is_a? Mal::Atom 321 | end 322 | 323 | def self.deref(args) 324 | head = args.first.unwrap 325 | eval_error "1st argument of deref must be atom" unless head.is_a? Mal::Atom 326 | head.val 327 | end 328 | 329 | def self.reset!(args) 330 | head = args.first.unwrap 331 | eval_error "1st argument of reset! must be atom" unless head.is_a? Mal::Atom 332 | head.val = args[1] 333 | end 334 | 335 | def self.swap!(args) 336 | atom = args.first.unwrap 337 | eval_error "1st argument of swap! must be atom" unless atom.is_a? Mal::Atom 338 | 339 | a = [atom.val] + args[2..-1] 340 | 341 | func = args[1].unwrap 342 | case func 343 | when Mal::Func 344 | atom.val = func.call a 345 | when Mal::Closure 346 | atom.val = func.fn.call a 347 | else 348 | eval_error "2nd argumetn of swap! must be function" 349 | end 350 | end 351 | 352 | def self.conj(args) 353 | seq = args.first.unwrap 354 | case seq 355 | when Mal::List 356 | (args[1..-1].reverse + seq).to_mal 357 | when Mal::Vector 358 | (seq + args[1..-1]).to_mal(Mal::Vector) 359 | else 360 | eval_error "1st argument of conj must be list or vector" 361 | end 362 | end 363 | 364 | def self.seq(args) 365 | obj = args.first.unwrap 366 | case obj 367 | when nil 368 | nil 369 | when Mal::List 370 | return nil if obj.empty? 371 | obj 372 | when Mal::Vector 373 | return nil if obj.empty? 374 | obj.to_mal 375 | when String 376 | return nil if obj.empty? 377 | obj.split("").each_with_object(Mal::List.new) { |e, l| l << Mal::Type.new(e) } 378 | else 379 | eval_error "argument of seq must be list or vector or string or nil" 380 | end 381 | end 382 | 383 | def self.time_ms(args) 384 | Time.local.to_unix_ms 385 | end 386 | 387 | # Note: 388 | # Simply using ->self.some_func doesn't work 389 | macro func(name) 390 | -> (args : Array(Mal::Type)) { Mal::Type.new self.{{name.id}}(args) } 391 | end 392 | 393 | macro rel_op(op) 394 | -> (args : Array(Mal::Type)) { Mal::Type.new (args[0] {{op.id}} args[1]) } 395 | end 396 | 397 | NS = { 398 | "+" => calc_op(:+), 399 | "-" => calc_op(:-), 400 | "*" => calc_op(:*), 401 | "/" => calc_op(:/), 402 | "list" => func(:list), 403 | "list?" => func(:list?), 404 | "empty?" => func(:empty?), 405 | "count" => func(:count), 406 | "=" => rel_op(:==), 407 | "<" => rel_op(:<), 408 | ">" => rel_op(:>), 409 | "<=" => rel_op(:<=), 410 | ">=" => rel_op(:>=), 411 | "pr-str" => func(:pr_str_), 412 | "str" => func(:str), 413 | "prn" => func(:prn), 414 | "println" => func(:println), 415 | "read-string" => func(:read_string), 416 | "slurp" => func(:slurp), 417 | "cons" => func(:cons), 418 | "concat" => func(:concat), 419 | "vec" => func(:vec), 420 | "nth" => func(:nth), 421 | "first" => func(:first), 422 | "rest" => func(:rest), 423 | "throw" => ->(args : Array(Mal::Type)) { raise Mal::RuntimeException.new args[0] }, 424 | "apply" => func(:apply), 425 | "map" => func(:map), 426 | "nil?" => func(:nil_value?), 427 | "true?" => func(:true?), 428 | "false?" => func(:false?), 429 | "symbol?" => func(:symbol?), 430 | "symbol" => func(:symbol), 431 | "string?" => func(:string?), 432 | "keyword" => func(:keyword), 433 | "keyword?" => func(:keyword?), 434 | "number?" => func(:number?), 435 | "fn?" => func(:fn?), 436 | "macro?" => func(:macro?), 437 | "vector" => func(:vector), 438 | "vector?" => func(:vector?), 439 | "hash-map" => func(:hash_map), 440 | "map?" => func(:map?), 441 | "assoc" => func(:assoc), 442 | "dissoc" => func(:dissoc), 443 | "get" => func(:get), 444 | "contains?" => func(:contains?), 445 | "keys" => func(:keys), 446 | "vals" => func(:vals), 447 | "sequential?" => func(:sequential?), 448 | "readline" => func(:readline), 449 | "meta" => func(:meta), 450 | "with-meta" => func(:with_meta), 451 | "atom" => func(:atom), 452 | "atom?" => func(:atom?), 453 | "deref" => func(:deref), 454 | "reset!" => func(:reset!), 455 | "swap!" => func(:swap!), 456 | "conj" => func(:conj), 457 | "seq" => func(:seq), 458 | "time-ms" => func(:time_ms), 459 | } of String => Mal::Func 460 | end 461 | --------------------------------------------------------------------------------