+ (second (help-arg prev-item (car (prim-args prim))))
+ following-args)))
+ (t (append
+ (butlast prev-item)
+ (list
+ (reconfigure-due-to-precedence
+ (car (last prev-item))
+ prim
+ following-args)))))))
+
+(defun parse-prim (prim lexed-ast prev-item prev-remaining-arg remaining-args)
+ (when (not (prim-precedence prim))
+ (error "Prim must have a precedence! ~A" prim))
+ (when (and (prim-is-infix prim) (eql :token (car (prim-args prim))))
+ (error "Can't have a prim that wants a token in the first position while being infix: ~A" prim))
+ (when
+ (and
+ (< (prim-precedence prim) 20)
+ (find-if (lambda (arg) (or (eql :token arg) (and (listp arg) (find :token arg)))) (prim-args prim)))
+ (error "Can't have a prim that wants a token and has a precedence of less than 20: ~A" prim))
+ (let*
+ ((args (if (prim-is-infix prim) (cdr (prim-args prim)) (prim-args prim)))
+ (half-parsed-remainder
+ (parse-internal (cdr lexed-ast) :remaining-args (append args (list :done-with-args))))
+ (breakpoint (or
+ (position-if (lambda (form) (or (not (listp form)) (not (eql :arg (car form))))) half-parsed-remainder)
+ (length half-parsed-remainder)))
+ (already-parsed-limbo-forms
+ (subseq half-parsed-remainder breakpoint (min (length args) (length half-parsed-remainder))))
+ (num-optional-forms (- (length args) breakpoint))
+ (middle-forms
+ (cons
+ (if
+ (prim-is-infix prim)
+ ; There's a potential bug here about infix operators with optional forms, where the first item is optional
+ ; I don't consider that super likely though...
+ (append
+ (reconfigure-due-to-precedence prev-item prim (mapcar #'cadr (subseq half-parsed-remainder 0 breakpoint)))
+ (loop :repeat num-optional-forms :collect :optional))
+ (cons
+ (prim-name prim)
+ (append
+ (mapcar #'cadr (subseq half-parsed-remainder 0 breakpoint))
+ (loop :repeat num-optional-forms :collect :optional)))) ; we save the place for optionals for the transpiler
+ already-parsed-limbo-forms)));)
+ (let
+ ((arg-at-bp (nth breakpoint args)))
+ (when (and arg-at-bp (or (not (listp arg-at-bp)) (not (find :optional arg-at-bp))))
+ (error "Stopped collecting arguments, but non optional arguments remain")))
+ (append
+ (butlast middle-forms)
+ (parse-internal
+ (nthcdr (length args) half-parsed-remainder)
+ :remaining-args (if (prim-is-infix prim) remaining-args (cdr remaining-args))
+ :prev-remaining-arg (if (prim-is-infix prim) prev-remaining-arg (car remaining-args))
+ :prev-item (car (last middle-forms))))))
+
+(defun help-arg (arg arg-type)
+ (cond
+ ((not arg-type) arg)
+ ((eql arg-type :token) (list :arg (list :token arg)))
+ ((and (listp arg-type) (find :token arg-type) (symbolp arg)) (list :arg (list :token arg)))
+ ((eql arg-type :command-block)
+ (if (not (and (consp arg) (eql 'block (car arg))))
+ (error "Required a block, but found a ~A" arg)
+ (list :arg (cons :command-block (cdr arg)))))
+ ((eql arg-type :reporter-block)
+ (if (not (and (consp arg) (eql 'block (car arg))))
+ (error "Required a block, but found a ~A" arg)
+ (list :arg (cons :reporter-block (cdr arg)))))
+ ((or
+ (eql arg-type :list)
+ (and (listp arg-type) (find :list arg-type)))
+ (list
+ :arg
+ (if (and (consp arg) (eql 'block (car arg)))
+ (cons :list-literal (cdr arg))
+ arg)))
+ ((and
+ (listp arg-type)
+ (find :command-block arg-type)
+ (consp arg)
+ (eql 'block (car arg)))
+ (list :arg (cons :command-block (cdr arg))))
+ ((and (listp arg-type) (find :optional arg-type)) arg)
+ (t (list :arg arg))))
+
+(defun parse-block (tokens remaining-args)
+ (multiple-value-bind (in-block after-block) (find-closing-bracket tokens)
+ (parse-internal after-block
+ :prev-item (cons 'block (parse-internal in-block))
+ :prev-remaining-arg (car remaining-args)
+ :remaining-args (cdr remaining-args))))
+
+(defun find-closing-bracket (tokens &optional (depth 0))
+ (cond
+ ((not tokens) (error "Failed to find a matching closing bracket"))
+ ((and (eql :] (car tokens)) (= depth 0)) (values nil (cdr tokens)))
+ (t (multiple-value-bind
+ (in-block after-block)
+ (find-closing-bracket (cdr tokens) (case (car tokens) (:[ (1+ depth)) (:] (1- depth)) (t depth)))
+ (values (cons (car tokens) in-block) after-block)))))
+
+(defun parse-parened-expr (tokens remaining-args)
+ (multiple-value-bind (in-block after-block) (find-closing-paren tokens)
+ (parse-internal after-block
+ :prev-item
+ (let
+ ((parsed-in-block (parse-internal in-block)))
+ (when (/= 1 (length parsed-in-block)) (error "Expected ) here"))
+ (list :parened (car parsed-in-block)))
+ :prev-remaining-arg (car remaining-args)
+ :remaining-args (cdr remaining-args))))
+
+(defun find-closing-paren (tokens &optional (depth 0))
+ (cond
+ ((not tokens) (error "Failed to find a matching closing bracket"))
+ ((and (eql (intern ")" :keyword) (car tokens)) (= depth 0)) (values nil (cdr tokens)))
+ (t (multiple-value-bind
+ (in-block after-block)
+ (find-closing-paren
+ (cdr tokens)
+ (cond
+ ((eql (intern "(" :keyword) (car tokens)) (1+ depth))
+ ((eql (intern ")" :keyword) (car tokens)) (1- depth)) (t depth)))
+ (values (cons (car tokens) in-block) after-block)))))
+
+(defmacro defprim (name args precedence &rest options)
+ `(push
+ (list :name ,name :args ',args :infix ,(find :infix options) :precedence ,precedence)
+ *prims*))