rs.lisp

;; When rs.lisp is loaded through cl-rust-generator.asd, package.lisp has
;; already created the package and ASDF has already pulled in alexandria.  The
;; block below only fires when somebody loads this file directly from a REPL.
(eval-when (:compile-toplevel :load-toplevel :execute)
  (unless (find-package :cl-rust-generator)
    (uiop:symbol-call :ql :quickload "alexandria")
    (eval (read-from-string
	   "(defpackage :cl-rust-generator
              (:use :cl :alexandria)
              (:export #:write-source #:emit-rs #:*rustfmt-program* #:*rustfmt-arguments*))"))))


(declaim (optimize (speed 0)
		   (safety 3)
		   (debug 3)))
					;(setf *features* (union *features* '(:generic-c)))
;(setf *features* (set-difference *features* '(:generic-c)))
(in-package :cl-rust-generator)

(setf (readtable-case *readtable*) :invert)

(defparameter *file-hashes* (make-hash-table :test #'equal))

(defparameter *rustfmt-program* "rustfmt"
  "Name (or absolute path) of the program used to format the generated Rust
code.  It is looked up in PATH.  Set to NIL to disable formatting.")

(defparameter *rustfmt-arguments* nil
  "Extra command line arguments handed to *RUSTFMT-PROGRAM*, e.g.
'(\"--edition\" \"2018\").  rustfmt defaults to edition 2015.")

(defun run-rustfmt (filename)
  "Format FILENAME in place with *RUSTFMT-PROGRAM*.  Missing or failing rustfmt
is reported as a warning; it never aborts code generation.  Returns the exit
code, or NIL when rustfmt could not be started."
  (when *rustfmt-program*
    (handler-case
	(multiple-value-bind (out err code)
	    (uiop:run-program (append (list *rustfmt-program*)
				      *rustfmt-arguments*
				      (list (namestring filename)))
			      :output nil
			      :error-output :string
			      :ignore-error-status t)
	  (declare (ignorable out))
	  (unless (eql 0 code)
	    (warn "~a failed on ~a (exit ~a): ~a" *rustfmt-program* filename code err))
	  code)
      (error (e)
	(warn "could not run ~a: ~a" *rustfmt-program* e)
	nil))))

(defun write-source (name code &optional (dir (user-homedir-pathname))
				 ignore-hash)
  "Emit CODE as Rust and write it to NAME (relative to DIR).  The file is only
touched when the generated text actually changed, then it is run through
rustfmt.  Returns the pathname that was written, or NIL when nothing changed."
  (let* ((fn (merge-pathnames (format nil "~a" name)
			      dir))
	 (code-str (emit-rs :code code))
	 (fn-key (namestring fn))
	 (code-hash (sxhash code-str)))
    (multiple-value-bind (old-code-hash exists) (gethash fn-key *file-hashes*)
      (when (or (not exists) ignore-hash (/= code-hash old-code-hash)
		(not (probe-file fn)))
	;; store the sxhash of the rust source in the hash table
	;; *file-hashes* with the full pathname as key
	(setf (gethash fn-key *file-hashes*) code-hash)
	(ensure-directories-exist fn)
	(with-open-file (s fn
			   :direction :output
			   :if-exists :supersede
			   :if-does-not-exist :create)
	  (write-sequence code-str s))
	(run-rustfmt fn)
	fn))))

;; http://clhs.lisp.se/Body/s_declar.htm
;; http://clhs.lisp.se/Body/d_type.htm

;; go through the body until no declare anymore



  ;; (declare (type int a b) (type float c)
  ;; (declare (values int &optional))
  ;; (declare (values int float &optional))

(defstruct type-definition
  (declaration)
  (mutable)
  (reference))



(defun type-definition-supersede-declaration (rname
					      hashtable decl
					      &optional (mutable t))
  "mutable by default"
  (multiple-value-bind (name ref) (remove-ampersand rname)
					;let*
    #+nil
   ((sname (format nil "~a" rname))
    (name (remove #\& sname))
    (ref  (< 0 (count #\& sname))))
   #+nil (format t "~a~%" `(:rname rname
				   :env
				   ,(loop for key being the hash-keys using (hash-value v) of hashtable collect `(,key ,v))))
   (multiple-value-bind (el exists) (gethash name hashtable)
     (if exists
	 (let ((m (type-definition-mutable el)))
	   (remhash name hashtable)
	   (setf (gethash name hashtable)
		 (make-type-definition :declaration  decl
				       :mutable m
				       :reference ref)))
	 (progn
	   
	   (setf (gethash name hashtable)
		 (make-type-definition :declaration decl :mutable mutable
				       :reference ref))
					;(format t "~a doesnt exist ~a~%" name `(:decl ,decl :entry ,(gethash name hashtable)))
	   )))))

(defun type-definition-supersede-mutable (rname hashtable mutable)
  (multiple-value-bind (name ref) (remove-ampersand rname)
   #+nil ((sname (format nil "~a" rname))
	(name (remove #\& sname))
	(ref  (< 0 (count #\& sname))))
    #+nil (format t "~a~%" `(:rname rname
			    :env
			    ,(loop for key being the hash-keys using (hash-value v) of hashtable collect `(,key ,v))))
    (multiple-value-bind (el exists) (gethash name hashtable)
     (if exists
	 (let ((decl (type-definition-declaration el)))
	   (remhash name hashtable)
	   (setf (gethash name hashtable)
		 (make-type-definition :declaration decl
				       :mutable mutable
				       :reference ref)))
	 (progn
					;(format t "~a doesnt exist~%" name)
	   (setf (gethash name hashtable)
		 (make-type-definition :declaration nil
				       :mutable mutable
				       :reference ref)))))))



(defun consume-declare (body &optional (mutable-default nil))
  "take a list of instructions from body, parse type declarations,
return the body without them and a hash table with an environment. the
entry return-values contains a list of return values.

CALLERS are responsible for stripping an optional leading Common Lisp
documentation string first; a plain string is otherwise a legitimate Rust
escape hatch form and must stay visible here."
  (let ((env (make-hash-table :test #'equalp))
	(looking-p t)
	(new-body nil))
    (loop for e in body do
	 (if looking-p
	     (if (listp e)
		 (if (eq (car e) 'declare)
		     (loop for declaration in (cdr e) do
			  ;(format t "declaration: ~a~%" declaration)
			  (cond 
			    ((eq (first declaration) 'type)
			     (destructuring-bind (symb type &rest vars) declaration
			       (declare (ignorable symb))
			       (loop for var in vars do
				    (type-definition-supersede-declaration
				     var env type mutable-default)
				    #+nil (type-definition-supersede-mutable
				     var env mutable-default))))
			    ((eq (first declaration) 'immutable)
			     (destructuring-bind (symb &rest vars) declaration
			       (declare (ignorable symb))
			       (loop for var in vars do
				    (type-definition-supersede-mutable
				     var env nil))))
			    ((eq (first declaration) 'mutable)
			     (destructuring-bind (symb &rest vars) declaration
			       (declare (ignorable symb))
			       (loop for var in vars do
				    (type-definition-supersede-mutable
				     var env t))))
			   
			    ((eq (first declaration) 'values)
			     (destructuring-bind (symb &rest types-opt) declaration
			       (declare (ignorable symb))
			       (let ((types nil))
				 ;; only collect types until occurrance of &optional
				 (loop for type in types-opt do
				      (unless (eq #\& (aref (format nil "~a" type) 0))
					(push type types)))
				 (setf (gethash 'return-values env) (reverse types)))))
			    (t (error "unknown declaration: ~a" declaration))))
		     (progn
		       (push e new-body)
		       (setf looking-p nil)))
		 (progn
		   (setf looking-p nil)
		   (push e new-body)))
	     (push e new-body)))
    (values (reverse new-body) env)))

(defun split-leading-docstring (body)
  "Split an optional Common Lisp documentation string from BODY.

Returns (values BODY-WITHOUT-DOCSTRING DOCSTRING).  Only a leading string
with at least one following form counts as a docstring; a lone string stays
part of the body so the Rust escape hatch still works in expression
position."
  (if (and (consp body)
		   (stringp (car body))
		   (cdr body))
      (values (cdr body) (car body))
      (values body nil)))

(defun remove-ampersand (rname)
  "Split a leading & off a variable or parameter name.  Returns (values NAME
REFERENCE-P) where NAME is a string without any & and REFERENCE-P tells whether
the original name asked for a Rust reference.  Lists (array type specifiers) are
passed through unchanged.

  (remove-ampersand '&x) => \"x\", T
  (remove-ampersand 'x)  => \"x\", NIL
  (remove-ampersand '(tuple a b)) => (tuple a b), NIL"
  (if (listp rname)
      (values rname nil)
      (let* ((sname (format nil "~a" rname))
	     (ref (< 0 (count #\& sname)))
	     (name (remove #\& sname)))
	(values name ref))))

(defun lookup-type (rname &key env)
  "get the type of a variable from an environment"
  (let* ((name (remove-ampersand rname))
	   (el (gethash name env)))
    #+nil (format t "search for ~a in ~a gives ~a ~%" name (loop for key being the hash-keys using (hash-value v) of env
							collect `(,key ,v))
	    el)
    el))


(defun rust-array-type (element-type dims emit)
  "Render a (possibly multi dimensional) Rust array type.
  (rust-array-type 'i32 '(4) emit)   => \"[i32; 4]\"
  (rust-array-type 'i32 '(2 3) emit) => \"[[i32; 3]; 2]\""
  (if (null dims)
      (funcall emit element-type)
      (format nil "[~a; ~a]"
	      (rust-array-type element-type (cdr dims) emit)
	      (funcall emit (car dims)))))

(defun variable-declaration (&key name env emit mutable-default)
  (let* ((name (remove-ampersand name))
	 (decl-m (lookup-type name :env env))
	 (type (when decl-m
		   (type-definition-declaration decl-m)))
	 (m (if decl-m
		(type-definition-mutable decl-m)
		mutable-default)))
    (with-output-to-string (s)
      (when m
	(format s "mut "))
      (if (listp type)
	  (if (null type)
	      (format s "~a" (funcall emit name))
	      ;; array
	      (destructuring-bind (array_ element-type &rest dims) type
		(assert (eq array_ 'array))
		(format s "~a: ~a"
			(funcall emit name)
			(rust-array-type element-type dims emit))))
	 (format s "~a~@[: ~a~]"
		 (funcall emit name)
		 (funcall emit type))))))

(defun render-parameter (rp env emit)
  "Render one entry of a DEFUN/LAMBDA lambda list as a Rust parameter.  When no
type declaration is known the entry is emitted verbatim, which is the escape
hatch used all over the examples for things like \"&mut self\" or
\"text: &str\".

Mutability is placed the way Rust wants it: a mutable binding of an owned value
is `mut x: T', a mutable reference is `x: &mut T'."
  (multiple-value-bind (p) (remove-ampersand rp)
    (let ((decl-m (lookup-type p :env env)))
      (if decl-m
	  (let ((declaration (type-definition-declaration decl-m))
		(m (type-definition-mutable decl-m))
		(ref (type-definition-reference decl-m)))
	    (with-output-to-string (s)
	      (when (and m (not ref))
		(format s "mut "))
	      (format s "~a: " (funcall emit p))
	      (when ref
		(format s "&"))
	      (when (and m ref)
		(format s "mut "))
	      (format s "~a" (funcall emit declaration))))
	  (funcall emit rp)))))

(defparameter *block-emitting-heads*
  '(progn block let let*)
  "Heads whose emission is already a bare {...} block.  A branch position
that would wrap one of these in another PROGN would emit a redundant
nested block ({{ ... }}), so the branch helpers splice it instead.")

(defun block-form-p (form)
  "True when FORM emits a bare {...} block on its own (PROGN, BLOCK, LET
or LET*).  Only single-form branch positions may splice such a form;
anything else still needs its own PROGN wrapper."
  (and (listp form)
       (member (car form) *block-emitting-heads* :test #'eq)
       t))

(defun emit-branch-block (form emit)
  "Emit single branch FORM as a block.  A bare-block form (PROGN, BLOCK,
LET, LET*) is emitted directly; anything else is wrapped in a PROGN so
the branch still gets its braces."
  (if (block-form-p form)
      (funcall emit form)
      (funcall emit `(progn ,form))))

(defun emit-body-block (forms emit)
  "Emit a multi-form branch BODY as a block.  A singleton bare-block
form is spliced (its braces become the branch braces); otherwise the
whole body is wrapped in a PROGN.  Empty bodies keep the old PROGN
behaviour."
  (if (and (= 1 (length forms))
	   (block-form-p (car forms)))
      (funcall emit (car forms))
      (funcall emit `(progn ,@forms))))


(defun parse-let (code emit &key (mutable-default nil))
  "let ({var | (var [init-form])}*) declaration* form*"
  (destructuring-bind (decls &rest body) (cdr code)
    (multiple-value-bind (body env) (consume-declare body mutable-default)
      (with-output-to-string (s)
	(format s "~a"
		(funcall emit
			`(progn
			  ,@(loop for decl in decls collect
				  (destructuring-bind (name &optional value)
				      (if (listp decl)
					  decl
					  (list decl))
				    (format nil "let ~a~@[ = ~a~];"
					    (variable-declaration
					     :name name :env env :emit emit
					     :mutable-default mutable-default)
					    (when value
					      (funcall emit value)))))
			  ,@body)))))))

(defun parse-defun (code emit &key header-only async)
  ;; defun function-name lambda-list [declaration*] form*
  ;; with ASYNC non-nil emit "async fn" (used by DEFUN-ASYNC).
  (destructuring-bind (name lambda-list &rest body) (cdr code)
    (multiple-value-bind (body docstring) (split-leading-docstring body)
      (declare (ignorable docstring))
      (multiple-value-bind (body env) (consume-declare body)
	(let ((req-param lambda-list))
	  (with-output-to-string (s)
	    (format s "~:[fn ~;async fn ~]~a~a~@[ -> ~a~]"
		    async
		    (funcall emit name)
		    (funcall emit `(paren
				    ,@(loop for rp in req-param collect
					    (render-parameter rp env emit))))
		    (let ((r (gethash 'return-values env)))
		      (if (< 1 (length r))
			  (funcall emit `(paren ,@r))
			  (when (car r)
			    (funcall emit (car r))))))
	    (unless header-only
	      (format s " ~a" (emit-body-block body emit)))))))))

(defun parse-lambda (code emit)
  ;;  lambda lambda-list [declaration*] form*
  ;; no return value:
  ;;  |a, b| {body}
  ;; with (declare (values f32)):
  ;;  |a: i32, b: f32| -> f32 { body }
  ;; captures are not modelled; use the `move' escape hatch by writing the
  ;; whole closure head as a string if you need it.
  (destructuring-bind (lambda-list &rest body) (cdr code)
    (multiple-value-bind (body docstring) (split-leading-docstring body)
      (declare (ignorable docstring))
      (multiple-value-bind (body env) (consume-declare body)
	(let ((req-param lambda-list))
	  (with-output-to-string (s)
	    (format s "|~a|~@[ -> ~a~]"
		    (funcall emit `(comma
				    ,@(loop for rp in req-param collect
					    (render-parameter rp env emit))))
		    (let ((r (gethash 'return-values env)))
		      (if (< 1 (length r))
			  (funcall emit `(paren ,@r))
			  (when (car r)
			    (funcall emit (car r))))))
	    (format s " ~a" (emit-body-block body emit))))))))





(defun clean-float-string (s)
  "Turn the output of ~G into something the Rust lexer accepts.  ~G pads its
result with blanks and happily produces \"0.\" or \".5\", none of which belongs
into generated source."
  (let ((s (string-trim '(#\Space #\Tab #\Newline) s)))
    (cond
      ;; "1." -> "1.0"
      ((and (< 0 (length s))
	    (char= #\. (aref s (1- (length s)))))
       (concatenate 'string s "0"))
      ;; "1.e+10" -> "1.0e+10"
      ((search ".e" s)
       (let ((p (search ".e" s)))
	 (concatenate 'string (subseq s 0 (1+ p)) "0" (subseq s (1+ p)))))
      ;; ".5" -> "0.5"
      ((and (< 0 (length s)) (char= #\. (aref s 0)))
       (concatenate 'string "0" s))
      ;; "1e10" (no dot at all) -> keep, Rust accepts 1e10
      (t s))))

(defun print-sufficient-digits-f32 (f)
  "print a single floating point number as a string with a given nr. of
  digits. parse it again and increase nr. of digits until the same bit
  pattern."
  (let* ((a f)
	 (digits 1)
	 (b (- a 1)))
    (unless (= a 0)
     (loop while (< 1d-6
		     (/ (abs (- a b))
		       (abs a))
		     ) do
	  (setf b (read-from-string (format nil "~,vG" digits a)))
	  (incf digits)))
    (clean-float-string (format nil "~,vG" digits a))))



(defun print-sufficient-digits-f64 (f)
  "print a double floating point number as a string with a given nr. of
  digits. parse it again and increase nr. of digits until the same bit
  pattern."

  (let* ((a f)
	 (digits 1)
	 (b (- a 1)))

    (unless (= a 0)			; (< (abs a) 1d-30)
      (loop while (< 1d-11
		     (/ (abs (- a b))
			(abs a))
		     ) do
	   (let ((str (format nil "~20,vG"  digits a))
		 (*read-default-float-format* 'double-float))
	     (setf b (read-from-string str)))
	   (incf digits)))
    (clean-float-string (format nil "~,v,,,,,'eG" digits a))))

			  
(defun top-level-comma-p (s)
  "True when S contains a comma at paren/bracket/brace depth 0.  Used to protect
tuple and argument lists from STRIP-OUTER-PARENS."
  (let ((depth 0))
    (loop for c across s
	  do (case c
	       ((#\( #\[ #\{) (incf depth))
	       ((#\) #\] #\}) (decf depth))
	       (#\, (when (<= depth 0) (return t))))
	  finally (return nil))))

(defun strip-outer-parens (s)
  "Remove one layer of enclosing parentheses from S if (and only if) the first
character is an opening paren that matches the last character and the content is
not a comma separated list.  Used where rustc's unused_parens lint would
otherwise complain about the parentheses that the operator forms add around
their result: if/while conditions, match subjects, for iterators, return values
and the right hand side of an assignment.

The scan is deliberately conservative: a paren inside a string literal makes the
depth count bail out early and S is returned unchanged.  A top level comma keeps
tuples such as (a, b) intact."
  (if (and (< 1 (length s))
	   (char= #\( (aref s 0))
	   (char= #\) (aref s (1- (length s))))
	   (let ((depth 0))
	     (loop for i below (length s)
		   do (case (aref s i)
			(#\( (incf depth))
			(#\) (decf depth)))
		   when (and (<= depth 0) (< i (1- (length s))))
		     do (return nil)
		   finally (return (= depth 0))))
	   (not (top-level-comma-p (subseq s 1 (1- (length s))))))
      (subseq s 1 (1- (length s)))
      s))

(defun emission-ends-with-semicolon-p (s)
  "True when the emitted string S already ends with a semicolon.
Unlike a bare (AREF S (1- (LENGTH S))) this is safe on empty emissions
\(e.g. (emit-rs :code nil) => \"\")."
  (and (< 0 (length s))
       (char= #\; (aref s (1- (length s))))))

;; -------------------------------------------------------------------
;; Operator precedence for *OMIT-REDUNDANT-PARENS*.
;;
;; Levels follow Table 5-1 of "Programming Rust" (see
;; operator-precedence.md): higher binds tighter.  The table only covers
;; operators the generator can emit; everything else is classified by
;; RUST-EXPRESSION-OPERATOR as :PRIMARY (self-delimited: calls, literals,
;; symbols, dot chains, ...) or :LOOSE (control flow, let, lambda, ...,
;; always parenthesised in omit mode).
;;
;; Rust specifics that differ from C: bitwise & ^ | bind TIGHTER than
;; comparisons, and comparisons and ranges cannot be chained at all
;; (a==b==c is a compile error, not (a==b)==c), hence associativity NON.
(defparameter *omit-redundant-parens* nil
  "When true, operator forms omit parentheses that Rust's precedence rules
make redundant: (+ (* a b) c) emits \"a * b + c\" instead of \"((a)*(b)+c)\".
When NIL (the default) every operator parenthesises its operands and its
result, so grouping is never ambiguous.  The fully parenthesised output is
the oracle: the value tests run in both modes and must compute the same
results.")

(defparameter *rust-precedence*
  '((-unary 15 left)
    (not 15 left) (deref 15 left) (ref 15 left) (ref-mut 15 left)
    (coerce 14 left)
    (* 13 left) (/ 13 left) (% 13 left)
    (+ 12 left) (- 12 left)
    (<< 11 left) (>> 11 left)
    (logand 10 left)
    (logxor 9 left)
    (logior 8 left)
    (== 7 non) (!= 7 non) (< 7 non) (<= 7 non) (> 7 non) (>= 7 non)
    (and 6 left) (or 5 left)
    (? 16 left))
  "Operator head -> (level associativity).  See *OMIT-REDUNDANT-PARENS*.
  Only heads with a CASE clause in EMIT-RS appear here: the single-character
  aliases & and ^ and the deprecated CAST were removed (use LOGAND, LOGXOR
  and COERCE, see MIGRATION.md).")

(defparameter *rust-associative-ops* '(+ * logand logior logxor or and)
  "Operators whose chains may stay flat on the right hand side: a+(b+c)
means the same as (a+b)+c (up to floating point rounding, documented).")

(defun rust-precedence-of (op)
  "Look up OP in *RUST-PRECEDENCE*.  Returns (values LEVEL ASSOC)."
  (let ((entry (assoc op *rust-precedence*)))
    (assert entry nil "no Rust precedence for operator ~a" op)
    (values (second entry) (third entry))))

(defparameter *rust-loose-heads*
  '(if when unless if-let while-let case for dotimes while loop
    return break continue
    let let* let-else setf = incf decf /= *= ^= %= <<= >>= &= \|=
    defun defun-async lambda impl use mod deftype struct
    defstruct0 defenum deftrait make-instance macroexpand attr
    do progn block do0 do0-no-final-semicolon stmt expr unsafe extern indent
    not deref ref ref-mut coerce quote)
  "Heads whose emission is not self-delimited (control flow, bindings,
items, blocks, prefix operators).  Anything else with a symbol head is
a plain (possibly macro) call and counts as :PRIMARY.")

(defun rust-expression-operator (form)
  "Classify FORM by the operator its emission binds with.  Returns one of:
:PRIMARY -- self-delimited, never needs parentheses as an operand
  (symbols, numbers, strings, calls, dot chains, aref, tuples, ranges,
  literals, the ? postfix operator);
:LOOSE -- control flow, bindings, lambdas and anything unknown: always
  parenthesised in omit mode;
or an operator head (a key of *RUST-PRECEDENCE*, or -UNARY for a
single-argument -).  A single-argument + is transparent and classifies as
its operand; a single-argument / (reciprocal) classifies as /.
(await x) and (? x) are postfix and likewise :PRIMARY."
  (cond ((atom form) :primary)
	((not (symbolp (car form))) :loose)
	((and (eq (car form) '-) (= 1 (length (cdr form)))) '-unary)
	((and (eq (car form) '+) (= 1 (length (cdr form))))
	 (rust-expression-operator (cadr form)))
	((and (eq (car form) '/) (= 1 (length (cdr form)))) '/)
	((assoc (car form) *rust-precedence*) (car form))
	((member (car form) '(dot aref paren tuple values bracket curly comma
			      scope angle space
			      range range-inclusive range-from range-to
			      range-to-inclusive range-full array-repeat
			      string string-r string-b char byte hex))
	 :primary)
	((member (car form) *rust-loose-heads*) :loose)
	;; Anything else with a symbol head is a plain call (f x),
	;; a macro call (vec![..], format!(..)), a path call
	;; (db::fetch(..)) or a constructor (Ok(..), Some(..)): all bind
	;; tighter than any operator, so no parentheses are needed.
	(:primary)))

(defun rust-operator-level (form)
  "Precedence level of FORM's own operator; :PRIMARY counts as top (16),
:LOOSE as bottom (-1)."
  (let ((op (rust-expression-operator form)))
    (cond ((eq op :primary) 16)
	  ((eq op :loose) -1)
	  (t (rust-precedence-of op)))))

(defun rust-operand-needs-parens-p (parent-op position form)
  "True when FORM, used as an operand of PARENT-OP at POSITION (:LEFT for
the first operand, :RIGHT for every other one), needs parentheses under
Rust's precedence rules.  Same-level nesting stays flat only for the same
left-associative operator on its preferred side (or a member of
*RUST-ASSOCIATIVE-OPS* on the right); comparisons never chain."
  (let ((child-op (rust-expression-operator form)))
    (cond ((eq child-op :primary) nil)
	  ((eq child-op :loose) t)
	  (t (multiple-value-bind (plevel passoc)
		 (rust-precedence-of parent-op)
	       (let ((clevel (rust-operator-level form)))
		 (cond ((< clevel plevel) t)
		       ((> clevel plevel) nil)
		       ((eq passoc 'non) t)
		       ((not (eq child-op parent-op)) t)
		       ((eq position :left) nil)
		       (t (not (member parent-op
				       *rust-associative-ops*))))))))))

(defun rust-unary-operand-needs-parens-p (parent-op form)
  "True when FORM needs parentheses under the unary operator PARENT-OP
\(one of -UNARY NOT DEREF REF REF-MUT).  A nested unary minus would glue
into the invalid --x, so minus inside minus is parenthesised; **p and !!x
are valid Rust and stay flat."
  (let ((child-op (rust-expression-operator form)))
    (cond ((eq child-op :primary) nil)
	  ((eq child-op :loose) t)
	  ((< (rust-operator-level form) 15) t)
	  ((> (rust-operator-level form) 15) nil)
	  ;; nested unary: only minus-minus needs help.
	  (t (or (eq parent-op '-unary) (eq child-op '-unary))))))

(defun rust-tight-operand-needs-parens-p (form)
  "True when FORM needs parentheses as the receiver of DOT, the object of
AREF or the operand of ?.  Those bind tighter than any binary or unary
operator: (dot (% a b) c) must stay ((a)%(b)).c, never a%b.c."
  (let ((child-op (rust-expression-operator form)))
    (cond ((eq child-op :primary) nil)
	  ((eq child-op :loose) t)
	  (t (< (rust-operator-level form) 16)))))

(defun rust-emit-operand (parent-op position form emit)
  "Emit FORM as an operand of PARENT-OP at POSITION, adding parentheses
when RUST-OPERAND-NEEDS-PARENS-P says so.  With *OMIT-REDUNDANT-PARENS*
NIL the form is emitted unchanged (callers add their full parentheses)."
  (let ((s (funcall emit form)))
    (if (and *omit-redundant-parens*
	     (rust-operand-needs-parens-p parent-op position form))
	(format nil "(~a)" s)
	s)))

(defun rust-emit-unary-operand (parent-op form emit)
  "Emit FORM as the operand of the unary operator PARENT-OP."
  (let ((s (funcall emit form)))
    (if (and *omit-redundant-parens*
	     (rust-unary-operand-needs-parens-p parent-op form))
	(format nil "(~a)" s)
	s)))

(defun rust-emit-tight-operand (form emit)
  "Emit FORM as a DOT receiver, AREF object or ? operand."
  (let ((s (funcall emit form)))
    (if (and *omit-redundant-parens*
	     (rust-tight-operand-needs-parens-p form))
	(format nil "(~a)" s)
	s)))

(defun rust-emit-operand-list (parent-op forms emit)
  "Emit FORMS as the operand list of PARENT-OP: first form :LEFT, rest
:RIGHT."
  (loop for form in forms
	for position = :left then :right
	collect (rust-emit-operand parent-op position form emit)))

(progn
  (defparameter *keywords-without-semicolon*
    `(;; forms that expand into a Rust item or a block expression used as a
      ;; statement.  Rust does not want (and clippy complains about) a
      ;; semicolon after those.
      defun defun-async defstruct0 defenum deftrait impl use mod attr
      if when unless if-let while-let case for dotimes while loop
      progn do do0 do0-no-final-semicolon stmt expr let-else
      extern unsafe macroexpand space let let*)
    "Heads of forms that must not get a semicolon appended by DO0.")
  (defun emit-rs (&key code (str nil)  (level 0) (hook-defun nil))
    "evaluate s-expressions in code, emit a string. if hook-defun is not nil, hook-defun will be called with every function definition. this functionality is intended to collect function declarations."
    (declare (ignorable str))
    (flet ((emit (code &optional (dl 0))
	     "change the indentation level. this is used in do"
	     (emit-rs :code code :level (+ dl level) :hook-defun hook-defun)))
      ;(format t "~a~%" code)
      (if code
	  (if (listp code)
	      (progn
		(case (car code)
		  
		  (comma
		   ;; comma {args}*
		   (let ((args (cdr code)))
		     (format nil "~{~a~^, ~}" (mapcar #'emit args))))
		  (semicolon
		   ;; semicolon {args}*
		   (let ((args (cdr code)))
		     (format nil "~{~a~^; ~}" (mapcar #'emit args))))
		  (space
		   ;; space {args}*
		   (let ((args (cdr code)))
		     (format nil "~{~a~^ ~}" (mapcar #'emit args))))
		  (angle
		   ;; angle {args}*
		   (let ((args (cdr code)))
		     (format nil "<~{~a~}>" (mapcar #'emit args))))
		  (paren
		   ;; paren {args}*
		   (let ((args (cdr code)))
		     (format nil "(~{~a~^, ~})" (mapcar #'emit args))))
		  (tuple
		   ;; tuple {args}*, same as paren
		   (let ((args (cdr code)))
		     (format nil "(~{~a~^, ~})" (mapcar #'emit args))))
		  (values
		   ;; values {args}* -- same as paren
		   (emit `(paren ,@(cdr code))))
		  (bracket
		   ;; bracket {args}*
		   (let ((args (cdr code)))
		     (format nil "[~{~a~^, ~}]" (mapcar #'emit args))))
		  (list
		   (emit `(bracket ,@(cdr code))))
		  (vec!
		   ;; (vec! a b) -> vec![a, b]; (vec!) -> vec![].
		   (let ((args (cdr code)))
		     (format nil "vec![~{~a~^, ~}]" (mapcar #'emit args))))
		  (curly
		   ;; curly {args}*
		   (let ((args (cdr code)))
		     (format nil "{~{~a~^, ~}}" (mapcar #'emit args))))
		  (make-instance
		   ;;https://doc.rust-lang.org/book/ch05-01-defining-structs.html
		   (let ((args (cdr code)))
		     (destructuring-bind (name &rest params) args
		       (emit `(space ,(emit name)
				     (curly
				      ,@(let ((i 0))
					  (loop while (< i (length params))  collect
					       (if (keywordp (elt params i))
						   (prog1
						     (format nil "~a: ~a"
							     (elt params i)
							     (emit (elt params (+ i 1))))
						     (incf i 2))
						   (prog1
						    (format nil "~a"
							    (emit (elt params i)))
						     (incf i)))))))))))
		  (macroexpand
		   (let ((args (cdr code)))
		     (destructuring-bind (name &rest params) args
		       (emit `(space ,(emit name)
				     (curly
				      ,@(let ((i 0))
					  (loop while (< i (length params))  collect
					       (if (keywordp (elt params i))
						   (prog1
						     (format nil "~a: ~a"
							     (elt params i)
							     (emit (elt params (+ i 1))))
						     (incf i 2))
						   (prog1
						    (format nil "~a"
							    (emit (elt params i)))
						    (incf i)))))))))))
		  (indent
		   ;; indent form
		   (format nil "~{~a~}~a"
			   ;; print indentation characters
			   (loop for i below level collect "    ")
			   (emit (cadr code))))
		  (impl (destructuring-bind (_impl name &rest body) code
			  (emit `(space impl
					,name
					(progn
					  ,@body)))))
		  (? (let ((args (cdr code)))
		       (if *omit-redundant-parens*
			   (format nil "~a?"
				   (rust-emit-tight-operand (car args) #'emit))
			   (format nil "~a?" (emit (car args))))))
		  (use
		   ;; use {(a b c)}*
		   ;; (use ((a b c) (q r))) => use a::b::c; use q::r
		   (let ((args (cdr code)))
		     (with-output-to-string (s)
			   (loop for e in args collect
				(format s "use ~{~a~^::~};~%" (mapcar #'emit e))))))
		  (mod
		   ;; mod {module}*
		   (let ((args (cdr code)))
			 (with-output-to-string (s)
			   (loop for e in args collect
			    (format s "mod ~a;~%" (emit e))))))
		  (do0 (with-output-to-string (s)
			 ;; do0 {form}*
			 ;; write each form into a newline, keep current indentation level
			 (format s "~{~&~a~}"
				 (mapcar
				  #'(lambda (x)
				      (let ((b (emit `(indent ,x) 0)))
					(format nil "~a~a"
						b
						;; don't add semicolon if there is already one
						;; or if x contains a string
						;; or if x is an s-expression with a c thing that doesn't end with semicolon
						(if (or (emission-ends-with-semicolon-p b)
							(and (typep x 'string))
							
							(and (listp x)
							     (member (car x)
								     *keywords-without-semicolon*
								     )))
						    "" 
						    ";"))))
				  (cdr code)))
			 #+nil
			 (let ((a (emit (cadr code))))
			   (format s "~&~a~a~{~&~a~}"
				   a
				   (if (eq #\; (aref a (- (length a) 1)))
				       ""
				       ";")
				   (mapcar
				    #'(lambda (x)
					(let ((b (emit `(indent ,x) 0)))
					  (format nil "~a~a"
						  b
						  (if (eq #\; (aref b (- (length b) 1)))
						      ""
						      ";"))))
				    (cddr code))))))
		  (do0-no-final-semicolon
		   (with-output-to-string (s)
		     ;; do0 {form}*
		     ;; write each form into a newline, keep current indentation level
		     (let ((count 0)
			   (args (cdr code)))
		      (format s "~{~&~a~}"
			      (mapcar
			       #'(lambda (x)
				   (prog1
				    (let ((b (emit `(indent ,x) 0)))
				      (format nil "~a~a"
					      b
					      ;; don't add semicolon if there is already one
					      ;; don't add semicolon after last statement
					      ;; or if x contains a string
					      ;; or if x is an s-expression with a c thing that doesn't end with semicolon
					      (if (or (emission-ends-with-semicolon-p b)
						      (and (typep x 'string))
						      (and (listp x)
							   (member (car x)
								   *keywords-without-semicolon*))
						      (= count (- (length args) 1)))
						  "" 
						  ";")))
				     (incf count)))
			       args)))))
		  (progn (with-output-to-string (s)
			   ;; progn {form}*
			   ;; like do but surrounds forms with braces.
			   ;; don't place semicolon after last statement (implicit return in rust)
			   ;; NOTE: all forms must go through ONE
			   ;; do0-no-final-semicolon.  Wrapping every form
			   ;; separately (as an earlier version did) makes every
			   ;; form the "last" one and drops all semicolons.
			   (format s "{~&~a~&}"
				   (emit `(do0-no-final-semicolon ,@(cdr code)) 1))))
		  (block (with-output-to-string (s)
			   ;; block {form}*
			   ;; like progn but with a semicolon after the last
			   ;; statement, i.e. the block evaluates to ().
			   ;; https://doc.rust-lang.org/reference/expressions/block-expr.html
			   (format s "{~&~a~&}"
				   (emit `(do0 ,@(cdr code)) 1))))
		  (do (with-output-to-string (s)
			;; do {form}*
			;; print each form on a new line with one more indentation.
			(format s "~a" (emit `(do0 ,@(cdr code)) 1))))
		  (stmt
		   ;; (stmt form) forces statement termination: emit FORM and
		   ;; append a semicolon unless there already is one.  This is
		   ;; the explicit override for escape-hatch forms such as
		   ;; (space ...) in statement position, where the semicolon
		   ;; heuristic (suffix check + head whitelist) cannot know
		   ;; whether the expansion is a statement or an expression.
		   (let ((s (emit (cadr code))))
		     (if (emission-ends-with-semicolon-p s)
			 s
			 (format nil "~a;" s))))
		  (expr
		   ;; (expr form) is the counterpart of STMT: it forces
		   ;; expression position, i.e. no semicolon is added.  Like
		   ;; STMT this is the explicit override for escape-hatch
		   ;; forms, for the tail of a PROGN (Rust's implicit return:
		   ;; a missing semicolon means "return this value").
		   (emit (cadr code)))
		  (defun
		      (prog1
			  (parse-defun code #'emit)
			(when hook-defun
			  (funcall hook-defun (parse-defun code #'emit :header-only t)))))
		  (defun-async
		      ;; defun-async name lambda-list [declaration*] form*
		      ;; like DEFUN but emits "async fn" (tokio/axum handlers).
		      (prog1
			  (parse-defun code #'emit :async t)
			(when hook-defun
			  (funcall hook-defun (parse-defun code #'emit :header-only t :async t)))))
		  (await
		   ;; (await expr) -> expr.await (outer parens stripped).
		   (format nil "~a.await" (strip-outer-parens (emit (cadr code)))))
		  (attr
		   ;; (attr attr-string* form) -> one #[attr] line per string, then form.
		   ;; (attr "derive(Clone, Debug)" (defstruct0 ...))
		   (let ((args (cdr code)))
		     (format nil "~{~a~^~%~}~%~a"
			     (mapcar (lambda (a) (format nil "#[~a]" (emit a)))
				     (butlast args))
			     (emit (car (last args))))))
		  (return (format nil "return ~a"
				  (strip-outer-parens (emit (car (cdr code))))))
		  (break
		   ;; break [value]
		   (let ((args (cdr code)))
		     (format nil "break~@[ ~a~]" (when args (emit (car args))))))
		  (continue "continue")
		  (array-repeat (destructuring-bind (value count) (cdr code)
				;; (array-repeat value count) -> [value; count],
				;; the repeat array literal from Table 5-1.
				(format nil "[~a; ~a]" (emit value) (emit count))))
		  (range (destructuring-bind (a b) (cdr code)
			   ;; (range a b) -> (a..b), end-exclusive Rust range.
			   (format nil "(~a..~a)" (emit a) (emit b))))
		  (range-inclusive (destructuring-bind (a b) (cdr code)
				     ;; (range-inclusive a b) -> (a..=b)
				     (format nil "(~a..=~a)" (emit a) (emit b))))
		  (range-from (destructuring-bind (a) (cdr code)
				;; (range-from a) -> (a..)
				(format nil "(~a..)" (emit a))))
		  (range-to (destructuring-bind (b) (cdr code)
			      ;; (range-to b) -> (..b)
			      (format nil "(..~a)" (emit b))))
		  (range-to-inclusive (destructuring-bind (b) (cdr code)
					;; (range-to-inclusive b) -> (..=b)
					(format nil "(..=~a)" (emit b))))
		  (range-full
		   ;; (range-full) -> (..), the full range.
		   (assert (null (cdr code)) nil
			   "range-full takes no arguments: ~a" code)
		   "(..)")
		  (let (parse-let code #'emit :mutable-default nil))
		  (let* (parse-let code #'emit :mutable-default t))
		  (setf 
		   (let ((args (cdr code)))
		     ;; "setf {pair}*"
		     (format nil "~a"
			     (emit
			      `(do0 
				,@(loop for i below (length args) by 2 collect
				       (let ((a (elt args i))
					     (b (elt args (+ 1 i))))
					 `(= ,a ,b))))))))
		  ;; NOTE: the unary prefix operators wrap the WHOLE expression in
		  ;; parentheses, not just their operand.  `*(p).x' parses as
		  ;; `*((p).x)' in Rust, which is not what (dot (deref p) x) means.
		  
		  (not (if *omit-redundant-parens*
			   (format nil "!~a"
				   (rust-emit-unary-operand 'not (cadr code) #'emit))
			   (format nil "(!~a)" (emit (car (cdr code))))))
		  (deref (if *omit-redundant-parens*
			     (format nil "*~a"
				     (rust-emit-unary-operand 'deref (cadr code) #'emit))
			     (format nil "(*~a)" (emit (car (cdr code))))))
		  (ref (if *omit-redundant-parens*
			   (format nil "&~a"
				   (rust-emit-unary-operand 'ref (cadr code) #'emit))
			   (format nil "(&~a)" (emit (car (cdr code))))))
		  (ref-mut (if *omit-redundant-parens*
			       (format nil "&mut ~a"
				       (rust-emit-unary-operand 'ref-mut (cadr code) #'emit))
			       (format nil "(&mut ~a)" (emit (car (cdr code))))))
		  (scope (let ((args (cdr code)))
			   (format nil "~{~a~^::~}" (mapcar #'emit args))))
		  (+ (let ((args (cdr code)))
		       ;; + {summands}*
		       (if *omit-redundant-parens*
			   (format nil "~{~a~^ + ~}"
				   (rust-emit-operand-list '+ args #'emit))
			   (format nil "(~{~a~^+~})" (mapcar #'emit args)))))
		  (- (let ((args (cdr code)))
		       (if (eq 1 (length args))
			   (if *omit-redundant-parens*
			       (format nil "-~a"
				       (rust-emit-unary-operand
					'-unary (car args) #'emit))
			       (format nil "(-~a)" (emit (car args)))) ;; py
			   (if *omit-redundant-parens*
			       (format nil "~{~a~^ - ~}"
				       (rust-emit-operand-list '- args #'emit))
			       (format nil "(~{~a~^-~})" (mapcar #'emit args))))))
		  (* (let ((args (cdr code)))
		       (if *omit-redundant-parens*
			   (format nil "~{~a~^ * ~}"
				   (rust-emit-operand-list '* args #'emit))
			   (format nil "(~{(~a)~^*~})" (mapcar #'emit args)))))
		  (/ (let ((args (cdr code)))
		       (if (eq 1 (length args))
			   (if *omit-redundant-parens*
			       (format nil "1.0 / ~a"
				       (rust-emit-operand '/ :right (car args) #'emit))
			       (format nil "(1.0/(~a))" (emit (car args)))) ;; py
			   (if *omit-redundant-parens*
			       (format nil "~{~a~^ / ~}"
				       (rust-emit-operand-list '/ args #'emit))
			       (format nil "(~{(~a)~^/~})" (mapcar #'emit args))))))
		  
		  (logior (let ((args (cdr code))) ;; py
			    (if *omit-redundant-parens*
				(format nil "~{~a~^ | ~}"
					(rust-emit-operand-list 'logior args #'emit))
				(format nil "(~{(~a)~^ | ~})" (mapcar #'emit args)))))
		  (logand (let ((args (cdr code))) ;; py
			    (if *omit-redundant-parens*
				(format nil "~{~a~^ & ~}"
					(rust-emit-operand-list 'logand args #'emit))
				(format nil "(~{(~a)~^ & ~})" (mapcar #'emit args)))))
		  (logxor (let ((args (cdr code))) ;; py
			    (if *omit-redundant-parens*
				(format nil "~{~a~^ ^ ~}"
					(rust-emit-operand-list 'logxor args #'emit))
				(format nil "(~{(~a)~^ ^ ~})" (mapcar #'emit args)))))
		  (or (let ((args (cdr code)))
			(if *omit-redundant-parens*
			    (format nil "~{~a~^ || ~}"
				    (rust-emit-operand-list 'or args #'emit))
			    (format nil "(~{(~a)~^||~})" (mapcar #'emit args)))))
		  (and (let ((args (cdr code)))
			 (if *omit-redundant-parens*
			     (format nil "~{~a~^ && ~}"
				     (rust-emit-operand-list 'and args #'emit))
			     (format nil "(~{(~a)~^&&~})" (mapcar #'emit args)))))
		  (= (destructuring-bind (a b) (cdr code)
		       ;; = pair
		       (format nil "~a=~a" (emit a)
			       (strip-outer-parens (emit b)))))
		  (/= (destructuring-bind (a b) (cdr code)
			;; NOTE: this is division-assignment (a /= b), NOT the
			;; Common Lisp "not equal".  Use != for a comparison.
			(format nil "~a/=(~a)" (emit a) (emit b))))
		  (*= (destructuring-bind (a b) (cdr code)
			(format nil "~a*=(~a)" (emit a) (emit b))))
		  (^= (destructuring-bind (a b) (cdr code)
			(format nil "(~a)^=(~a)" (emit a) (emit b))))
		  (<<= (destructuring-bind (a b) (cdr code)
			 ;; (<<= place value) is shift-left-assignment.
			 (format nil "~a<<=(~a)" (emit a) (emit b))))
		  (>>= (destructuring-bind (a b) (cdr code)
			 ;; (>>= place value) is shift-right-assignment.
			 (format nil "~a>>=(~a)" (emit a) (emit b))))
		  (&= (destructuring-bind (a b) (cdr code)
			;; (&= place value) is bitwise-and-assignment.
			(format nil "~a&=(~a)" (emit a) (emit b))))
		  (\|= (destructuring-bind (a b) (cdr code)
			 ;; (\|= place value) is bitwise-or-assignment.
			 (format nil "~a|=(~a)" (emit a) (emit b))))
		  ;; NOTE: binary operators parenthesise their RESULT as well as
		  ;; their operands.  Without the outer pair
		  ;;   (dot (% a b) c) -> (a)%(b).c
		  ;; which Rust parses as (a)%((b).c), because `.' binds tighter
		  ;; than any binary operator.  The redundant parentheses in
		  ;; if/while conditions are removed again by STRIP-OUTER-PARENS.
		  (<= (destructuring-bind (a b) (cdr code)
			(if *omit-redundant-parens*
			    (format nil "~a <= ~a"
				    (rust-emit-operand '<= :left a #'emit)
				    (rust-emit-operand '<= :right b #'emit))
			    (format nil "((~a)<=(~a))" (emit a) (emit b)))))
		  (>= (destructuring-bind (a b) (cdr code)
			(if *omit-redundant-parens*
			    (format nil "~a >= ~a"
				    (rust-emit-operand '>= :left a #'emit)
				    (rust-emit-operand '>= :right b #'emit))
			    (format nil "((~a)>=(~a))" (emit a) (emit b)))))
		  (!= (destructuring-bind (a b) (cdr code)
			(if *omit-redundant-parens*
			    (format nil "~a != ~a"
				    (rust-emit-operand '!= :left a #'emit)
				    (rust-emit-operand '!= :right b #'emit))
			    (format nil "((~a)!=(~a))" (emit a) (emit b)))))
		  (== (destructuring-bind (a b) (cdr code)
			(if *omit-redundant-parens*
			    (format nil "~a == ~a"
				    (rust-emit-operand '== :left a #'emit)
				    (rust-emit-operand '== :right b #'emit))
			    (format nil "((~a)==(~a))" (emit a) (emit b)))))
		  (< (destructuring-bind (a b) (cdr code)
		       (if *omit-redundant-parens*
			   (format nil "~a < ~a"
				   (rust-emit-operand '< :left a #'emit)
				   (rust-emit-operand '< :right b #'emit))
			   (format nil "((~a)<(~a))" (emit a) (emit b)))))
		  (> (destructuring-bind (a b) (cdr code)
		       (if *omit-redundant-parens*
			   (format nil "~a > ~a"
				   (rust-emit-operand '> :left a #'emit)
				   (rust-emit-operand '> :right b #'emit))
			   (format nil "((~a)>(~a))" (emit a) (emit b)))))
		  (% (destructuring-bind (a b) (cdr code)
		       (if *omit-redundant-parens*
			   (format nil "~a % ~a"
				   (rust-emit-operand '% :left a #'emit)
				   (rust-emit-operand '% :right b #'emit))
			   (format nil "((~a)%(~a))" (emit a) (emit b)))))
		  (<< (destructuring-bind (a &rest rest) (cdr code)
			(if *omit-redundant-parens*
			    (format nil "~{~a~^ << ~}"
				    (rust-emit-operand-list '<< (cons a rest) #'emit))
			    (format nil "((~a)~{<<(~a)~})" (emit a) (mapcar #'emit rest)))))
		  (>> (destructuring-bind (a &rest rest) (cdr code)
			(if *omit-redundant-parens*
			    (format nil "~{~a~^ >> ~}"
				    (rust-emit-operand-list '>> (cons a rest) #'emit))
			    (format nil "((~a)~{>>(~a)~})" (emit a) (mapcar #'emit rest)))))
		  #+nil (>> (destructuring-bind (a b) (cdr code)
			      (format nil "(~a)>>~a" (emit a) (emit b))))
		  (incf (destructuring-bind (a &optional (b 1)) (cdr code) ;; py
			  (format nil "~a += ~a" (emit a) (emit b))
			  ))
		  (%= (destructuring-bind (a &optional (b 1)) (cdr code) 
			  (format nil "~a %= ~a" (emit a) (emit b))
			  ))
		  (decf (destructuring-bind (a &optional (b 1)) (cdr code)
			  (format nil "~a -= ~a" (emit a) (emit b))
			  ))
		  (byte  (format nil "b'~a'" (cadr code)))
		  (string (format nil "\"~a\"" (cadr code)))
		  (string-b (format nil "b\"~a\"" (cadr code)))
		  ;; string-r  ->  raw string literal r#"..."#
		  ;; enough hashes are added so that the payload may itself
		  ;; contain quote-hash sequences.  (The old STRING# alias
		  ;; was removed; see MIGRATION.md.)
		  (string-r
		   (let* ((str (cadr code))
			  (n-of-hash (count #\# str))
			  (list-of-hash (loop for i upto n-of-hash collect "#")))
		     (format nil "r~{~a~}\"~a\"~{~a~}"
			     list-of-hash
			     str
			     list-of-hash)))
		  (char (format nil "'~a'" (cadr code)))
		  (hex (destructuring-bind (number) (cdr code)
			 (format nil "0x~x" number)))
		  (if (destructuring-bind (condition true-statement &optional false-statement) (cdr code)
			(with-output-to-string (s)
			  (format s "if ~a ~a"
				  (strip-outer-parens (emit condition))
				  (emit-branch-block true-statement #'emit))
			  (when false-statement
			    (format s " else ~a"
				    (emit-branch-block false-statement #'emit))))))
		  (when (destructuring-bind (condition &rest forms) (cdr code)
			  ;; like IF but with an implicit body block, so several
			  ;; forms can be given
			  (format nil "if ~a ~a"
				  (strip-outer-parens (emit condition))
				  (emit-body-block forms #'emit))))
		  (unless (destructuring-bind (condition &rest forms) (cdr code)
			    (format nil "if ~a ~a"
				    (strip-outer-parens (emit `(not ,condition)))
				    (emit-body-block forms #'emit))))
		  (if-let
		      ;; (if-let (pattern scrutinee) then &optional else)
		      ;;   -> if let pattern = scrutinee { then } else { else }
		      ;; patterns are ordinary forms: (Some x) emits Some(x),
		      ;; None and _ work as written.
		      (destructuring-bind ((pattern scrutinee) then
					    &optional else)
			  (cdr code)
			(with-output-to-string (s)
			  (format s "if let ~a = ~a ~a"
				  (emit pattern)
				  (strip-outer-parens (emit scrutinee))
				  (emit-branch-block then #'emit))
			  (when else
			    (format s " else ~a"
				    (emit-branch-block else #'emit))))))
		  (while-let
		      ;; (while-let (pattern scrutinee) form*)
		      ;;   -> while let pattern = scrutinee { forms }
		      (destructuring-bind ((pattern scrutinee) &rest body)
			  (cdr code)
			(format nil "while let ~a = ~a ~a"
				(emit pattern)
				(strip-outer-parens (emit scrutinee))
				(emit-body-block body #'emit))))
		  (let-else
		      ;; (let-else (pattern scrutinee) form*)
		      ;;   -> let pattern = scrutinee else { forms };
		      ;; A let-else always ends with a semicolon (Rust
		      ;; requires it), so the branch terminates itself and
		      ;; the head is in *KEYWORDS-WITHOUT-SEMICOLON* to
		      ;; avoid a second one.  Patterns are ordinary forms
		      ;; like in IF-LET: (Some x) emits Some(x).
		      (destructuring-bind ((pattern scrutinee) &rest body)
			  (cdr code)
			(format nil "let ~a = ~a else ~a;"
				(emit pattern)
				(strip-outer-parens (emit scrutinee))
				(emit-body-block body #'emit))))
		  (coerce (let ((args (cdr code)))
			(destructuring-bind (name type) args
			  (if *omit-redundant-parens*
			      (format nil "~a as ~a"
				      (rust-emit-operand 'coerce :left name #'emit)
				      (emit type))
			      (format nil "(~a as ~a)" (emit name) (emit type))))))
		  (dot (let ((args (cdr code)))
			 (if *omit-redundant-parens*
			     (format nil "~{~a~^.~}"
				     (cons (rust-emit-tight-operand (car args) #'emit)
					   (mapcar #'emit (cdr args))))
			     (format nil "~{~a~^.~}" (mapcar #'emit args)))))
		  

		  (aref (destructuring-bind (name &rest indices) (cdr code)
			  ;(format t "aref: ~a ~a~%" (emit name) (mapcar #'emit indices))
			  (if *omit-redundant-parens*
			      (format nil "~a[~{~a~^,~}]"
				      (rust-emit-tight-operand name #'emit)
				      (mapcar #'emit indices))
			      (format nil "~a[~{~a~^,~}]" (emit name) (mapcar #'emit indices)))))
		  
		  (lambda (parse-lambda code #'emit))
		  #+nil (unsafe (let ((args (cdr code)))
			    (format nil "unsafe {~{~a~}}" args)))
		  (unsafe (let ((args (cdr code)))
			    (format nil "unsafe ~a"
				    (emit-body-block args #'emit))))
		  (extern (let ((args (cdr code)))
			    (format nil "extern ~a"
				    (emit-body-block args #'emit))))
		  (case
		      ;; case keyform {normal-clause}* [otherwise-clause]
		      ;; normal-clause::= (key form*)
		      ;; otherwise-clause::= (t form*)
		      ;; key may be a symbol (None), a list that emits a pattern
		      ;; ((Some x) ...) or a string for anything else.
		      (destructuring-bind (keyform &rest clauses)
			  (cdr code)
			(format
			 nil "match ~a ~a"
			 (strip-outer-parens (emit keyform))
			 (emit
			  `(progn
			     ,@(loop for c in clauses collect
				    (destructuring-bind (key &rest forms) c
				      ;; NOTE: pass FORMS on unevaluated, do not
				      ;; pre-emit them.  Emitting twice turned
				      ;; every arm body into a string, which
				      ;; suppressed all statement semicolons.
				      (format nil "~a => ~a,"
					      (if (eq key t)
						  "_"
						  (emit key))
					      (emit-body-block forms #'emit)))))))))
		  (dotimes
		      ;; dotimes (var count [step]) {form}*
		      ;;   -> for var in 0..count { }
		      ;;   -> for var in (0..count).step_by(step) { }
		      (destructuring-bind ((i n &optional (step 1)) &rest body) (cdr code)
			(format nil "for ~a in ~a ~a"
				(emit i)
				(if (eql step 1)
				    (format nil "0..~a" (emit n))
				    (format nil "(0..~a).step_by(~a)"
					    (emit n) (emit step)))
				(emit-body-block body #'emit))))
		  (loop (let ((args (cdr code)))
			  (format nil "loop ~a"
				  (emit-body-block args #'emit))))
		  (for (destructuring-bind ((item collection) &rest body) (cdr code)
			     (format nil "for ~a in ~a ~a"
				     (emit item)
				     (strip-outer-parens (emit collection))
				     (emit-body-block body #'emit))))
		  (while  ;; while condition {forms}*
		      (destructuring-bind (condition &rest body) (cdr code)
			;; no parentheses around the condition, rustc's
			;; unused_parens lint complains about them
			(format nil "while ~a ~a"
				(strip-outer-parens (emit condition))
				(emit-body-block body #'emit))))
		  (deftype
		      ;; deftype name lambda-list {form}*
		      ;; only the first form of the body is used, lambda list is ignored
		      ;; (deftype my-u () u64) -> type my_u = u64
		      (destructuring-bind (name lambda-list &rest body) (cdr code)
			(declare (ignore lambda-list))
			(format nil "type ~a = ~a" (emit name) (emit (car body)))))
		  (struct (format nil "struct ~a" (emit (car (cdr code)))))
		  (defstruct0
		   ;; defstruct0 name {slot-description}*
		   ;; slot-description::= (slot-name slot-type)
		   ;;
		   ;; (defstruct0 Point (x f64) (y f64))
		   ;;  -> struct Point { x: f64, y: f64, }
		   ;;
		   ;; Attributes such as "#[derive(Clone)]" are written as plain
		   ;; strings in front of the form.
		   (destructuring-bind (name &rest slot-descriptions) (cdr code)
		     (format nil "struct ~a ~a"
			     (emit name)
			     (emit
			      `(progn
				 ,@(loop for desc in slot-descriptions collect
					 (destructuring-bind (slot-name &optional type value) desc
					   (declare (ignorable value))
					   (format nil "~a: ~a," (emit slot-name) (emit type)))))))))
		  (defenum
		   ;; defenum name {variant}*
		   ;; (defenum Status Queued Running) -> enum Status { Queued, Running, }
		   ;; Derives/attributes via (attr ... (defenum ...)).
		   (destructuring-bind (name &rest variants) (cdr code)
		     (format nil "enum ~a ~a"
			     (emit name)
			     (emit
			      `(progn
				 ,@(loop for v in variants collect
					 (format nil "~a," (emit v))))))))
		  (deftrait
		   ;; deftrait name {(defun method (args) declare*)}*
		   ;;   -> trait name { fn method(args) -> T; ... }
		   ;; Each body form must be a DEFUN; only the signature is
		   ;; emitted (like PARSE-DEFUN with :HEADER-ONLY).  Write
		   ;; bounds as a string name, e.g. "Shape: Debug".
		   ;;
		   ;; (deftrait Shape
		   ;;   (defun area (&self) (declare (values f64))))
		   ;;  -> trait Shape { fn area(&self) -> f64; }
		   (destructuring-bind (name &rest methods) (cdr code)
		     (format nil "trait ~a ~a"
			     (emit name)
			     (emit
			      `(progn
				 ,@(loop for m in methods collect
					 (progn
					   (assert (and (listp m) (eq (car m) 'defun)) nil
						   "deftrait expects (defun ...) members, got: ~a" m)
					   (format nil "~a;"
						   (parse-defun m #'emit
								:header-only t)))))))))
		  ((handler-case throw include defclass protected public ->  new
		    slice cast string# & ^)
		   ;; The first group are leftovers from the C/C++ generator
		   ;; this file started out as; the second group are forms
		   ;; removed in 2026-09 (see MIGRATION.md).  Whatever they
		   ;; used to emit is not valid Rust, so fail loudly instead
		   ;; of producing garbage.
		   (error "cl-rust-generator: the form ~s is not supported.~%~a"
			  (car code)
			  (case (car code)
			    (handler-case "Rust has no exceptions. Use (case expr ((Ok v) ...) ((Err e) ...)) or the ? operator.")
			    (throw "Rust has no exceptions. Return (Err ...) or use panic!.")
			    (include "Use (use (std io)) / (mod name) instead of #include.")
			    (defclass "Use (defstruct0 ...) together with (impl ...).")
			    ((protected public) "Write \"pub\" as a plain string in front of the item.")
			    (-> "-> is only valid in a function signature; use (dot a b) for member access.")
			    (new "Rust has no `new' keyword; call the associated function, e.g. (\"Vec::new\").")
			    (slice "Removed: use (range a b), (range-inclusive a b), (range-from a), (range-to b), (range-to-inclusive b) or (range-full).")
			    (cast "Removed: use (coerce value type).")
			    (string# "Removed: use (string-r ...).")
			    (& "Removed: use (logand a b).")
			    (^ "Removed: use (logxor a b)."))))
		  (t (destructuring-bind (name &rest args) code

		       (if (listp name)
			   ;; lambda call and similar complex constructs
			   (format nil "(~a)~a"
				   (emit name)
				   (emit `(paren ,@args))
				   )
			   ;; function call
			   
			   
			   (progn	;if
			     
			     #+nil(and
				   (= 1 (length args))
				   (eq (aref (format nil "~a" (car args)) 0) #\.))
			     #+nil (format nil "~a~a" name
					   (emit args))
			     (format nil "~a~a" (emit name)
				     (emit `(paren ,@args)))))))))
	      (cond
		((symbolp code)
		 ;; print variable or function name
		 ;; convert - to : 
		 (substitute #\: #\- (format nil "~a" code))
		 )
		((stringp code) 
		 ;; print variable or function name
		 ;; don't transform characters
		 (format nil "~a" code)
		 )
		#+nil ((stringp code) 
		 (format nil "~a" code))
		((numberp code) ;; print constants
		 (cond ((integerp code)
			(if (< code 0)
			    (format nil "(~a)" code)
			    (format nil "~a" code)))
		       ((floatp code)
			(typecase code
			  (single-float (let ((v (print-sufficient-digits-f32 code)))
					  (if (< code 0)
					      (format nil "(~a)" v)
					      (format nil "~a" v))))
			  (double-float (let ((v (print-sufficient-digits-f64 code)))
					  (if (< code 0)
					      (format nil "(~a)" v)
					      (format nil "~a" v))))))))))
	  "")))
  #+nil (progn
   (defparameter *bla*
     (emit-rs :code `(do0
		     (include <stdio.h>)
		     (defun main (argc argv)
		       (declare (type int argc)
				(type char** argv)
				(values int))
		       (printf (string "hello world!"))
		       (return 0)))))
   (format t "~a" *bla*)))

#+nil((ntuple (let ((args (cdr code)))
			   (format nil "~{~a~^, ~}" (mapcar #'emit args))))
		 (paren
		  ;; paren {args}*
		  (let ((args (cdr code)))
		    (format nil "(~{~a~^, ~})" (mapcar #'emit args))))
		 (braces
		  ;; braces {args}*
		  (let ((args (cdr code)))
		    (format nil "{~{~a~^, ~}}" (mapcar #'emit args))))
      (curly ;; name{arg1, args}
		  ;; or name{key1:arg1, key2:arg2}
		  (destructuring-bind (name &rest args) (cdr code)
		    (emit `(cast ,name
				 (braces
				  ,@(if (keywordp (car args))
					(loop for i below (length args) by 2 collect
					     (let ((a (elt args i))
						   (b (elt args (+ 1 i))))
					       (format nil "~a: ~a" (emit a) (emit b))))
					args))))))
		      (cast ;; cast type value
		       (destructuring-bind (type value) (cdr code)
			 (format nil "~a ~a" (emit type) (emit value)))
		       )
		      (dict
		       ;; dict {pair}*
		       (let* ((args (cdr code)))
			 (let ((str (with-output-to-string (s)
				      (loop for (e f) in args
					 do
					   (format s "~a: ~a," (emit e) (emit f))))))
			   (format nil "{~a}" ;; remove trailing comma
				   (subseq str 0 (- (length str) 1))))))
		      (go (format nil "go ~a" (emit (car (cdr code)))))
		      (range (format nil "range ~a" (emit (car (cdr code)))))
		      (chan (format nil "chan ~a" (emit (car (cdr code)))))
		      (defer (format nil "defer ~a" (emit (car (cdr code)))))
      (return (format nil "return ~a" (emit (car (cdr code)))))
		      
      (do (with-output-to-string (s)
			    ;; do {form}*
			    ;; print each form on a new line with one more indentation.
	    (format s "~{~&~a~}" (mapcar #'(lambda (x) (emit `(indent ,x) 1)) (cdr code)))
	    (progn (with-output-to-string (s)
		     ;; progrn {form}*
		     ;; like do but surrounds forms with braces.
		     (format s "{~{~&~a~}~&}" (mapcar #'(lambda (x) (emit `(indent ,x) 1)) (cdr code)))))))
		      
		      (let (parse-let code #'emit))
		      
		      (defun (parse-defun code #'emit))
		      (defun-declaration (parse-defun-declaration code #'emit))
      
		      (defmethod (parse-defmethod code #'emit))
		      (defmethod-interface (parse-defmethod-interface code #'emit))
		      (defmethod-declaration (parse-defmethod-declaration code #'emit))
		      #+nil (defstruct
				;;  defstruct name {slot-description}*
				;; slot-description::= slot-name | (slot-name [slot-initform [[slot-option]]]) 
				;; slot-option::= :type slot-type
				(destructuring-bind (name &rest slot-descriptions) (cdr code)
				  (format
				   nil "type ~a struct ~a"
				   name
				   (emit
				    `(progn
				       ,@(loop for desc in slot-descriptions collect
					      (destructuring-bind (slot-name ;; &optional init
								   ;; init doesnt really fit into go semantics
								   &key type) desc
						(format nil "~a~@[ ~a~]" slot-name type))))))))
		      (deftype
			  ;; deftype name lambda-list {form}*
			  ;; only the first form of the body is used, lambda list is ignored
			  (destructuring-bind (name lambda-list &rest body) (cdr code)
			    (declare (ignore lambda-list))
			    (format nil "type ~a ~a" name (emit (car body)))))
		      

		      (definterface
			  
			  ;; definterface name {slot-description}*
			  ;; slot-description::= other-interface-name | method-interface-declaration

			  (destructuring-bind (name &rest slot-descriptions) (cdr code)
			    (format nil "type ~a interface ~a"
				    name
				    (emit
				     `(progn
					,@(mapcar #'emit slot-descriptions))))))
		      (setf (parse-setf code #'emit))
		      (const (parse-const code #'emit))
		      (assign
		       ;; assign {pair}*
		       (let ((args (cdr code)))
			 (format nil "~a~%"
				 (emit
				  `(do0 
				    ,@(loop for i below (length args) by 2 collect
					   (let ((a (elt args i))
						 (b (elt args (+ 1 i))))
					     `(:= ,a ,b))))))))
      
		      (ecase
			  ;; ecase keyform {normal-clause}*
			  ;; normal-clause::= (keys form*) 
			  (destructuring-bind (keyform &rest clauses)
			      (cdr code)
			    (format
			     nil "switch ~a ~a"
			     (emit keyform)
			     (emit
			      `(progn
				 ,@(loop for c in clauses collect
					(destructuring-bind (key &rest forms) c
					  (format nil "case ~a:~&~a"
						  (emit key)
						  (emit
						   `(do0
						     ,@(mapcar #'emit
							       forms)))))))))))
      
		      (for
		       ;; for [init [condition [update]]] {forms}*
		       (destructuring-bind ((&optional init condition update) &rest body)
			   (cdr code)
			 (with-output-to-string (s)
			   (format s "for ~a ; ~a; ~a "
				   (if init
				       (emit init)
				       "")
				   (if condition
				       (emit condition)
				       "")
				   (if update
				       (emit update)
				       ""))
			   (format s "~a" (emit `(progn ,@body))))))
		      (foreach
		       ;; foreach [var] range {forms}*
		       ;; foreach range {forms}*
		       (destructuring-bind ((&rest decl) &rest body) (cdr code)
			 (with-output-to-string (s)
			   (format s "for ~a "
				   (if (< 1 (length decl))
				       (destructuring-bind (var range) decl
					 (emit `(:= ,var ,range)))
				       (emit (car decl))))
			   (format s "~a" (emit `(progn ,@body))))))

		      
		      (dotimes (destructuring-bind ((var end) &rest body) (cdr code)
				 (emit `(for ((:= ,var 0)
					      (< ,var ,end)
					      (incf ,var))
					     ,@body))))
      
		      
      (slice (let ((args (cdr code)))
			       (if (null args)
				   (format nil ":")
				   (format nil "~{~a~^:~}" (mapcar #'emit args)))))
		      
		      #+nil (-> (let ((forms (cdr code)))
				  ;; clojure's thread first macro, thrush operator
				  ;; http://blog.fogus.me/2010/09/28/thrush-in-clojure-redux/
				  ;; -> {form}*
				  (emit (reduce #'(lambda (x y) (list (emit x) (emit y))) forms)))))