;;; tests/ast-ir-smoke.el --- quick check that ast-ir.lisp lowers parse trees  -*- lexical-binding: t -*-
;;
;; Copyright (C) 2026 Anthony Green <green@moxielogic.com>
;; SPDX-License-Identifier: GPL-2.0-only WITH Classpath-exception-2.0
;;
;; Loads ast-ir.lisp under the elisp host (so the reader's
;; byte-vector symbol output is the same shape stage1's runtime sees)
;; and prints the lowered form for a few test inputs.

(require 'cl-lib)

(defvar funcl-test-root
  (file-name-directory
   (directory-file-name
    (file-name-directory (or load-file-name buffer-file-name)))))

(load (expand-file-name "elisp/compat.el"  funcl-test-root) nil 'nomessage)
(load (expand-file-name "src/cold/buffer.lisp"  funcl-test-root) nil 'nomessage)
(load (expand-file-name "src/cold/reader.lisp"  funcl-test-root) nil 'nomessage)
(load (expand-file-name "src/cold/ast-ir.lisp"  funcl-test-root) nil 'nomessage)

(defun ast-ir-smoke--bv-from-string (s)
  (let ((bv (make-byte-vector)))
    (dotimes (i (length s))
      (byte-vector-push bv (aref s i)))
    bv))

(defun ast-ir-smoke--bv-to-string (bv)
  (with-current-buffer bv
    (buffer-substring-no-properties (point-min) (point-max))))

(defun ast-ir-smoke--render (node)
  "Pretty-print a lowered AST-IR node by tag."
  (cond
    ((null node) "nil")
    ((not (consp node)) (format "%S" node))
    (t
     (let ((tag (car node))
           (rest (cdr node)))
       (cond
         ((= tag 0) (format "(int %S)" rest))
         ((= tag 1) "(nil)")
         ((= tag 2) "(t)")
         ((= tag 3) (format "(var %S)" (ast-ir-smoke--bv-to-string rest)))
         ((= tag 4)
          (format "(call %S %s)"
                  (ast-ir-smoke--bv-to-string (car rest))
                  (mapconcat #'ast-ir-smoke--render (cdr rest) " ")))
         ((= tag 5)
          (format "(if %s %s %s)"
                  (ast-ir-smoke--render (car rest))
                  (ast-ir-smoke--render (car (cdr rest)))
                  (ast-ir-smoke--render (cdr (cdr rest)))))
         ((= tag 6)
          (format "(let %S %s %s)"
                  (ast-ir-smoke--bv-to-string (car rest))
                  (ast-ir-smoke--render (car (cdr rest)))
                  (ast-ir-smoke--render (cdr (cdr rest)))))
         ((= tag 7)
          (format "(progn %s)"
                  (mapconcat #'ast-ir-smoke--render rest " ")))
         ((= tag 8)
          (format "(quote ...)"))
         (t (format "(unknown-tag %S)" node)))))))

(defun ast-ir-smoke--run (label src)
  (let* ((bv (ast-ir-smoke--bv-from-string src))
         (parsed (car (reader-read-all-from-bv bv)))
         (lowered (ir-lower parsed)))
    (princ (format "%-20s %-40s → %s\n" label src
                   (ast-ir-smoke--render lowered)))))

(ast-ir-smoke--run "int"            "42")
(ast-ir-smoke--run "nil-atom"       "nil")
(ast-ir-smoke--run "t-atom"         "t")
(ast-ir-smoke--run "var"            "x")
(ast-ir-smoke--run "simple call"    "(+ 1 2)")
(ast-ir-smoke--run "nested call"    "(+ 1 (* 2 3))")
(ast-ir-smoke--run "if"             "(if (< x 0) 1 2)")
(ast-ir-smoke--run "let"            "(let ((x 7)) x)")
(ast-ir-smoke--run "let progn-body" "(let ((x 5)) (+ x 1) (+ x 2))")
(ast-ir-smoke--run "progn"          "(progn 1 2 3)")
(ast-ir-smoke--run "quote"          "'(1 2 3)")
(ast-ir-smoke--run "user call"      "(fact (- n 1))")

(kill-emacs 0)