+ ((not parsed-ast) nil)
+ ((and (listp parsed-ast) (eql :parened (car parsed-ast))) (remove-parened-forms (cadr parsed-ast)))
+ ((listp parsed-ast) (mapcar #'remove-parened-forms parsed-ast))
+ (t parsed-ast)))
+
+(defun parse-internal (lexed-ast &key prev-item prev-remaining-arg remaining-args)
+ (let
+ ((prim (and lexed-ast (symbolp (car lexed-ast)) (find-prim (car lexed-ast)))))
+ (cond
+ ((and remaining-args (eql (car remaining-args) :done-with-args))
+ (append (when prev-item (list (help-arg prev-item prev-remaining-arg))) lexed-ast))
+ ((and prim (prim-is-infix prim))
+ (parse-prim prim lexed-ast prev-item prev-remaining-arg remaining-args)) ; Special casing infix prims is cleaner
+ (t
+ (append
+ (when prev-item (list (help-arg prev-item prev-remaining-arg)))
+ (cond
+ ((not lexed-ast) nil)
+ ((stringp (car lexed-ast))
+ (parse-internal (cdr lexed-ast)
+ :prev-item (car lexed-ast)
+ :prev-remaining-arg (car remaining-args)
+ :remaining-args (cdr remaining-args)))
+ ((numberp (car lexed-ast))
+ (parse-internal (cdr lexed-ast)
+ :prev-item (coerce (car lexed-ast) 'double-float)
+ :prev-remaining-arg (car remaining-args)
+ :remaining-args (cdr remaining-args)))
+ ((and remaining-args
+ (or
+ (eql :token (car remaining-args))
+ (and
+ (listp (car remaining-args))
+ (find :token (car remaining-args))
+ (symbolp (car lexed-ast)))))
+ (parse-internal (cdr lexed-ast)
+ :prev-item (car lexed-ast)
+ :prev-remaining-arg (car remaining-args)
+ :remaining-args (cdr remaining-args)))
+ ((eql (intern "(" :keyword) (car lexed-ast)) (parse-parened-expr (cdr lexed-ast) remaining-args))
+ ((eql (intern ")" :keyword) (car lexed-ast)) (error "Closing parens has no opening parens"))
+ ((eql :let (car lexed-ast)) (parse-let (cdr lexed-ast) remaining-args))
+ ((eql :[ (car lexed-ast)) (parse-block (cdr lexed-ast) remaining-args))
+ (prim
+ (when (prim-structure-prim prim)
+ (error "This doesn't make sense here"))
+ (parse-prim prim lexed-ast nil prev-remaining-arg remaining-args))
+ (t (error "Couldn't parse ~S" lexed-ast))))))))
+
+(defun parse-let (lexed-ast remaining-args)
+ (when (not (keywordp (car lexed-ast))) (error "Needed a keyword for let"))
+ (let*
+ ((half-parsed-remainder (parse-internal (cdr lexed-ast) :remaining-args (list t :done-with-args))))
+ (let
+ ((*dynamic-prims* (cons (list :name (car lexed-ast) :precedence 20) *dynamic-prims*)))
+ (parse-internal
+ (cdr half-parsed-remainder)
+ :remaining-args (cdr remaining-args)
+ :prev-remaining-arg (car remaining-args)
+ :prev-item (list :let (car lexed-ast) (cadr (car half-parsed-remainder)))))))
+
+(defun reconfigure-due-to-precedence (prev-item prim following-args)
+ (flet
+ ((calculate-precedence (x)
+ (or
+ (and
+ (listp x)
+ (< 1 (length prev-item))
+ (keywordp (car x))
+ (find-prim (car x))
+ (prim-precedence (find-prim (car x))))
+ 20)))
+ (cond
+ ((<= (prim-precedence prim) (calculate-precedence prev-item))