Learning tests for Scheme

(define (test-alist-ref _)
  (let ((alst '((a 3) (b 2))))
    (⊦= '(3) (alist-ref 'a alst))
    (⊦= '(2) (alist-ref 'b alst))
    (⊦= #f (alist-ref 'c alst))))

((eta 0.0) (memory #(6291456 1367376 1048576)) (stdout "") (stderr ""))

(define (test/len _)
  (let ((my-strlen
          (foreign-lambda*
            int
            ((scheme-object cons))
            "C_return(C_header_size(cons));")))
    (⊦= 2 (my-strlen (cons 1 '())))
    (⊦= 2 (my-strlen (cons 1 (cons 2 (cons 3 '())))))
    (⊦= 4 (my-strlen "hello world"))))

((eta 0.0) (memory #(6291456 1368352 1048576)) (stdout "") (stderr ""))

(define (test/unquote _) (let1 (a '(3)) (⊦= (cons 1 a) `(1 unquote a))))

((eta 0.0) (memory #(6291456 1369952 1048576)) (stdout "") (stderr ""))

(define (test/c_callback _)
  (let ((witness (gensym))
        (my-strlen
          (foreign-safe-lambda*
            scheme-object
            ((scheme-object f))
            "\t\t\t\t\t  C_word res = C_callback(f, 0);\n\t\t\t\t\t  printf(\"from within a safe lambda\\n\");\n\t\t\t\t\t  C_return (res);")))
    (⊦= witness (car (my-strlen (lambda () (list witness 4)))))))

((eta 0.0) (memory #(6291456 1371104 1048576)) (stdout "") (stderr ""))

(define (test/foreign-safe-lambda*/allocate_string/inline _)
  (let1 (allocate_string
          (foreign-safe-lambda*
            scheme-object
            ()
            "                            char* str = \"hello world\";\n                            C_word length = strlen(str);\n                            C_word* ptr = C_alloc (C_SIZEOF_STRING (length));\n                            C_word res = C_string (&ptr, length, str);\n                            C_return (res);"))
        (⊦= "hello world" (allocate_string))))

((eta 0.0) (memory #(6291456 1372328 1048576)) (stdout "") (stderr ""))

(define (test/foreign-primitive/allocate-string _)
  (let1 (allocate_string
          (foreign-primitive scheme-object () "C_my_allocate_string(C_k);"))
        (⊦= "hello world" (allocate_string))))

((eta 0.0) (memory #(6291456 1373976 1048576)) (stdout "") (stderr ""))

(define (test/foreign-safe-lambda/list-walk _)
  (let1 (list-walk
          (foreign-safe-lambda
            scheme-object
            "C_list_walk"
            scheme-object
            scheme-object))
        (⊦= '(1 2 3) (list-walk '(1 2 3) identity))))

((eta 0.0) (memory #(6291456 1375168 1048576)) (stdout "") (stderr ""))

(define (test/foreign/callout-callin _)
  (define callout (foreign-safe-lambda int "callout" int int int))
  (define-external
    (callin (scheme-object xyz))
    int
    (print "This is 'callin': " xyz)
    123)
  (⊦= 123 (callout 1 2 3)))

((eta 0.0)
 (memory #(6291456 1376992 1048576))
 (stdout "This is 'callin': (1 2 3)\n")
 (stderr ""))

(define (test/string/ref _) (⊦ equal? #\o (string-ref "hello" 4)))

((eta 0.0) (memory #(6291456 1378144 1048576)) (stdout "") (stderr ""))

(define (test/string/first _) (⊦ equal? #\h (first/string "hello")))

((eta 0.0) (memory #(6291456 1379304 1048576)) (stdout "") (stderr ""))

(define (test/string/last _) (⊦ equal? #\o (last/string "hello")))

((eta 0.0) (memory #(6291456 1380464 1048576)) (stdout "") (stderr ""))

(define (test/string/take-right _)
  (⊦ equal? "o" (string-take-right "hello" 1)))

((eta 0.0) (memory #(6291456 1381624 1048576)) (stdout "") (stderr ""))

(define (test-null-eq? _) (⊨ (eq? '() '())))

((eta 0.0) (memory #(6291456 1382768 1048576)) (stdout "") (stderr ""))

(define (test-last-syntax _)
  (define-syntax-rule (var-last body ... last) last)
  (⊦ equal? 'a (var-last 'a))
  (⊦ equal? 7 (var-last 'a (+ 3 4))))

((eta 0.0) (memory #(6291456 1383928 1048576)) (stdout "") (stderr ""))

(define (test-syntax-with-_ _)
  (define-syntax
    with-underscore
    (syntax-rules () ((_ body ...) (list '_ body ...))))
  (⊦ equal? '(_ a) (with-underscore 'a)))

((eta 0.0) (memory #(6291456 1385088 1048576)) (stdout "") (stderr ""))

(define (test-syntax-with-literal _)
  (define where +)
  (define-syntax-rule (literal where) (my-macro a where b) '(a b where))
  (⊦ equal? '(c d where) (my-macro c where d)))

((eta 0.0) (memory #(6291456 1386264 1048576)) (stdout "") (stderr ""))

(define (test-syntax-with-literal-and-ellipses _)
  (define-syntax-rule (literal :) (my-macro a ... : b ...) '((a ...) (b ...)))
  (⊦ equal? '((a b c) (d e)) (my-macro a b c : d e)))

((eta 0.0) (memory #(6291456 1387456 1048576)) (stdout "") (stderr ""))

(define (test-vec-syntax _)
  (define-syntax-rule
    (v-aux (v #(x z ... y)) body ...)
    (let1 (v (list z ...)) body ...))
  (⊦ equal? '(0 2) (v-aux (v #(1 2 3)) (cons 0 v))))

((eta 0.0) (memory #(6291456 1388608 1048576)) (stdout "") (stderr ""))