(import srfi-69
        semen
        types)

(define print-str-fn
  '(fn print-str ((s string)) void
       (printf "%s" s)))

(define sum-fn
  '(pub fn sum ((a int) (b int)) float
        (return (cast (+ a b) float))))

(test-group "semen"
  (test-assert (sex-fn? print-str-fn))
  (test #f (sex-fn-public? print-str-fn))
  (test 'void (sex-fn-return-type print-str-fn))
  (test 'print-str (sex-fn-name print-str-fn))
  (test '((s string)) (sex-fn-arglist print-str-fn))
  (test '(fn print-str ((s string)) void) (sex-fn-prototype print-str-fn))
  (test '((printf "%s" s)) (sex-fn-body print-str-fn))

  (test-assert (sex-fn? sum-fn))
  (test #t (sex-fn-public? sum-fn))
  (test 'float (sex-fn-return-type sum-fn))
  (test 'sum (sex-fn-name sum-fn))
  (test '((a int) (b int)) (sex-fn-arglist sum-fn))
  (test '(pub fn sum ((a int) (b int)) float) (sex-fn-prototype sum-fn))
  (test '((return (cast (+ a b) float))) (sex-fn-body sum-fn))

  (test-assert (sex-fn? '(extern fn foo () void)))
  (test 'foo (sex-fn-name '(extern fn foo () void)))
  (test #f (sex-fn? '(struct point ((x int)))))

  (let ((sex-code
         '((defmacro (sum-var name a b c)
             `(var ,name ,(+ a b c)))

           (sum-var v 1 2 3))))

    (test '((var v 6)) (semen-process sex-code)))

;;; Macro expansion

  (define (form-identity form env)
    form)

  (test 'a (walk-form 'a form-identity (make-hash-table)))
  (test '(a b c) (walk-form '(a b c) form-identity (make-hash-table)))

  (test 'a (macro-expand 'a))
  (test '(a b c) (macro-expand '(a b c)))

  (let ((sex-code-macro
         '((defmacro (x10 a)
             `(* 10 ,a))

           (fn foo ((a int) (b int)) void
               (return (+ a (x10 b)))))))

    (test '((fn foo ((a int) (b int)) void
                (return (+ a (* 10 b)))))
          (semen-process sex-code-macro)))

;;; Docstrings are lifted out as comment forms sitting before the
;;; declaration. A string later in a body is left alone.

  (test '((comment "Greet NAME.")
          (fn greet ((name (* char))) void
              (printf "Hello %s!\n" name)))
        (semen-process
         '((fn greet ((name (* char))) void
               "Greet NAME."
               (printf "Hello %s!\n" name)))))

  (test '((comment "Public entry.")
          (pub fn main () int
               (return 0)))
        (semen-process
         '((pub fn main () int
                "Public entry."
                (return 0)))))

  ;; A prototype whose only "body" is a docstring stays a prototype
  (test '((comment "Forward.")
          (fn helper ((a int)) int))
        (semen-process
         '((fn helper ((a int)) int
               "Forward."))))

  (test '((fn f () void (g) "not a docstring"))
        (semen-process
         '((fn f () void (g) "not a docstring"))))

  ;; `;' comments before the string are skipped when looking for it,
  ;; and stay in the body
  (test '((comment "Kept.")
          (fn f () void (comment " note") (g)))
        (semen-process
         '((fn f () void (comment " note") "Kept." (g)))))

  (test '((comment "A 2D point.")
          (struct t-doc-pt ((x int) (y int))))
        (semen-process
         '((struct t-doc-pt "A 2D point." ((x int) (y int))))))

  (test '((x int) (y int))
        (get-fields 't-doc-pt))

  (test '((comment "RGB.")
          (enum t-doc-color (red green blue)))
        (semen-process
         '((enum t-doc-color "RGB." (red green blue)))))

  (test '((comment "Either.")
          (union t-doc-val ((i int) (f float))))
        (semen-process
         '((union t-doc-val "Either." ((i int) (f float))))))
)