(module nwn mzscheme
  (require (lib "string.ss" "srfi" "13"))
  (require (lib "string.ss" "mzlib"))

  (define (nwscript . body)
    (string-join (map nw-stmt body) "\n"))

  (define (nw-block head body)
    (format "~a\n{\n~a\n}" head (nw-body body)))

  (define (nw-body body)
    (indent (string-join (map nw-stmt body) "\n")))

  (define (nw-stmt stmt)
    (case (car stmt)
      ((while)   (apply nw-while (cdr stmt)))
      ((def)     (apply nw-def (cdr stmt)))
      ((if)      (apply nw-if (cdr stmt)))
      ((switch)  (apply nw-switch (cdr stmt)))
      ((include) (apply nw-include (cdr stmt)))
      (else      (string-append (nw-expr stmt) ";"))))

  (define (nw-expr expr)
    (cond
      ((literal? expr) (nw-literal expr))
      ((type? expr)    (nw-type expr))
      ((return? expr)  (nw-return (cdr expr)))
      ((infix? expr)   (apply nw-infix expr))
      (else            (apply nw-func expr))))

  (define (return? x)
    (eq? (car x) 'return))

  (define (literal? x)
    (not (list? x)))

  (define (type? expr)
    (one-of? (car expr)
      '(void int float string object location talent vector itemproperty)))

  (define (infix? expr)
    (one-of? (car expr)
      '(= < > >= <= == != * - + / % & ^ *= += -= /=)))

  (define (one-of? x ys)
    (ormap (lambda (y) (eq? x y)) ys))

  (define (nw-include expr)
    (format "#include ~a" (nw-expr expr)))

  (define (nw-return expr)
    (format "return ~a" (apply nw-expr expr)))

  (define (nw-infix oper first second)
    (format "~a ~a ~a" (nw-expr first) oper (nw-expr second)))

  (define (nw-type x)
    (apply format "~a ~a" x))

  (define (nw-func name . args)
    (format "~a(~a)"
      name (string-join (map nw-expr args) ", ")))

  (define (nw-literal value)
    (format "~s" value))

  (define (nw-while cdn body)
    (nw-block
      (format "while (~a)" (nw-expr cdn))
      body))

  (define (nw-def args . body)
    (nw-block
      (apply nw-func (nw-type (car args)) (cdr args))
      body))

  (define (nw-if . actions)
    (string-join
      (map (lambda (action)
             (if (eq? (car action) 'else)
               (apply nw-block "" (cdr action))
               (apply nw-if-single action)))
           actions)
      "\nelse "))

  (define (nw-if-single cdn body)
    (nw-block
      (format "if (~a)" (nw-expr cdn))
      body))

  (define (nw-switch expr . cases)
    (format "switch (~a)\n{\n~a\n}"
      (nw-expr expr)
      (string-join 
        (map (lambda (c) (apply nw-case c)) cases)
        "\n")))

  (define (nw-case cases body)
    (string-append 
      (nw-case-line cases)
      "\n"
      (nw-body body)
      "\n\tbreak;"))

  (define (nw-case-line cases)
    (if (eq? cases 'default)
      "default:"
      (string-join
        (map (lambda (c)
          (format "case ~a:" (nw-literal c))) cases)
        "\n")))

  (define (indent lines)
    (join-lines (map indent-one (split-lines lines))))

  (define (indent-one line)
    (string-append "\t" line))

  (define (join-lines lines)
    (string-join lines "\n"))

  (define (split-lines lines)
    (regexp-split "\n" lines))
  
  (provide nwscript))