causa-arcana-misc/lesson-lisp
1
0
Fork 0
Code Activity

Fix script syntax

Browse source
This commit is contained in:
Alex Kotov 2023-05-07 18:11:11 +04:00
parent 522936f222
commit fccc3b4f8c
Signed by: kotovalexarian
GPG key ID: 553C0EBBEB5D5F08
13 changed files with 368 additions and 385 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
src/main.c
View file

@ -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);
}

2
src/syntax.c
View file

@ -20,7 +20,7 @@ struct Object *syntax_script(
struct Object *args,
struct Object *const environment
) {
return eval(args, environment);
return syntax_begin(args, environment);
}
/*******************

96
tests/arcana/builtin.scm
View file

@ -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)))

72
tests/arcana/parse.scm
View file

@ -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 ")"))))

86
tests/arcana/tokenize.scm
View file

@ -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 ")")))

18
tests/arcana/typeof.scm
View file

@ -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))

54
tests/arithm_ops.scm
View file

@ -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))

18
tests/basic_data_structs.scm
View file

@ -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))

108
tests/equiv.scm
View file

@ -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))

20
tests/logic_ops.scm
View file

@ -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)))

86
tests/syntax.scm
View file

@ -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))

22
tests/type_conv.scm
View file

@ -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))

162
tests/type_preds.scm
View file

@ -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)))