(def orf args
  ; evaluates each arg in 'args, returns the
  ; first non-nil value, or nil if they are
  ; all nil
  (cond args
        (cond (car args)
              (car args)
              (apply orf
                     (cdr args)))))

(mac unless (arg . body)
  ; evaluate 'body if 'arg is nil
  `(if (no ,arg) (do ,@body)))

(def expand-colon-syntax (names)
  (if (no (cdr names))
          `(apply ,(car names) args)
          `(,(car names) ,(expand-colon-syntax (cdr names)))))

(def default-colon-syntax (names)
  `(fn args ,(expand-colon-syntax names)))

(assign colon-syntax-overrides (hash))

(mac def-colon-syntax (name var . body)
  `(hash-set colon-syntax-overrides
             ',name
             (fn (,var) ,@body)))

(def-colon-syntax || names
  (error "Irregular ': syntax: got ~(inspect names) : not prefix-syntax : in ~(joinstr ":" names)"))

(mac colon-syntax names
  ; handle syntax of the form a:b, which the parser expands to
  ; (colon-syntax a b). By default, this complains if colon is used
  ; as a prefix (ie it disallows ":foo"), otherwise creates a new
  ; function which is the composition of the functions named in its
  ; arguments. For example,
  ; (count:parts spaceship) is the same as (count (parts spaceship))
  ((orf (hash-get colon-syntax-overrides (car names))
        default-colon-syntax)
   names))

(mac bang-syntax (pfx . rest)
  ; handle syntax of the form !x, which the parser expands to
  ; (bang-syntax || x). By default, this complains if there is
  ; a non-empty prefix (ie it disallows x!y), otherwise it creates
  ; a new function which is the negation of the given named function.
  ; For example,
  ; (!eq? a 10) is the same as (no:eq? a 10), which is the same as (no (eq? a 10))
  (if (no (eq? pfx '||))
      (error "Irregular '! syntax: got prefix ~(inspect pfx) in ~(joinstr "!" (cons pfx rest))"))
  (if (cdr rest)
      (error "Irregular '! syntax: got suffix ~(inspect (cdr rest)) in ~(joinstr "!" (cons pfx rest))")
      (if (caris 'colon-syntax (car rest))
          `(colon-syntax no ,@(cdar rest))
          `(colon-syntax no ,(car rest)))))

(mac and args
  (if args
      (if (cdr args)
          `(if ,(car args) (and ,@(cdr args)))
          (car args))
      't))

(mac when (condition . body)
  `(cond ,condition (do ,@body)))

(def pairs (things)
     (if (no things)       nil
       (no (cdr things)) (list (list (car things)))
       (cons (list (car things) (cadr things))
             (pairs (cddr things)))))

(mac with (parms . body)
     `((fn ,(map car (pairs parms))
           ,@body)
       ,@(map cadr (pairs parms))))

(mac let (var val . body)
     `(with (,var ,val) ,@body))

(mac rfn (name parms . body)
  ; creates a named, locally-scoped function
  ; with the given parameter names. It is possible
  ; to reference the function by its name from within
  ; the function (to pass as an argument or for
  ; recursive invocation)
  `(let ,name nil
     (assign ,name (fn ,parms ,@body))))

(mac afn (parms . body)
  ; same as 'rfn, but using the name 'self
  `(rfn self ,parms ,@body))

(mac rfnwith (name params . body)
  ; a mix of rfn and with; creates a locally-scoped named function with
  ; the given parameter names, and invokes it with the given parameter
  ; values. It is possible to reference the function by its name from
  ; within the function (to pass as an argument or for recursive
  ; invocation)
  (let ppairs (pairs params)
    `(let ,name nil
       (assign ,name (fn ,(map car ppairs) ,@body))
       (,name ,@(map cadr ppairs)))))

(let uniq-counter 0
     (def uniq (prefix)
          (sym (joinstr "-"
                        (list prefix
                              (assign uniq-counter
                                      (+ uniq-counter 1))))))
     (def reset-uniq-counter ()
          (assign uniq-counter 0)))

(mac w/uniq (vars . body)
  ; creates a lexical scope with a unique symbol assigned to
  ; each variable in 'vars ; executes the 'body.
  (if (pair? vars)
      `(with ,(apply + (map (fn (n) (list n '(uniq ',n))) vars))
             ,@body)
      `(let ,vars (uniq ',vars) ,@body)))

(mac or args
  ; lazy-evaluates each argument, returns the first
  ; non-nil result, or nil if all evaluate to nil.
  (cond args
        (w/uniq ora
                `(let ,ora ,(car args)
                   (cond ,ora ,ora (or ,@(cdr args)))))))

(mac pop (xs)
     (w/uniq gp
             `(let ,gp (car ,xs)
                   (assign ,xs (cdr ,xs))
                   ,gp)))

(def build-keyword-args (pairs)
  (map (fn (ab) `(list (quote ,(car ab)) ,@(cdr ab))) pairs))

(def build-hash-get-key (name)
  (if (pair? name)
      (if (caris 'unquote name)
          (cadr name)
          name)
      (list 'quote name)))

(def build-hash-getters (names acc)
  ;; (build-hash-getters '(a b c)) => (hash-get (hash-get a 'b) 'c)
  (if (no acc)
      (build-hash-getters (cdr names) (car names))
      names
      (build-hash-getters (cdr names) `(hash-get ,acc ,(build-hash-get-key (car names))))
      acc))

(def build-hash-lookup-from (root names)
  (build-hash-getters (cons root names) nil))

(mac hash-lookup (names)
  (build-hash-getters names nil))

(mac dot-syntax names `(hash-lookup ,names))
(mac dollar-syntax (_ name) `(,name))

(def dot-syntax-assignment (names value-expr)
  (let rnames (rev names)
    `(hash-set ,(build-hash-getters (rev (cdr rnames)) nil)
               ,(build-hash-get-key:car rnames)
               ,value-expr)))

(def isa     (type obj) (eq? (type-of obj) type))

(mac = (name value)
  (if (isa 'symbol name)
      `(assign ,name ,value)
      (caris 'dot-syntax name)
      (dot-syntax-assignment (cdr name) value)))

(mac def-assign args `(= ,@args))

(def brace-list-hash-key (k)
  (if (isa 'symbol k)      `(quote ,k)
      (caris 'unquote k)   (cadr k)
      k))

(def brace-list-build-hash (args)
  (w/uniq hash
    (let mappings (pairs args)
      `(let ,hash (hash)
            ,@(map (fn (m) `(hash-set ,hash ,(brace-list-hash-key (car m)) ,(cadr m))) mappings)
            ,hash))))

(def build-ampersand-syntax (arg)
  (if (caris 'dot-syntax arg)
      `(fn (obj) ,(build-hash-lookup-from 'obj (cdr arg)))
      `(fn (obj) ,(build-hash-lookup-from 'obj (list arg)))))

(mac ampersand-syntax (pfx . rest)
  (if (no (eq? pfx '||))
      (error "Irregular '& syntax: got prefix ~(inspect pfx) in ~(joinstr "&" (cons pfx rest))"))
  (if (cdr rest)
      (error "Irregular '& syntax: got suffix ~(inspect (cdr rest)) in ~(joinstr "&" (cons pfx rest))")
      (build-ampersand-syntax (car rest))))

(mac brace-list-mono (arg) arg)
(mac brace-list-empty () '(hash))

(mac brace-list args
  (if (no args)
      `(brace-list-empty)
      (no (cdr args))
      `(brace-list-mono ,(car args))
      (brace-list-build-hash args)))