;;;-*- Mode: Lisp; Package: cl-user -*-

(in-package :cl-user)

; To run do (build)

; Sharp-double-quote

(defun sharp-double-quote-reader (stream sub-char numarg)
  (declare (ignore sub-char numarg))
  (let (chars)
    (do ((prev (read-char stream) curr)
         (curr (read-char stream) (read-char stream)))
        ((and (char= prev #\") (char= curr #\#)))
      (push prev chars))
    (coerce (nreverse chars) 'string)))

(set-dispatch-macro-character
  #\# #\" #'sharp-double-quote-reader)

; Code generation functions

(defun float-function (str enum string comments)
  (declare (ignore string))
  (format str "
~:[~2*~;/*
  (~a number)
  Returns ~a(number).
*/
~]object *fn_~a (object *args, object *env) {
  (void) env;
  return makefloat(~a(checkintfloat(first(args))));
}" 
          comments
          (string-downcase enum)
          (string-downcase enum)
          (string-downcase enum)
          (string-downcase enum)))

(defun truncate-function (str enum string comments)
  (declare (ignore string))
  (format str "
~:[~2*~;/*
  (~a number [divisor])
  Returns ~a(number/divisor). If omitted, divisor is 1.
*/
~]object *fn_~a (object *args, object *env) {
  (void) env;
  object *arg = first(args);
  args = cdr(args);
  if (args != NULL) return number(~a(checkintfloat(arg) / checkintfloat(first(args))));
  else return number(~a(checkintfloat(arg)));
}" 
          comments
          (string-downcase enum)
          (cdr (assoc enum '((CEILING . "ceil") (FLOOR . "floor") (TRUNCATE . "trunc") (ROUND . "round"))))
          (string-downcase enum) 
          (cdr (assoc enum '((CEILING . "ceil") (FLOOR . "floor") (TRUNCATE . "trunc") (ROUND . "round"))))
          (cdr (assoc enum '((CEILING . "ceil") (FLOOR . "floor") (TRUNCATE . "trunc") (ROUND . "round"))))))

#|
(defun numeric1 (str enum string comments)
  (declare (ignore string))
  (format str "
object *fn_~a (object *args, object *env) {
  (void) env;
  int arg = checkinteger(~a, first(args));
  return number(~a(arg));
}" (string-downcase enum) enum (string-downcase enum)))
|#

(defun bitwise (str enum string comments)
  (declare (ignore string))
  (format str "
~:[~2*~;/*
  (~a [value*])
  Returns the bitwise ~a of the values.
*/
~]object *fn_~a (object *args, object *env) {
  (void) env;
  int result = ~a;
  while (args != NULL) {
    result = result ~a checkinteger(first(args));
    args = cdr(args);
  }
  return number(result);
}"
          comments
          (string-downcase enum)
          (cdr (assoc enum '((LOGAND . "&") (LOGIOR . "|") (LOGXOR . "^"))))
          (string-downcase enum)
          (cdr (assoc enum '((LOGAND . "-1") (LOGIOR . "0") (LOGXOR . "0"))))
          (cdr (assoc enum '((LOGAND . "&") (LOGIOR . "|") (LOGXOR . "^"))))))

#|
; For max or min

(defun numeric2 (str enum string comments)
  (declare (ignore string))
  (format str "
object *fn_~a (object *args, object *env) {
  (void) env;
  int result = integer(first(args));
  args = cdr(args);
  while (args != NULL) {
    result = ~a(result,integer(car(args)));
    args = cdr(args);
  }
  return number(result);
}" (string-downcase enum) (string-downcase enum)))
|#

(defun split-into-lines (string &optional (indent 0))
  (let* ((linelen 106)
         (start 0)
         (end (- linelen indent)) 
         (length (length string))
         result)
    (loop
     (when (>= end length)
       (push (subseq string start) result) 
       (return (reverse result)))
     (let ((comma (position #\, string :start start :end end :from-end t)))
       (push (subseq string start (1+ comma)) result)
       (setq start (+ comma 2) end (+ comma 2 linelen))))))