preprocess.el

preprocess.el

(require 'ht)

(defun pp-nan (expr)
  (if (symbolp expr)
      (if (string-prefix-p "nan" (symbol-name expr))
	  "nan"
	(if (string-prefix-p "-nan" (symbol-name expr))
	    "-nan"
	  expr))
    expr))

(defun pp-const (val)
  (pcase val
    (`(f32.const ,const) (format "f32:%s" (pp-nan const)))
    (`(f64.const ,const) (format "f64:%s" (pp-nan const)))
    (`(i32.const ,const) (format "i32:%s" (pp-nan const)))
    (`(i64.const ,const) (format "i64:%s" (pp-nan const)))
    (_ (error "Invalid value expression"))))

(defun pp-invoke (expr)
  `(:function ,(nth 1 expr) :args ,(cl-coerce (mapcar #'pp-const (cddr expr)) 'vector)))

(defun pp-assert-return (expr)
  (cl-assert (eq (caadr expr) 'invoke))
  (let ((hash (ht<-plist (pp-invoke (nth 1 expr))))
	(rtrn (if (null (caddr expr)) nil
		(pp-const (caddr expr)))))
    (puthash "return" rtrn hash)
    hash))

(defun pp-assert-trap (expr)
  (cl-assert (eq (caadr expr) 'invoke))
  (let ((hash (ht<-plist (pp-invoke (nth 1 expr))))
	(trap-msg (caddr expr)))
    (puthash "trap" trap-msg hash)
    hash))

(defun pp-expr (expr)
  (pcase (car expr)
    ('assert_return (pp-assert-return expr))
    ((or 'assert_return_arithmetic_nan 'assert_return_canonical_nan)
     (pp-assert-return `(assert-return ,@  (cdr expr) (f64.const nan))))
    ('assert_trap (pp-assert-trap expr))
    (_ (error "Unrecognized expression"))))

(defun pp-kill-json (tests)
  (kill-new (json-encode (mapcar #'pp-expr tests))))