#!/bin/sh
: ; exec klone $0 "$@"
; The above line allows not to embed the exact path of the klone executable

;;Skeleton of a typical klone script

(setq args (getopts "USAGE: %0 [options] files...
qc-check tries to check QuakeC files for correctness
"
    ("-v" () verbose "verbose operation")
    ("-debug" () enter-debugger-on-error "enter klone debugger on error")
    ("-stackdump" () stackdump-on-error "verbose stack dump on error")
))

(if enter-debugger-on-error (kdb t))
(if stackdump-on-error (stack-dump-on-error t))

(setq Rident "([a-zA-Z_][a-zA-Z_0-9.]*)")
(setq Rspace "[ \t\n]*")
(setq Rexpr 
  "(([-+/*&|!<>=a-zA-Z_0-9. \t\n]*)|([(][-+/*&|!<>=a-zA-Z_0-9. \t\n]*[)]))")
(setq Rfuncall (+ Rident Rspace "[(]" Rexpr "[)]"))
(setq Rop "(&&|[|][|]|!|<=|<|>=|>|==|!=|[+]|[-]|&|[|]|[*]|[/])")

(setq re-combination-of-funcalls (regcomp
    (+ Rspace Rfuncall Rspace Rop 
      "(" Rspace Rident Rspace Rop ")*"
      Rspace Rfuncall)
))

(setq re-funcall-of-funcall (regcomp
    (+ Rident Rspace "[(]" Rspace Rfuncall Rspace "[)]")
))
(setq re-funcall-of-funcall-ok (regcomp
    (+ "[bds]print" Rspace "[(]" 
      "(([a-zA-Z_][a-zA-Z_0-9.]*)" Rspace "," Rspace ")?"
      "[fv]tos" Rspace "[(]"
)))
(setq re-lower-case-constants (regcomp (+
      "\n" Rspace "(float|string|entity|vector)" Rspace "[a-z_]" Rident Rspace
      "=[^\n]*"
)))

(defun qc-check-file (filename &aux
    (buffer (String (open filename 
	  :error '(fatal-error 1 "Cannot open file: %0\n" filename)
    )))
    (pos 0)
  )
  ;; check for afunc() + bfunc()
  (with (pos 0 re re-combination-of-funcalls)
    (while (regexec re buffer pos)
      (emacs-error-message filename buffer 
	(get (get re 0) 0) (PF String "Operation on funcalls: %0" 
	  (regsub re 0))
      )
      (setq pos (get (get re 0) 1))
  ))
  ;; check for afunc(bfunc())
  (with (pos 0 re re-funcall-of-funcall)
    (while (regexec re buffer pos)
      (if (and 
	  (not (regexec re-funcall-of-funcall-ok (regsub re 0)))
	  (/= "if" (regsub re 1))
	  (/= "while" (regsub re 1))
	)
	(emacs-error-message filename buffer 
	  (get (get re 0) 0) (PF String "Funcall of Funcall: %0" 
	    (regsub re 0))
      ))
      (setq pos (get (get re 0) 1))
  ))
  ;; check for lower-case constants (disallowed!)
  (with (pos 0 re re-lower-case-constants)
    (while (regexec re buffer pos)
      (emacs-error-message filename buffer 
	(get (get re 0) 0) (PF String "Lower-case constant: %0" 
	  (subseq (regsub re 0) 1)
      ))
      (setq pos (get (get re 0) 1))
  ))
)

(defun emacs-error-message (filename buffer pos text)
  (PF "%0:%1:%2\n" filename (pos-to-line buffer pos) text)
)

(defun pos-to-line (buffer pos &aux
    (lineno 1)
    (curpos 0)
  )
  (catch 'Found
    (while (setq curpos (seek buffer #\newline curpos))
      (if (> curpos pos) (throw 'Found))
      (incf lineno)
      (incf curpos)
    )
  )
  lineno
)

(defun main (&aux
  )
  (dolist (file args)
    (qc-check-file file)
  )
)

(main)

;;; EMACS MODES
;;; Local Variables: ***
;;; mode:lisp ***
;;; End: ***