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_lex(lexer, '\n');
LEXER_DELETE(lexer); 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); TOKENS_DELETE(tokens);
if (program == NULL) return;
struct Object *const environment = Object_new_pair(NULL, NULL); struct Object *const environment = Object_new_pair(NULL, NULL);
syntax_script(program, environment); syntax_script(program, environment);
} }

2
src/syntax.c
View file

@ -20,7 +20,7 @@ struct Object *syntax_script(
struct Object *args, struct Object *args,
struct Object *const environment 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 ; Testing some builtin procedures for sanity
(assert-equal '(1 2 3) ((arcana/builtin 'list) 1 2 3)) (assert-equal '(1 2 3) ((arcana/builtin 'list) 1 2 3))
(assert-true ((arcana/builtin 'boolean?) #false)) (assert-true ((arcana/builtin 'boolean?) #false))
(assert-true ((arcana/builtin 'number?) 123)) (assert-true ((arcana/builtin 'number?) 123))
(assert-equal "123456" ((arcana/builtin 'number->string) 123456)) (assert-equal "123456" ((arcana/builtin 'number->string) 123456))
(assert-equal 'foobar ((arcana/builtin 'string->symbol) "foobar")) (assert-equal 'foobar ((arcana/builtin 'string->symbol) "foobar"))
(assert-equal "foobar" ((arcana/builtin 'symbol->string) 'foobar)) (assert-equal "foobar" ((arcana/builtin 'symbol->string) 'foobar))
; Assertions ; Assertions
(assert-true (procedure? (arcana/builtin 'assert-equal))) (assert-true (procedure? (arcana/builtin 'assert-equal)))
(assert-true (procedure? (arcana/builtin 'assert-false))) (assert-true (procedure? (arcana/builtin 'assert-false)))
(assert-true (procedure? (arcana/builtin 'assert-true))) (assert-true (procedure? (arcana/builtin 'assert-true)))
; Arcana Lisp internals ; Arcana Lisp internals
(assert-true (procedure? (arcana/builtin 'arcana/builtin))) (assert-true (procedure? (arcana/builtin 'arcana/builtin)))
(assert-true (procedure? (arcana/builtin 'arcana/parse))) (assert-true (procedure? (arcana/builtin 'arcana/parse)))
(assert-true (procedure? (arcana/builtin 'arcana/tokenize))) (assert-true (procedure? (arcana/builtin 'arcana/tokenize)))
(assert-true (procedure? (arcana/builtin 'arcana/typeof))) (assert-true (procedure? (arcana/builtin 'arcana/typeof)))
; Basic data structures ; Basic data structures
(assert-true (procedure? (arcana/builtin 'car))) (assert-true (procedure? (arcana/builtin 'car)))
(assert-true (procedure? (arcana/builtin 'cdr))) (assert-true (procedure? (arcana/builtin 'cdr)))
(assert-true (procedure? (arcana/builtin 'cons))) (assert-true (procedure? (arcana/builtin 'cons)))
(assert-true (procedure? (arcana/builtin 'list))) (assert-true (procedure? (arcana/builtin 'list)))
; Type predicates ; Type predicates
(assert-true (procedure? (arcana/builtin 'boolean?))) (assert-true (procedure? (arcana/builtin 'boolean?)))
(assert-true (procedure? (arcana/builtin 'char?))) (assert-true (procedure? (arcana/builtin 'char?)))
(assert-true (procedure? (arcana/builtin 'null?))) (assert-true (procedure? (arcana/builtin 'null?)))
(assert-true (procedure? (arcana/builtin 'number?))) (assert-true (procedure? (arcana/builtin 'number?)))
(assert-true (procedure? (arcana/builtin 'pair?))) (assert-true (procedure? (arcana/builtin 'pair?)))
(assert-true (procedure? (arcana/builtin 'procedure?))) (assert-true (procedure? (arcana/builtin 'procedure?)))
(assert-true (procedure? (arcana/builtin 'string?))) (assert-true (procedure? (arcana/builtin 'string?)))
(assert-true (procedure? (arcana/builtin 'symbol?))) (assert-true (procedure? (arcana/builtin 'symbol?)))
; Equivalence predicates ; Equivalence predicates
(assert-true (procedure? (arcana/builtin 'equal?))) (assert-true (procedure? (arcana/builtin 'equal?)))
; Type conversion ; Type conversion
(assert-true (procedure? (arcana/builtin 'number->string))) (assert-true (procedure? (arcana/builtin 'number->string)))
(assert-true (procedure? (arcana/builtin 'string->symbol))) (assert-true (procedure? (arcana/builtin 'string->symbol)))
(assert-true (procedure? (arcana/builtin 'symbol->string))) (assert-true (procedure? (arcana/builtin 'symbol->string)))
; Logical operators ; Logical operators
(assert-true (procedure? (arcana/builtin 'not))) (assert-true (procedure? (arcana/builtin 'not)))
; Arithmetic operators ; Arithmetic operators
(assert-true (procedure? (arcana/builtin '=))) (assert-true (procedure? (arcana/builtin '=)))
(assert-true (procedure? (arcana/builtin '+))) (assert-true (procedure? (arcana/builtin '+)))
(assert-true (procedure? (arcana/builtin '-))) (assert-true (procedure? (arcana/builtin '-)))
; IO ; IO
(assert-true (procedure? (arcana/builtin 'display))) (assert-true (procedure? (arcana/builtin 'display)))
(assert-true (procedure? (arcana/builtin 'displayln))) (assert-true (procedure? (arcana/builtin 'displayln)))
(assert-true (procedure? (arcana/builtin 'newline))) (assert-true (procedure? (arcana/builtin 'newline)))
)

6
tests/arcana/parse.scm
View file

@ -1,5 +1,4 @@
(begin (assert-equal
(assert-equal
'(displayln (+ 123 456)) '(displayln (+ 123 456))
(arcana/parse (arcana/parse
(list (list
@ -12,7 +11,7 @@
(cons 'TOKEN_ROUND_CLOSE ")") (cons 'TOKEN_ROUND_CLOSE ")")
(cons 'TOKEN_ROUND_CLOSE ")")))) (cons 'TOKEN_ROUND_CLOSE ")"))))
(assert-equal (assert-equal
'(quasiquote '(quasiquote
(cons (cons
(unquote (+ 12 34)) (unquote (+ 12 34))
@ -35,4 +34,3 @@
(cons 'TOKEN_NUM "78") (cons 'TOKEN_NUM "78")
(cons 'TOKEN_ROUND_CLOSE ")") (cons 'TOKEN_ROUND_CLOSE ")")
(cons 'TOKEN_ROUND_CLOSE ")")))) (cons 'TOKEN_ROUND_CLOSE ")"))))
)

56
tests/arcana/tokenize.scm
View file

@ -1,43 +1,42 @@
(begin (assert-equal '() (arcana/tokenize ""))
(assert-equal '() (arcana/tokenize "")) (assert-equal '() (arcana/tokenize " "))
(assert-equal '() (arcana/tokenize " ")) ;(assert-equal '() (arcana/tokenize "\n"))
;(assert-equal '() (arcana/tokenize "\n")) (assert-equal '() (arcana/tokenize "; foo"))
(assert-equal '() (arcana/tokenize "; foo")) ;(assert-equal '() (arcana/tokenize " ; foo\n ; 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_OPEN "(")))
(assert-equal (arcana/tokenize ")") (list (cons 'TOKEN_ROUND_CLOSE ")"))) (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_OPEN "[")))
(assert-equal (arcana/tokenize "]") (list (cons 'TOKEN_SQUARE_CLOSE "]"))) (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_OPEN "{")))
(assert-equal (arcana/tokenize "}") (list (cons 'TOKEN_CURLY_CLOSE "}"))) (assert-equal (arcana/tokenize "}") (list (cons 'TOKEN_CURLY_CLOSE "}")))
(assert-equal (arcana/tokenize "'") (list (cons 'TOKEN_QUOTE "'"))) (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_QUOTE "`")))
(assert-equal (arcana/tokenize ",") (list (cons 'TOKEN_QUASI_UNQUOTE ","))) (assert-equal (arcana/tokenize ",") (list (cons 'TOKEN_QUASI_UNQUOTE ",")))
(assert-equal (arcana/tokenize "#f") (list (cons 'TOKEN_TAG "f"))) (assert-equal (arcana/tokenize "#f") (list (cons 'TOKEN_TAG "f")))
(assert-equal (arcana/tokenize "#t") (list (cons 'TOKEN_TAG "t"))) (assert-equal (arcana/tokenize "#t") (list (cons 'TOKEN_TAG "t")))
(assert-equal (arcana/tokenize "#false") (list (cons 'TOKEN_TAG "false"))) (assert-equal (arcana/tokenize "#false") (list (cons 'TOKEN_TAG "false")))
(assert-equal (arcana/tokenize "#true") (list (cons 'TOKEN_TAG "true"))) (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_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 "\"\"") (list (cons 'TOKEN_STRING "")))
(assert-equal (arcana/tokenize "\"qwe\"") (list (cons 'TOKEN_STRING "qwe"))) (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 (assert-equal
(arcana/tokenize "(displayln \"qwe\")") (arcana/tokenize "(displayln \"qwe\")")
(list (list
(cons 'TOKEN_ROUND_OPEN "(") (cons 'TOKEN_ROUND_OPEN "(")
(cons 'TOKEN_IDENT "displayln") (cons 'TOKEN_IDENT "displayln")
(cons 'TOKEN_STRING "qwe") (cons 'TOKEN_STRING "qwe")
(cons 'TOKEN_ROUND_CLOSE ")"))) (cons 'TOKEN_ROUND_CLOSE ")")))
(assert-equal (assert-equal
(arcana/tokenize "(displayln (list 1))") (arcana/tokenize "(displayln (list 1))")
(list (list
(cons 'TOKEN_ROUND_OPEN "(") (cons 'TOKEN_ROUND_OPEN "(")
@ -47,4 +46,3 @@
(cons 'TOKEN_NUM "1") (cons 'TOKEN_NUM "1")
(cons 'TOKEN_ROUND_CLOSE ")") (cons 'TOKEN_ROUND_CLOSE ")")
(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 'null (arcana/typeof '())) (assert-equal 'procedure (arcana/typeof +))
(assert-equal 'procedure (arcana/typeof +)) (assert-equal 'pair (arcana/typeof (cons 123 456)))
(assert-equal 'pair (arcana/typeof (cons 123 456))) (assert-equal 'boolean (arcana/typeof #false))
(assert-equal 'boolean (arcana/typeof #false)) ;(assert-equal 'char (arcana/typeof #\n))
;(assert-equal 'char (arcana/typeof #\n)) (assert-equal 'symbol (arcana/typeof 'foo))
(assert-equal 'symbol (arcana/typeof 'foo)) (assert-equal 'string (arcana/typeof "foo"))
(assert-equal 'string (arcana/typeof "foo")) (assert-equal 'number (arcana/typeof 123))
(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)) (assert-equal #true (= 123 123))
(assert-equal #true (= 123 123)) (assert-equal #false (= 123 456))
(assert-equal #false (= 123 456)) (assert-equal #true (= 123 123 123))
(assert-equal #true (= 123 123 123)) (assert-equal #false (= 456 123 123))
(assert-equal #false (= 456 123 123)) (assert-equal #false (= 123 456 123))
(assert-equal #false (= 123 456 123)) (assert-equal #false (= 123 123 456))
(assert-equal #false (= 123 123 456)) (assert-equal #true (= 123 123 123 123))
(assert-equal #true (= 123 123 123 123)) (assert-equal #false (= 456 123 123 123))
(assert-equal #false (= 456 123 123 123)) (assert-equal #false (= 123 456 123 123))
(assert-equal #false (= 123 456 123 123)) (assert-equal #false (= 123 123 456 123))
(assert-equal #false (= 123 123 456 123)) (assert-equal #false (= 123 123 123 456))
(assert-equal #false (= 123 123 123 456))
;;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal 0 (+)) (assert-equal 0 (+))
(assert-equal 123 (+ 123)) (assert-equal 123 (+ 123))
(assert-equal 11 (+ 1 10)) (assert-equal 11 (+ 1 10))
(assert-equal 111 (+ 1 10 100)) (assert-equal 111 (+ 1 10 100))
(assert-equal 1111 (+ 1 10 100 1000)) (assert-equal 1111 (+ 1 10 100 1000))
;;; - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal 0 (- 0)) (assert-equal 0 (- 0))
;(assert-equal -123 (- 123)) ;(assert-equal -123 (- 123))
(assert-equal 99 (- 100 1)) (assert-equal 99 (- 100 1))
(assert-equal 97 (- 100 1 2)) (assert-equal 97 (- 100 1 2))
(assert-equal 94 (- 100 1 2 3)) (assert-equal 94 (- 100 1 2 3))
(assert-equal 90 (- 100 1 2 3 4)) (assert-equal 90 (- 100 1 2 3 4))
)

18
tests/basic_data_structs.scm
View file

@ -1,12 +1,10 @@
(begin ;;; car ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; car ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (assert-equal 123 (car (cons 123 456)))
(assert-equal 123 (car (cons 123 456)))
;;; cdr ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; cdr ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal 456 (cdr (cons 123 456))) (assert-equal 456 (cdr (cons 123 456)))
;;; list ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; list ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal '() (list)) (assert-equal '() (list))
(assert-equal '(123) (list 123)) (assert-equal '(123) (list 123))
(assert-equal '(123 456) (list 123 456)) (assert-equal '(123 456) (list 123 456))
)

108
tests/equiv.scm
View file

@ -1,55 +1,53 @@
(begin ;;; equal? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; equal? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; No args
; No args (assert-true (equal?))
(assert-true (equal?)) ; A single arg
; A single arg (assert-true (equal? '()))
(assert-true (equal? '())) (assert-true (equal? +))
(assert-true (equal? +)) (assert-true (equal? (cons 123 456)))
(assert-true (equal? (cons 123 456))) (assert-true (equal? #false))
(assert-true (equal? #false)) (assert-true (equal? #true))
(assert-true (equal? #true)) ;(assert-true (equal? #\n))
;(assert-true (equal? #\n)) (assert-true (equal? 'foo))
(assert-true (equal? 'foo)) (assert-true (equal? "foo"))
(assert-true (equal? "foo")) (assert-true (equal? 123))
(assert-true (equal? 123)) ; Two equal args
; Two equal args (assert-true (equal? '() '()))
(assert-true (equal? '() '())) (assert-true (equal? + +))
(assert-true (equal? + +)) (assert-true (equal? (cons 123 456) (cons 123 456)))
(assert-true (equal? (cons 123 456) (cons 123 456))) (assert-true (equal? #false #false))
(assert-true (equal? #false #false)) (assert-true (equal? #true #true))
(assert-true (equal? #true #true)) ;(assert-true (equal? #\n #\n))
;(assert-true (equal? #\n #\n)) (assert-true (equal? 'foo 'foo))
(assert-true (equal? 'foo 'foo)) (assert-true (equal? "foo" "foo"))
(assert-true (equal? "foo" "foo")) (assert-true (equal? 123 123))
(assert-true (equal? 123 123)) ; Two different args
; Two different args (assert-false (equal? '() '(1)))
(assert-false (equal? '() '(1))) (assert-false (equal? + -))
(assert-false (equal? + -)) (assert-false (equal? (cons 123 456) (cons 123 789)))
(assert-false (equal? (cons 123 456) (cons 123 789))) (assert-false (equal? #false #true))
(assert-false (equal? #false #true)) (assert-false (equal? #true #false))
(assert-false (equal? #true #false)) ;(assert-false (equal? #\n #\t))
;(assert-false (equal? #\n #\t)) (assert-false (equal? 'foo 'bar))
(assert-false (equal? 'foo 'bar)) (assert-false (equal? "foo" "bar"))
(assert-false (equal? "foo" "bar")) (assert-false (equal? 123 789))
(assert-false (equal? 123 789)) ; Three equal args
; Three equal args (assert-true (equal? '() '() '()))
(assert-true (equal? '() '() '())) (assert-true (equal? + + +))
(assert-true (equal? + + +)) (assert-true (equal? (cons 123 456) (cons 123 456) (cons 123 456)))
(assert-true (equal? (cons 123 456) (cons 123 456) (cons 123 456))) (assert-true (equal? #false #false #false))
(assert-true (equal? #false #false #false)) (assert-true (equal? #true #true #true))
(assert-true (equal? #true #true #true)) ;(assert-true (equal? #\n #\n #\n))
;(assert-true (equal? #\n #\n #\n)) (assert-true (equal? 'foo 'foo 'foo))
(assert-true (equal? 'foo 'foo 'foo)) (assert-true (equal? "foo" "foo" "foo"))
(assert-true (equal? "foo" "foo" "foo")) (assert-true (equal? 123 123 123))
(assert-true (equal? 123 123 123)) ; Three different args
; Three different args (assert-false (equal? '() '() '(1)))
(assert-false (equal? '() '() '(1))) (assert-false (equal? + + -))
(assert-false (equal? + + -)) (assert-false (equal? (cons 123 456) (cons 123 456) (cons 123 789)))
(assert-false (equal? (cons 123 456) (cons 123 456) (cons 123 789))) (assert-false (equal? #false #false #true))
(assert-false (equal? #false #false #true)) (assert-false (equal? #true #true #false))
(assert-false (equal? #true #true #false)) ;(assert-false (equal? #\n #\n #\t))
;(assert-false (equal? #\n #\n #\t)) (assert-false (equal? 'foo 'foo 'bar))
(assert-false (equal? 'foo 'foo 'bar)) (assert-false (equal? "foo" "foo" "bar"))
(assert-false (equal? "foo" "foo" "bar")) (assert-false (equal? 123 123 789))
(assert-false (equal? 123 123 789))
)

20
tests/logic_ops.scm
View file

@ -1,11 +1,9 @@
(begin ;; not ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; not ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (assert-false (not '()))
(assert-false (not '())) (assert-false (not #true))
(assert-false (not #true)) (assert-true (not #false))
(assert-true (not #false)) ;(assert-false (not #\n))
;(assert-false (not #\n)) (assert-false (not 'foo))
(assert-false (not 'foo)) (assert-false (not "foo"))
(assert-false (not "foo")) (assert-false (not 123))
(assert-false (not 123)) (assert-false (not (cons 123 456)))
(assert-false (not (cons 123 456)))
)

64
tests/syntax.scm
View file

@ -1,18 +1,17 @@
(begin ;;; begin ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; begin ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (assert-equal '() (begin))
(assert-equal '() (begin)) (assert-equal 123 (begin 123))
(assert-equal 123 (begin 123)) (assert-equal 456 (begin 123 456))
(assert-equal 456 (begin 123 456)) (assert-equal 789 (begin 123 456 789))
(assert-equal 789 (begin 123 456 789))
;;; define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal (assert-equal
'(123 579) '(123 579)
(begin (begin
(define x 123) (define x 123)
(define y (+ x 456)) (define y (+ x 456))
(list x y))) (list x y)))
(assert-equal (assert-equal
'(123 456) '(123 456)
(begin (begin
(define x 123) (define x 123)
@ -20,28 +19,27 @@
(define x 456) (define x 456)
(list old x))) (list old x)))
;;; if ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; if ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal 123 (if #true 123 456)) (assert-equal 123 (if #true 123 456))
(assert-equal 123 (if "foo" 123 456)) (assert-equal 123 (if "foo" 123 456))
(assert-equal 456 (if #false 123 456)) (assert-equal 456 (if #false 123 456))
;;; quote ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; quote ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal '+ (quote +)) (assert-equal '+ (quote +))
(assert-equal '+ '+) (assert-equal '+ '+)
(assert-equal '() (quote ())) (assert-equal '() (quote ()))
(assert-equal '() '()) (assert-equal '() '())
(assert-equal #true (quote #true)) (assert-equal #true (quote #true))
(assert-equal #true '#true) (assert-equal #true '#true)
(assert-equal #false (quote #false)) (assert-equal #false (quote #false))
(assert-equal #false '#false) (assert-equal #false '#false)
;(assert-equal #\n (quote #\n)) ;(assert-equal #\n (quote #\n))
;(assert-equal #\n '#\n) ;(assert-equal #\n '#\n)
(assert-equal 'foo (quote foo)) (assert-equal 'foo (quote foo))
(assert-equal 'foo 'foo) (assert-equal 'foo 'foo)
(assert-equal "foo" (quote "foo")) (assert-equal "foo" (quote "foo"))
(assert-equal "foo" '"foo") (assert-equal "foo" '"foo")
(assert-equal 123 (quote 123)) (assert-equal 123 (quote 123))
(assert-equal 123 '123) (assert-equal 123 '123)
(assert-equal '(cons 123 456) (quote (cons 123 456))) (assert-equal '(cons 123 456) (quote (cons 123 456)))
(assert-equal '(cons 123 456) '(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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; number->string ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (assert-equal "123" (number->string 123))
(assert-equal "123" (number->string 123)) ;(assert-equal "-123" (number->string -123))
;(assert-equal "-123" (number->string -123)) (assert-equal "1e240" (number->string 123456 16))
(assert-equal "1e240" (number->string 123456 16))
;;; string->symbol ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; string->symbol ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(assert-equal '|| (string->symbol "")) ;(assert-equal '|| (string->symbol ""))
;(assert-equal '| | (string->symbol " ")) ;(assert-equal '| | (string->symbol " "))
(assert-equal 'foo (string->symbol "foo")) (assert-equal 'foo (string->symbol "foo"))
;;; symbol->string ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; symbol->string ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal "foo" (symbol->string 'foo)) (assert-equal "foo" (symbol->string 'foo))
)

162
tests/type_preds.scm
View file

@ -1,89 +1,87 @@
(begin ;;; boolean? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; boolean? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (assert-false (boolean? +))
(assert-false (boolean? +)) (assert-false (boolean? '()))
(assert-false (boolean? '())) (assert-true (boolean? #true))
(assert-true (boolean? #true)) (assert-true (boolean? #false))
(assert-true (boolean? #false)) ;(assert-false (boolean? #\n))
;(assert-false (boolean? #\n)) (assert-false (boolean? 'foo))
(assert-false (boolean? 'foo)) (assert-false (boolean? "foo"))
(assert-false (boolean? "foo")) (assert-false (boolean? 123))
(assert-false (boolean? 123)) (assert-false (boolean? (cons 123 456)))
(assert-false (boolean? (cons 123 456)))
;;; char? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; char? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-false (char? +)) (assert-false (char? +))
(assert-false (char? '())) (assert-false (char? '()))
(assert-false (char? #true)) (assert-false (char? #true))
(assert-false (char? #false)) (assert-false (char? #false))
;(assert-true (char? #\n)) ;(assert-true (char? #\n))
(assert-false (char? 'foo)) (assert-false (char? 'foo))
(assert-false (char? "foo")) (assert-false (char? "foo"))
(assert-false (char? 123)) (assert-false (char? 123))
(assert-false (char? (cons 123 456))) (assert-false (char? (cons 123 456)))
;;; null? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; null? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-false (null? +)) (assert-false (null? +))
(assert-true (null? '())) (assert-true (null? '()))
(assert-false (null? #true)) (assert-false (null? #true))
(assert-false (null? #false)) (assert-false (null? #false))
;(assert-false (null? #\n)) ;(assert-false (null? #\n))
(assert-false (null? 'foo)) (assert-false (null? 'foo))
(assert-false (null? "foo")) (assert-false (null? "foo"))
(assert-false (null? 123)) (assert-false (null? 123))
(assert-false (null? (cons 123 456))) (assert-false (null? (cons 123 456)))
;;; number? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; number? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-false (number? +)) (assert-false (number? +))
(assert-false (number? '())) (assert-false (number? '()))
(assert-false (number? #true)) (assert-false (number? #true))
(assert-false (number? #false)) (assert-false (number? #false))
;(assert-false (number? #\n)) ;(assert-false (number? #\n))
(assert-false (number? 'foo)) (assert-false (number? 'foo))
(assert-false (number? "foo")) (assert-false (number? "foo"))
(assert-true (number? 123)) (assert-true (number? 123))
(assert-false (number? (cons 123 456))) (assert-false (number? (cons 123 456)))
;;; pair? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; pair? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-false (pair? +)) (assert-false (pair? +))
(assert-false (pair? '())) (assert-false (pair? '()))
(assert-false (pair? #true)) (assert-false (pair? #true))
(assert-false (pair? #false)) (assert-false (pair? #false))
;(assert-false (pair? #\n)) ;(assert-false (pair? #\n))
(assert-false (pair? 'foo)) (assert-false (pair? 'foo))
(assert-false (pair? "foo")) (assert-false (pair? "foo"))
(assert-false (pair? 123)) (assert-false (pair? 123))
(assert-true (pair? (cons 123 456))) (assert-true (pair? (cons 123 456)))
;;; procedure? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; procedure? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-true (procedure? +)) (assert-true (procedure? +))
(assert-false (procedure? '())) (assert-false (procedure? '()))
(assert-false (procedure? #true)) (assert-false (procedure? #true))
(assert-false (procedure? #false)) (assert-false (procedure? #false))
;(assert-false (procedure? #\n)) ;(assert-false (procedure? #\n))
(assert-false (procedure? 'foo)) (assert-false (procedure? 'foo))
(assert-false (procedure? "foo")) (assert-false (procedure? "foo"))
(assert-false (procedure? 123)) (assert-false (procedure? 123))
(assert-false (procedure? (cons 123 456))) (assert-false (procedure? (cons 123 456)))
;;; string? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; string? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-false (string? +)) (assert-false (string? +))
(assert-false (string? '())) (assert-false (string? '()))
(assert-false (string? #true)) (assert-false (string? #true))
(assert-false (string? #false)) (assert-false (string? #false))
;(assert-false (string? #\n)) ;(assert-false (string? #\n))
(assert-false (string? 'foo)) (assert-false (string? 'foo))
(assert-true (string? "foo")) (assert-true (string? "foo"))
(assert-false (string? 123)) (assert-false (string? 123))
(assert-false (string? (cons 123 456))) (assert-false (string? (cons 123 456)))
;;; symbol? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; symbol? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-false (symbol? +)) (assert-false (symbol? +))
(assert-false (symbol? '())) (assert-false (symbol? '()))
(assert-false (symbol? #true)) (assert-false (symbol? #true))
(assert-false (symbol? #false)) (assert-false (symbol? #false))
;(assert-false (symbol? #\n)) ;(assert-false (symbol? #\n))
(assert-true (symbol? 'foo)) (assert-true (symbol? 'foo))
(assert-false (symbol? "foo")) (assert-false (symbol? "foo"))
(assert-false (symbol? 123)) (assert-false (symbol? 123))
(assert-false (symbol? (cons 123 456))) (assert-false (symbol? (cons 123 456)))
)