Login
7 branches 0 tags
Ben(Parabola/X220) Better exception handling 5205c8a 2 years ago 1018 Commits
nujel / stdlib / compiler / frontend / macroexpander.nuj
;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; Contains the Nujel macroexpander
;;;
;;; Expands a do for, leaving out sub-expressions in the middle that are without
;;; side effects, which is simplified to mean anything that is not a pair.

(def macroexpand* (let*
                    (defn macroexpand-do-args (args env)
                          (if (last? args)
                              (cons (macroexpand* (car args) env) #nil)
                              (if (pair? (car args))
                                  (let* (def ocar (macroexpand* (car args) env))
                                        (if (pair? ocar)
                                            (cons ocar (macroexpand-do-args (cdr args) env))
                                            (macroexpand-do-args (cdr args) env)))
                                  (macroexpand-do-args (cdr args) env))))

                    (defn macroexpand-do (source env)
                          (def args (macroexpand-do-args source env))
                          (if (last? args)
                              (car args)
                              (cons 'do args)))

                    (defn macroexpand-form (source env op arity implicit-do? no-expand-bitmap)
                          (def ret (cons op #nil))
                          (def l (cdr source))
                          (dotimes (i arity)
                            (cons! (if (bit-test? no-expand-bitmap i)
                                       (car l)
                                       (macroexpand* (car l) env))
                                   ret)
                            (cdr! l))
                          (if implicit-do?
                              (set! ret (cons (macroexpand-do l env) ret))
                              (when l (throw (list :arity-error (cat op " form contains more than " arity " arguments") source env))))
                          (return (nreverse ret)))

                    (defn macroexpand-fold (op source env)
                          (if (cdr source)
                              (if (cddr source)
                                  (list op
                                        (macroexpand-fold op (except-last-pair source) env)
                                        (macroexpand* (car (last-pair source)) env))
                                  (list op
                                        (macroexpand* (car source) env)
                                        (macroexpand* (cadr source) env)))
                              (list op (macroexpand* (car source) env))))

                    (defn macroexpand* (source env)
                          "Expand all macros within source"
                          :cat :compiler
                          :internal
                          (def op (if (resolves? (car source) env)
                                      (resolve   (car source) env)
                                      (car source)))
                          (case (type-of op)
                                (:nil source)
                                (:macro (macroexpand* (apply op (cdr source)) env))
                                (:native-function
                                 (case op
                                       (quote source)
                                       (do                  (macroexpand-do   source env))
                                       (return              (macroexpand-form source env op 1 #f #b0))
                                       ((try while)         (macroexpand-form source env op 1 #t #b0))
                                       ((def set!)          (macroexpand-form source env op 2 #f #b01))
                                       (if                  (macroexpand-form source env op 3 #f #b0))
                                       ((fn* macro*)        (macroexpand-form source env op 4 #t #b0111))
                                       ((let* environment*) (list op (macroexpand-do (cdr source) env)))
                                       (otherwise (if (meta op :fold)
                                                      (macroexpand-fold op (cdr source))
                                                      (map source (fn (α) (macroexpand* α env)))))))
                                (otherwise (map source (fn (α) (macroexpand* α env))))))))

(defn macroexpand (source env)
      "Macroexpand the forms in source"
      (macroexpand* source (or env root-closure)))