application/octet-stream
•
5.20 KB
•
87 lines
;;; 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-set (source env)
(if (= 3 (:length (cdr source)))
(macroexpand-form source env set! 3 #f #b000)
(if (pair? (cadr source))
(if (= (car (cadr source)) 'ref)
(macroexpand-form (list 'set! (cadr (cadr source)) (caddr (cadr source)) (caddr source)) env set! 3 #f #b000)
(throw (list :type-error "(set!) needs a symbol name and a value as arguments" source env)))
(macroexpand-form source env set! 2 #f #b001))))
(defn macroexpand* (source env)
; Expand all macros within source
:internal
(def op (if (resolves? (car source) env)
(ref (or env (current-closure)) (car source))
(car source)))
(case (:type-name 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))
(set! (macroexpand-set source env))
(def (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))))))))
(defmacro macroexpand (source)
"Macroexpand the forms in source"
`(macroexpand* (quote ~source) (current-closure)))
