From fccc3b4f8cc1f0aaaff5cccd8b68dd1a28c3615a Mon Sep 17 00:00:00 2001 From: Alex Kotov Date: Sun, 7 May 2023 18:11:11 +0400 Subject: [PATCH] Fix script syntax --- src/main.c | 9 +- src/syntax.c | 2 +- tests/arcana/builtin.scm | 96 ++++++++++----------- tests/arcana/parse.scm | 72 ++++++++-------- tests/arcana/tokenize.scm | 86 +++++++++---------- tests/arcana/typeof.scm | 18 ++-- tests/arithm_ops.scm | 54 ++++++------ tests/basic_data_structs.scm | 18 ++-- tests/equiv.scm | 108 ++++++++++++----------- tests/logic_ops.scm | 20 ++--- tests/syntax.scm | 86 +++++++++---------- tests/type_conv.scm | 22 +++-- tests/type_preds.scm | 162 +++++++++++++++++------------------ 13 files changed, 368 insertions(+), 385 deletions(-) diff --git a/src/main.c b/src/main.c index 52d716b..e511f1f 100644 --- a/src/main.c +++ b/src/main.c @@ -92,11 +92,16 @@ void script() Lexer_lex(lexer, '\n'); LEXER_DELETE(lexer); - if (Tokens_top(tokens) == NULL) return; - struct Object *const program = parse(tokens); + struct Object *program = NULL; + + while (Tokens_top(tokens)) { + program = Object_new_pair(parse(tokens), program); + } TOKENS_DELETE(tokens); + if (program == NULL) return; + struct Object *const environment = Object_new_pair(NULL, NULL); syntax_script(program, environment); } diff --git a/src/syntax.c b/src/syntax.c index 943a0c1..a2ec38b 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -20,7 +20,7 @@ struct Object *syntax_script( struct Object *args, struct Object *const environment ) { - return eval(args, environment); + return syntax_begin(args, environment); } /******************* diff --git a/tests/arcana/builtin.scm b/tests/arcana/builtin.scm index 4d76b2c..ec79e46 100644 --- a/tests/arcana/builtin.scm +++ b/tests/arcana/builtin.scm @@ -1,51 +1,49 @@ -(begin - (assert-true (null? (arcana/builtin 'foobar))) +(assert-true (null? (arcana/builtin 'foobar))) - ; Testing some builtin procedures for sanity - (assert-equal '(1 2 3) ((arcana/builtin 'list) 1 2 3)) - (assert-true ((arcana/builtin 'boolean?) #false)) - (assert-true ((arcana/builtin 'number?) 123)) - (assert-equal "123456" ((arcana/builtin 'number->string) 123456)) - (assert-equal 'foobar ((arcana/builtin 'string->symbol) "foobar")) - (assert-equal "foobar" ((arcana/builtin 'symbol->string) 'foobar)) +; Testing some builtin procedures for sanity +(assert-equal '(1 2 3) ((arcana/builtin 'list) 1 2 3)) +(assert-true ((arcana/builtin 'boolean?) #false)) +(assert-true ((arcana/builtin 'number?) 123)) +(assert-equal "123456" ((arcana/builtin 'number->string) 123456)) +(assert-equal 'foobar ((arcana/builtin 'string->symbol) "foobar")) +(assert-equal "foobar" ((arcana/builtin 'symbol->string) 'foobar)) - ; Assertions - (assert-true (procedure? (arcana/builtin 'assert-equal))) - (assert-true (procedure? (arcana/builtin 'assert-false))) - (assert-true (procedure? (arcana/builtin 'assert-true))) - ; Arcana Lisp internals - (assert-true (procedure? (arcana/builtin 'arcana/builtin))) - (assert-true (procedure? (arcana/builtin 'arcana/parse))) - (assert-true (procedure? (arcana/builtin 'arcana/tokenize))) - (assert-true (procedure? (arcana/builtin 'arcana/typeof))) - ; Basic data structures - (assert-true (procedure? (arcana/builtin 'car))) - (assert-true (procedure? (arcana/builtin 'cdr))) - (assert-true (procedure? (arcana/builtin 'cons))) - (assert-true (procedure? (arcana/builtin 'list))) - ; Type predicates - (assert-true (procedure? (arcana/builtin 'boolean?))) - (assert-true (procedure? (arcana/builtin 'char?))) - (assert-true (procedure? (arcana/builtin 'null?))) - (assert-true (procedure? (arcana/builtin 'number?))) - (assert-true (procedure? (arcana/builtin 'pair?))) - (assert-true (procedure? (arcana/builtin 'procedure?))) - (assert-true (procedure? (arcana/builtin 'string?))) - (assert-true (procedure? (arcana/builtin 'symbol?))) - ; Equivalence predicates - (assert-true (procedure? (arcana/builtin 'equal?))) - ; Type conversion - (assert-true (procedure? (arcana/builtin 'number->string))) - (assert-true (procedure? (arcana/builtin 'string->symbol))) - (assert-true (procedure? (arcana/builtin 'symbol->string))) - ; Logical operators - (assert-true (procedure? (arcana/builtin 'not))) - ; Arithmetic operators - (assert-true (procedure? (arcana/builtin '=))) - (assert-true (procedure? (arcana/builtin '+))) - (assert-true (procedure? (arcana/builtin '-))) - ; IO - (assert-true (procedure? (arcana/builtin 'display))) - (assert-true (procedure? (arcana/builtin 'displayln))) - (assert-true (procedure? (arcana/builtin 'newline))) -) +; Assertions +(assert-true (procedure? (arcana/builtin 'assert-equal))) +(assert-true (procedure? (arcana/builtin 'assert-false))) +(assert-true (procedure? (arcana/builtin 'assert-true))) +; Arcana Lisp internals +(assert-true (procedure? (arcana/builtin 'arcana/builtin))) +(assert-true (procedure? (arcana/builtin 'arcana/parse))) +(assert-true (procedure? (arcana/builtin 'arcana/tokenize))) +(assert-true (procedure? (arcana/builtin 'arcana/typeof))) +; Basic data structures +(assert-true (procedure? (arcana/builtin 'car))) +(assert-true (procedure? (arcana/builtin 'cdr))) +(assert-true (procedure? (arcana/builtin 'cons))) +(assert-true (procedure? (arcana/builtin 'list))) +; Type predicates +(assert-true (procedure? (arcana/builtin 'boolean?))) +(assert-true (procedure? (arcana/builtin 'char?))) +(assert-true (procedure? (arcana/builtin 'null?))) +(assert-true (procedure? (arcana/builtin 'number?))) +(assert-true (procedure? (arcana/builtin 'pair?))) +(assert-true (procedure? (arcana/builtin 'procedure?))) +(assert-true (procedure? (arcana/builtin 'string?))) +(assert-true (procedure? (arcana/builtin 'symbol?))) +; Equivalence predicates +(assert-true (procedure? (arcana/builtin 'equal?))) +; Type conversion +(assert-true (procedure? (arcana/builtin 'number->string))) +(assert-true (procedure? (arcana/builtin 'string->symbol))) +(assert-true (procedure? (arcana/builtin 'symbol->string))) +; Logical operators +(assert-true (procedure? (arcana/builtin 'not))) +; Arithmetic operators +(assert-true (procedure? (arcana/builtin '=))) +(assert-true (procedure? (arcana/builtin '+))) +(assert-true (procedure? (arcana/builtin '-))) +; IO +(assert-true (procedure? (arcana/builtin 'display))) +(assert-true (procedure? (arcana/builtin 'displayln))) +(assert-true (procedure? (arcana/builtin 'newline))) diff --git a/tests/arcana/parse.scm b/tests/arcana/parse.scm index 778985d..57c6e6b 100644 --- a/tests/arcana/parse.scm +++ b/tests/arcana/parse.scm @@ -1,38 +1,36 @@ -(begin - (assert-equal - '(displayln (+ 123 456)) - (arcana/parse - (list - (cons 'TOKEN_ROUND_OPEN "(") - (cons 'TOKEN_IDENT "displayln") - (cons 'TOKEN_ROUND_OPEN "(") - (cons 'TOKEN_IDENT "+") - (cons 'TOKEN_NUM "123") - (cons 'TOKEN_NUM "456") - (cons 'TOKEN_ROUND_CLOSE ")") - (cons 'TOKEN_ROUND_CLOSE ")")))) +(assert-equal + '(displayln (+ 123 456)) + (arcana/parse + (list + (cons 'TOKEN_ROUND_OPEN "(") + (cons 'TOKEN_IDENT "displayln") + (cons 'TOKEN_ROUND_OPEN "(") + (cons 'TOKEN_IDENT "+") + (cons 'TOKEN_NUM "123") + (cons 'TOKEN_NUM "456") + (cons 'TOKEN_ROUND_CLOSE ")") + (cons 'TOKEN_ROUND_CLOSE ")")))) - (assert-equal - '(quasiquote - (cons - (unquote (+ 12 34)) - (unquote (+ 56 78)))) - (arcana/parse - (list - (cons 'TOKEN_QUASI_QUOTE "`") - (cons 'TOKEN_ROUND_OPEN "(") - (cons 'TOKEN_IDENT "cons") - (cons 'TOKEN_QUASI_UNQUOTE ",") - (cons 'TOKEN_ROUND_OPEN "(") - (cons 'TOKEN_IDENT "+") - (cons 'TOKEN_NUM "12") - (cons 'TOKEN_NUM "34") - (cons 'TOKEN_ROUND_CLOSE ")") - (cons 'TOKEN_QUASI_UNQUOTE ",") - (cons 'TOKEN_ROUND_OPEN "(") - (cons 'TOKEN_IDENT "+") - (cons 'TOKEN_NUM "56") - (cons 'TOKEN_NUM "78") - (cons 'TOKEN_ROUND_CLOSE ")") - (cons 'TOKEN_ROUND_CLOSE ")")))) -) +(assert-equal + '(quasiquote + (cons + (unquote (+ 12 34)) + (unquote (+ 56 78)))) + (arcana/parse + (list + (cons 'TOKEN_QUASI_QUOTE "`") + (cons 'TOKEN_ROUND_OPEN "(") + (cons 'TOKEN_IDENT "cons") + (cons 'TOKEN_QUASI_UNQUOTE ",") + (cons 'TOKEN_ROUND_OPEN "(") + (cons 'TOKEN_IDENT "+") + (cons 'TOKEN_NUM "12") + (cons 'TOKEN_NUM "34") + (cons 'TOKEN_ROUND_CLOSE ")") + (cons 'TOKEN_QUASI_UNQUOTE ",") + (cons 'TOKEN_ROUND_OPEN "(") + (cons 'TOKEN_IDENT "+") + (cons 'TOKEN_NUM "56") + (cons 'TOKEN_NUM "78") + (cons 'TOKEN_ROUND_CLOSE ")") + (cons 'TOKEN_ROUND_CLOSE ")")))) diff --git a/tests/arcana/tokenize.scm b/tests/arcana/tokenize.scm index d541e16..21d97a7 100644 --- a/tests/arcana/tokenize.scm +++ b/tests/arcana/tokenize.scm @@ -1,50 +1,48 @@ -(begin - (assert-equal '() (arcana/tokenize "")) - (assert-equal '() (arcana/tokenize " ")) - ;(assert-equal '() (arcana/tokenize "\n")) - (assert-equal '() (arcana/tokenize "; foo")) - ;(assert-equal '() (arcana/tokenize " ; foo\n ; foo")) +(assert-equal '() (arcana/tokenize "")) +(assert-equal '() (arcana/tokenize " ")) +;(assert-equal '() (arcana/tokenize "\n")) +(assert-equal '() (arcana/tokenize "; foo")) +;(assert-equal '() (arcana/tokenize " ; foo\n ; foo")) - (assert-equal (arcana/tokenize "(") (list (cons 'TOKEN_ROUND_OPEN "("))) - (assert-equal (arcana/tokenize ")") (list (cons 'TOKEN_ROUND_CLOSE ")"))) - (assert-equal (arcana/tokenize "[") (list (cons 'TOKEN_SQUARE_OPEN "["))) - (assert-equal (arcana/tokenize "]") (list (cons 'TOKEN_SQUARE_CLOSE "]"))) - (assert-equal (arcana/tokenize "{") (list (cons 'TOKEN_CURLY_OPEN "{"))) - (assert-equal (arcana/tokenize "}") (list (cons 'TOKEN_CURLY_CLOSE "}"))) - (assert-equal (arcana/tokenize "'") (list (cons 'TOKEN_QUOTE "'"))) - (assert-equal (arcana/tokenize "`") (list (cons 'TOKEN_QUASI_QUOTE "`"))) - (assert-equal (arcana/tokenize ",") (list (cons 'TOKEN_QUASI_UNQUOTE ","))) +(assert-equal (arcana/tokenize "(") (list (cons 'TOKEN_ROUND_OPEN "("))) +(assert-equal (arcana/tokenize ")") (list (cons 'TOKEN_ROUND_CLOSE ")"))) +(assert-equal (arcana/tokenize "[") (list (cons 'TOKEN_SQUARE_OPEN "["))) +(assert-equal (arcana/tokenize "]") (list (cons 'TOKEN_SQUARE_CLOSE "]"))) +(assert-equal (arcana/tokenize "{") (list (cons 'TOKEN_CURLY_OPEN "{"))) +(assert-equal (arcana/tokenize "}") (list (cons 'TOKEN_CURLY_CLOSE "}"))) +(assert-equal (arcana/tokenize "'") (list (cons 'TOKEN_QUOTE "'"))) +(assert-equal (arcana/tokenize "`") (list (cons 'TOKEN_QUASI_QUOTE "`"))) +(assert-equal (arcana/tokenize ",") (list (cons 'TOKEN_QUASI_UNQUOTE ","))) - (assert-equal (arcana/tokenize "#f") (list (cons 'TOKEN_TAG "f"))) - (assert-equal (arcana/tokenize "#t") (list (cons 'TOKEN_TAG "t"))) - (assert-equal (arcana/tokenize "#false") (list (cons 'TOKEN_TAG "false"))) - (assert-equal (arcana/tokenize "#true") (list (cons 'TOKEN_TAG "true"))) - (assert-equal (arcana/tokenize "#qwe") (list (cons 'TOKEN_TAG "qwe"))) +(assert-equal (arcana/tokenize "#f") (list (cons 'TOKEN_TAG "f"))) +(assert-equal (arcana/tokenize "#t") (list (cons 'TOKEN_TAG "t"))) +(assert-equal (arcana/tokenize "#false") (list (cons 'TOKEN_TAG "false"))) +(assert-equal (arcana/tokenize "#true") (list (cons 'TOKEN_TAG "true"))) +(assert-equal (arcana/tokenize "#qwe") (list (cons 'TOKEN_TAG "qwe"))) - (assert-equal (arcana/tokenize "qwe") (list (cons 'TOKEN_IDENT "qwe"))) +(assert-equal (arcana/tokenize "qwe") (list (cons 'TOKEN_IDENT "qwe"))) - (assert-equal (arcana/tokenize "123") (list (cons 'TOKEN_NUM "123"))) - ;(assert-equal (arcana/tokenize "-123") (list (cons 'TOKEN_NUM "-123"))) +(assert-equal (arcana/tokenize "123") (list (cons 'TOKEN_NUM "123"))) +;(assert-equal (arcana/tokenize "-123") (list (cons 'TOKEN_NUM "-123"))) - (assert-equal (arcana/tokenize "\"\"") (list (cons 'TOKEN_STRING ""))) - (assert-equal (arcana/tokenize "\"qwe\"") (list (cons 'TOKEN_STRING "qwe"))) - (assert-equal (arcana/tokenize "\"\\\"\"") (list (cons 'TOKEN_STRING "\""))) +(assert-equal (arcana/tokenize "\"\"") (list (cons 'TOKEN_STRING ""))) +(assert-equal (arcana/tokenize "\"qwe\"") (list (cons 'TOKEN_STRING "qwe"))) +(assert-equal (arcana/tokenize "\"\\\"\"") (list (cons 'TOKEN_STRING "\""))) - (assert-equal - (arcana/tokenize "(displayln \"qwe\")") - (list - (cons 'TOKEN_ROUND_OPEN "(") - (cons 'TOKEN_IDENT "displayln") - (cons 'TOKEN_STRING "qwe") - (cons 'TOKEN_ROUND_CLOSE ")"))) - (assert-equal - (arcana/tokenize "(displayln (list 1))") - (list - (cons 'TOKEN_ROUND_OPEN "(") - (cons 'TOKEN_IDENT "displayln") - (cons 'TOKEN_ROUND_OPEN "(") - (cons 'TOKEN_IDENT "list") - (cons 'TOKEN_NUM "1") - (cons 'TOKEN_ROUND_CLOSE ")") - (cons 'TOKEN_ROUND_CLOSE ")"))) -) +(assert-equal + (arcana/tokenize "(displayln \"qwe\")") + (list + (cons 'TOKEN_ROUND_OPEN "(") + (cons 'TOKEN_IDENT "displayln") + (cons 'TOKEN_STRING "qwe") + (cons 'TOKEN_ROUND_CLOSE ")"))) +(assert-equal + (arcana/tokenize "(displayln (list 1))") + (list + (cons 'TOKEN_ROUND_OPEN "(") + (cons 'TOKEN_IDENT "displayln") + (cons 'TOKEN_ROUND_OPEN "(") + (cons 'TOKEN_IDENT "list") + (cons 'TOKEN_NUM "1") + (cons 'TOKEN_ROUND_CLOSE ")") + (cons 'TOKEN_ROUND_CLOSE ")"))) diff --git a/tests/arcana/typeof.scm b/tests/arcana/typeof.scm index ec9cf49..3be53bd 100644 --- a/tests/arcana/typeof.scm +++ b/tests/arcana/typeof.scm @@ -1,10 +1,8 @@ -(begin - (assert-equal 'null (arcana/typeof '())) - (assert-equal 'procedure (arcana/typeof +)) - (assert-equal 'pair (arcana/typeof (cons 123 456))) - (assert-equal 'boolean (arcana/typeof #false)) - ;(assert-equal 'char (arcana/typeof #\n)) - (assert-equal 'symbol (arcana/typeof 'foo)) - (assert-equal 'string (arcana/typeof "foo")) - (assert-equal 'number (arcana/typeof 123)) -) +(assert-equal 'null (arcana/typeof '())) +(assert-equal 'procedure (arcana/typeof +)) +(assert-equal 'pair (arcana/typeof (cons 123 456))) +(assert-equal 'boolean (arcana/typeof #false)) +;(assert-equal 'char (arcana/typeof #\n)) +(assert-equal 'symbol (arcana/typeof 'foo)) +(assert-equal 'string (arcana/typeof "foo")) +(assert-equal 'number (arcana/typeof 123)) diff --git a/tests/arithm_ops.scm b/tests/arithm_ops.scm index b192765..a3bf635 100644 --- a/tests/arithm_ops.scm +++ b/tests/arithm_ops.scm @@ -1,30 +1,28 @@ -(begin - ;;; = ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-equal #true (= 123)) - (assert-equal #true (= 123 123)) - (assert-equal #false (= 123 456)) - (assert-equal #true (= 123 123 123)) - (assert-equal #false (= 456 123 123)) - (assert-equal #false (= 123 456 123)) - (assert-equal #false (= 123 123 456)) - (assert-equal #true (= 123 123 123 123)) - (assert-equal #false (= 456 123 123 123)) - (assert-equal #false (= 123 456 123 123)) - (assert-equal #false (= 123 123 456 123)) - (assert-equal #false (= 123 123 123 456)) +;;; = ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal #true (= 123)) +(assert-equal #true (= 123 123)) +(assert-equal #false (= 123 456)) +(assert-equal #true (= 123 123 123)) +(assert-equal #false (= 456 123 123)) +(assert-equal #false (= 123 456 123)) +(assert-equal #false (= 123 123 456)) +(assert-equal #true (= 123 123 123 123)) +(assert-equal #false (= 456 123 123 123)) +(assert-equal #false (= 123 456 123 123)) +(assert-equal #false (= 123 123 456 123)) +(assert-equal #false (= 123 123 123 456)) - ;;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-equal 0 (+)) - (assert-equal 123 (+ 123)) - (assert-equal 11 (+ 1 10)) - (assert-equal 111 (+ 1 10 100)) - (assert-equal 1111 (+ 1 10 100 1000)) +;;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal 0 (+)) +(assert-equal 123 (+ 123)) +(assert-equal 11 (+ 1 10)) +(assert-equal 111 (+ 1 10 100)) +(assert-equal 1111 (+ 1 10 100 1000)) - ;;; - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-equal 0 (- 0)) - ;(assert-equal -123 (- 123)) - (assert-equal 99 (- 100 1)) - (assert-equal 97 (- 100 1 2)) - (assert-equal 94 (- 100 1 2 3)) - (assert-equal 90 (- 100 1 2 3 4)) -) +;;; - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal 0 (- 0)) +;(assert-equal -123 (- 123)) +(assert-equal 99 (- 100 1)) +(assert-equal 97 (- 100 1 2)) +(assert-equal 94 (- 100 1 2 3)) +(assert-equal 90 (- 100 1 2 3 4)) diff --git a/tests/basic_data_structs.scm b/tests/basic_data_structs.scm index 5d2c4b3..1a24433 100644 --- a/tests/basic_data_structs.scm +++ b/tests/basic_data_structs.scm @@ -1,12 +1,10 @@ -(begin - ;;; car ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-equal 123 (car (cons 123 456))) +;;; car ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal 123 (car (cons 123 456))) - ;;; cdr ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-equal 456 (cdr (cons 123 456))) +;;; cdr ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal 456 (cdr (cons 123 456))) - ;;; list ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-equal '() (list)) - (assert-equal '(123) (list 123)) - (assert-equal '(123 456) (list 123 456)) -) +;;; list ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal '() (list)) +(assert-equal '(123) (list 123)) +(assert-equal '(123 456) (list 123 456)) diff --git a/tests/equiv.scm b/tests/equiv.scm index cbe1b27..92f209c 100644 --- a/tests/equiv.scm +++ b/tests/equiv.scm @@ -1,55 +1,53 @@ -(begin - ;;; equal? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ; No args - (assert-true (equal?)) - ; A single arg - (assert-true (equal? '())) - (assert-true (equal? +)) - (assert-true (equal? (cons 123 456))) - (assert-true (equal? #false)) - (assert-true (equal? #true)) - ;(assert-true (equal? #\n)) - (assert-true (equal? 'foo)) - (assert-true (equal? "foo")) - (assert-true (equal? 123)) - ; Two equal args - (assert-true (equal? '() '())) - (assert-true (equal? + +)) - (assert-true (equal? (cons 123 456) (cons 123 456))) - (assert-true (equal? #false #false)) - (assert-true (equal? #true #true)) - ;(assert-true (equal? #\n #\n)) - (assert-true (equal? 'foo 'foo)) - (assert-true (equal? "foo" "foo")) - (assert-true (equal? 123 123)) - ; Two different args - (assert-false (equal? '() '(1))) - (assert-false (equal? + -)) - (assert-false (equal? (cons 123 456) (cons 123 789))) - (assert-false (equal? #false #true)) - (assert-false (equal? #true #false)) - ;(assert-false (equal? #\n #\t)) - (assert-false (equal? 'foo 'bar)) - (assert-false (equal? "foo" "bar")) - (assert-false (equal? 123 789)) - ; Three equal args - (assert-true (equal? '() '() '())) - (assert-true (equal? + + +)) - (assert-true (equal? (cons 123 456) (cons 123 456) (cons 123 456))) - (assert-true (equal? #false #false #false)) - (assert-true (equal? #true #true #true)) - ;(assert-true (equal? #\n #\n #\n)) - (assert-true (equal? 'foo 'foo 'foo)) - (assert-true (equal? "foo" "foo" "foo")) - (assert-true (equal? 123 123 123)) - ; Three different args - (assert-false (equal? '() '() '(1))) - (assert-false (equal? + + -)) - (assert-false (equal? (cons 123 456) (cons 123 456) (cons 123 789))) - (assert-false (equal? #false #false #true)) - (assert-false (equal? #true #true #false)) - ;(assert-false (equal? #\n #\n #\t)) - (assert-false (equal? 'foo 'foo 'bar)) - (assert-false (equal? "foo" "foo" "bar")) - (assert-false (equal? 123 123 789)) -) +;;; equal? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; No args +(assert-true (equal?)) +; A single arg +(assert-true (equal? '())) +(assert-true (equal? +)) +(assert-true (equal? (cons 123 456))) +(assert-true (equal? #false)) +(assert-true (equal? #true)) +;(assert-true (equal? #\n)) +(assert-true (equal? 'foo)) +(assert-true (equal? "foo")) +(assert-true (equal? 123)) +; Two equal args +(assert-true (equal? '() '())) +(assert-true (equal? + +)) +(assert-true (equal? (cons 123 456) (cons 123 456))) +(assert-true (equal? #false #false)) +(assert-true (equal? #true #true)) +;(assert-true (equal? #\n #\n)) +(assert-true (equal? 'foo 'foo)) +(assert-true (equal? "foo" "foo")) +(assert-true (equal? 123 123)) +; Two different args +(assert-false (equal? '() '(1))) +(assert-false (equal? + -)) +(assert-false (equal? (cons 123 456) (cons 123 789))) +(assert-false (equal? #false #true)) +(assert-false (equal? #true #false)) +;(assert-false (equal? #\n #\t)) +(assert-false (equal? 'foo 'bar)) +(assert-false (equal? "foo" "bar")) +(assert-false (equal? 123 789)) +; Three equal args +(assert-true (equal? '() '() '())) +(assert-true (equal? + + +)) +(assert-true (equal? (cons 123 456) (cons 123 456) (cons 123 456))) +(assert-true (equal? #false #false #false)) +(assert-true (equal? #true #true #true)) +;(assert-true (equal? #\n #\n #\n)) +(assert-true (equal? 'foo 'foo 'foo)) +(assert-true (equal? "foo" "foo" "foo")) +(assert-true (equal? 123 123 123)) +; Three different args +(assert-false (equal? '() '() '(1))) +(assert-false (equal? + + -)) +(assert-false (equal? (cons 123 456) (cons 123 456) (cons 123 789))) +(assert-false (equal? #false #false #true)) +(assert-false (equal? #true #true #false)) +;(assert-false (equal? #\n #\n #\t)) +(assert-false (equal? 'foo 'foo 'bar)) +(assert-false (equal? "foo" "foo" "bar")) +(assert-false (equal? 123 123 789)) diff --git a/tests/logic_ops.scm b/tests/logic_ops.scm index 7e985e7..b907ce9 100644 --- a/tests/logic_ops.scm +++ b/tests/logic_ops.scm @@ -1,11 +1,9 @@ -(begin - ;; not ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-false (not '())) - (assert-false (not #true)) - (assert-true (not #false)) - ;(assert-false (not #\n)) - (assert-false (not 'foo)) - (assert-false (not "foo")) - (assert-false (not 123)) - (assert-false (not (cons 123 456))) -) +;; not ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-false (not '())) +(assert-false (not #true)) +(assert-true (not #false)) +;(assert-false (not #\n)) +(assert-false (not 'foo)) +(assert-false (not "foo")) +(assert-false (not 123)) +(assert-false (not (cons 123 456))) diff --git a/tests/syntax.scm b/tests/syntax.scm index b0e65eb..6a5246a 100644 --- a/tests/syntax.scm +++ b/tests/syntax.scm @@ -1,47 +1,45 @@ -(begin - ;;; begin ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-equal '() (begin)) - (assert-equal 123 (begin 123)) - (assert-equal 456 (begin 123 456)) - (assert-equal 789 (begin 123 456 789)) +;;; begin ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal '() (begin)) +(assert-equal 123 (begin 123)) +(assert-equal 456 (begin 123 456)) +(assert-equal 789 (begin 123 456 789)) - ;;; define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-equal - '(123 579) - (begin - (define x 123) - (define y (+ x 456)) - (list x y))) - (assert-equal - '(123 456) - (begin - (define x 123) - (define old x) - (define x 456) - (list old x))) +;;; define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal + '(123 579) + (begin + (define x 123) + (define y (+ x 456)) + (list x y))) +(assert-equal + '(123 456) + (begin + (define x 123) + (define old x) + (define x 456) + (list old x))) - ;;; if ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-equal 123 (if #true 123 456)) - (assert-equal 123 (if "foo" 123 456)) - (assert-equal 456 (if #false 123 456)) +;;; if ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal 123 (if #true 123 456)) +(assert-equal 123 (if "foo" 123 456)) +(assert-equal 456 (if #false 123 456)) - ;;; quote ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-equal '+ (quote +)) - (assert-equal '+ '+) - (assert-equal '() (quote ())) - (assert-equal '() '()) - (assert-equal #true (quote #true)) - (assert-equal #true '#true) - (assert-equal #false (quote #false)) - (assert-equal #false '#false) - ;(assert-equal #\n (quote #\n)) - ;(assert-equal #\n '#\n) - (assert-equal 'foo (quote foo)) - (assert-equal 'foo 'foo) - (assert-equal "foo" (quote "foo")) - (assert-equal "foo" '"foo") - (assert-equal 123 (quote 123)) - (assert-equal 123 '123) - (assert-equal '(cons 123 456) (quote (cons 123 456))) - (assert-equal '(cons 123 456) '(cons 123 456)) -) +;;; quote ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal '+ (quote +)) +(assert-equal '+ '+) +(assert-equal '() (quote ())) +(assert-equal '() '()) +(assert-equal #true (quote #true)) +(assert-equal #true '#true) +(assert-equal #false (quote #false)) +(assert-equal #false '#false) +;(assert-equal #\n (quote #\n)) +;(assert-equal #\n '#\n) +(assert-equal 'foo (quote foo)) +(assert-equal 'foo 'foo) +(assert-equal "foo" (quote "foo")) +(assert-equal "foo" '"foo") +(assert-equal 123 (quote 123)) +(assert-equal 123 '123) +(assert-equal '(cons 123 456) (quote (cons 123 456))) +(assert-equal '(cons 123 456) '(cons 123 456)) diff --git a/tests/type_conv.scm b/tests/type_conv.scm index 7f863fe..f6b155d 100644 --- a/tests/type_conv.scm +++ b/tests/type_conv.scm @@ -1,14 +1,12 @@ -(begin - ;;; number->string ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-equal "123" (number->string 123)) - ;(assert-equal "-123" (number->string -123)) - (assert-equal "1e240" (number->string 123456 16)) +;;; number->string ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal "123" (number->string 123)) +;(assert-equal "-123" (number->string -123)) +(assert-equal "1e240" (number->string 123456 16)) - ;;; string->symbol ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;(assert-equal '|| (string->symbol "")) - ;(assert-equal '| | (string->symbol " ")) - (assert-equal 'foo (string->symbol "foo")) +;;; string->symbol ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;(assert-equal '|| (string->symbol "")) +;(assert-equal '| | (string->symbol " ")) +(assert-equal 'foo (string->symbol "foo")) - ;;; symbol->string ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-equal "foo" (symbol->string 'foo)) -) +;;; symbol->string ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal "foo" (symbol->string 'foo)) diff --git a/tests/type_preds.scm b/tests/type_preds.scm index 2a8624a..22c4164 100644 --- a/tests/type_preds.scm +++ b/tests/type_preds.scm @@ -1,89 +1,87 @@ -(begin - ;;; boolean? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-false (boolean? +)) - (assert-false (boolean? '())) - (assert-true (boolean? #true)) - (assert-true (boolean? #false)) - ;(assert-false (boolean? #\n)) - (assert-false (boolean? 'foo)) - (assert-false (boolean? "foo")) - (assert-false (boolean? 123)) - (assert-false (boolean? (cons 123 456))) +;;; boolean? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-false (boolean? +)) +(assert-false (boolean? '())) +(assert-true (boolean? #true)) +(assert-true (boolean? #false)) +;(assert-false (boolean? #\n)) +(assert-false (boolean? 'foo)) +(assert-false (boolean? "foo")) +(assert-false (boolean? 123)) +(assert-false (boolean? (cons 123 456))) - ;;; char? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-false (char? +)) - (assert-false (char? '())) - (assert-false (char? #true)) - (assert-false (char? #false)) - ;(assert-true (char? #\n)) - (assert-false (char? 'foo)) - (assert-false (char? "foo")) - (assert-false (char? 123)) - (assert-false (char? (cons 123 456))) +;;; char? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-false (char? +)) +(assert-false (char? '())) +(assert-false (char? #true)) +(assert-false (char? #false)) +;(assert-true (char? #\n)) +(assert-false (char? 'foo)) +(assert-false (char? "foo")) +(assert-false (char? 123)) +(assert-false (char? (cons 123 456))) - ;;; null? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-false (null? +)) - (assert-true (null? '())) - (assert-false (null? #true)) - (assert-false (null? #false)) - ;(assert-false (null? #\n)) - (assert-false (null? 'foo)) - (assert-false (null? "foo")) - (assert-false (null? 123)) - (assert-false (null? (cons 123 456))) +;;; null? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-false (null? +)) +(assert-true (null? '())) +(assert-false (null? #true)) +(assert-false (null? #false)) +;(assert-false (null? #\n)) +(assert-false (null? 'foo)) +(assert-false (null? "foo")) +(assert-false (null? 123)) +(assert-false (null? (cons 123 456))) - ;;; number? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-false (number? +)) - (assert-false (number? '())) - (assert-false (number? #true)) - (assert-false (number? #false)) - ;(assert-false (number? #\n)) - (assert-false (number? 'foo)) - (assert-false (number? "foo")) - (assert-true (number? 123)) - (assert-false (number? (cons 123 456))) +;;; number? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-false (number? +)) +(assert-false (number? '())) +(assert-false (number? #true)) +(assert-false (number? #false)) +;(assert-false (number? #\n)) +(assert-false (number? 'foo)) +(assert-false (number? "foo")) +(assert-true (number? 123)) +(assert-false (number? (cons 123 456))) - ;;; pair? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-false (pair? +)) - (assert-false (pair? '())) - (assert-false (pair? #true)) - (assert-false (pair? #false)) - ;(assert-false (pair? #\n)) - (assert-false (pair? 'foo)) - (assert-false (pair? "foo")) - (assert-false (pair? 123)) - (assert-true (pair? (cons 123 456))) +;;; pair? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-false (pair? +)) +(assert-false (pair? '())) +(assert-false (pair? #true)) +(assert-false (pair? #false)) +;(assert-false (pair? #\n)) +(assert-false (pair? 'foo)) +(assert-false (pair? "foo")) +(assert-false (pair? 123)) +(assert-true (pair? (cons 123 456))) - ;;; procedure? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-true (procedure? +)) - (assert-false (procedure? '())) - (assert-false (procedure? #true)) - (assert-false (procedure? #false)) - ;(assert-false (procedure? #\n)) - (assert-false (procedure? 'foo)) - (assert-false (procedure? "foo")) - (assert-false (procedure? 123)) - (assert-false (procedure? (cons 123 456))) +;;; procedure? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-true (procedure? +)) +(assert-false (procedure? '())) +(assert-false (procedure? #true)) +(assert-false (procedure? #false)) +;(assert-false (procedure? #\n)) +(assert-false (procedure? 'foo)) +(assert-false (procedure? "foo")) +(assert-false (procedure? 123)) +(assert-false (procedure? (cons 123 456))) - ;;; string? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-false (string? +)) - (assert-false (string? '())) - (assert-false (string? #true)) - (assert-false (string? #false)) - ;(assert-false (string? #\n)) - (assert-false (string? 'foo)) - (assert-true (string? "foo")) - (assert-false (string? 123)) - (assert-false (string? (cons 123 456))) +;;; string? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-false (string? +)) +(assert-false (string? '())) +(assert-false (string? #true)) +(assert-false (string? #false)) +;(assert-false (string? #\n)) +(assert-false (string? 'foo)) +(assert-true (string? "foo")) +(assert-false (string? 123)) +(assert-false (string? (cons 123 456))) - ;;; symbol? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (assert-false (symbol? +)) - (assert-false (symbol? '())) - (assert-false (symbol? #true)) - (assert-false (symbol? #false)) - ;(assert-false (symbol? #\n)) - (assert-true (symbol? 'foo)) - (assert-false (symbol? "foo")) - (assert-false (symbol? 123)) - (assert-false (symbol? (cons 123 456))) -) +;;; symbol? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-false (symbol? +)) +(assert-false (symbol? '())) +(assert-false (symbol? #true)) +(assert-false (symbol? #false)) +;(assert-false (symbol? #\n)) +(assert-true (symbol? 'foo)) +(assert-false (symbol? "foo")) +(assert-false (symbol? 123)) +(assert-false (symbol? (cons 123 456)))