Ben / Nujel

;; 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

[def macroexpand/environment [current-closure]]

;; 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.
[defn macroexpand/do/args [args]
  [if [last? args]
      [cons [macroexpand* [car args]] #nil]
      [if [pair? [car args]]
          [let* [def ocar [macroexpand* [car args]]]
            [if [pair? ocar]
                [cons ocar [macroexpand/do/args [cdr args]]]
                [macroexpand/do/args [cdr args]]]]
          [macroexpand/do/args [cdr args]]]]]

[defn macroexpand/do [source]
  [def args [macroexpand/do/args source]]
  [if [last? args]
      [car args]
      [cons 'do args]]]

[defn macroexpand/def [source]
  [when [cdddr source] [throw [list :arity-error "[def] can only have 2 arguments" source [current-lambda]]]]
  [list 'def [cadr source] [macroexpand* [caddr source]]]]

[defn macroexpand/set! [source]
  [when [cdddr source] [throw [list :arity-error "[set!] can only have 2 arguments" source [current-lambda]]]]
  [list 'set! [cadr source] [macroexpand* [caddr source]]]]

[defn macroexpand/fn* [source]
  [when [cdddddr source] [throw [list :arity-error "[fn*] can only have 4 arguments" source [current-lambda]]]]
  [list 'fn*
        [cadr source]
        [caddr source]
        [cadddr source]
        [macroexpand [caddddr source]]]]

[defn macroexpand/macro* [source]
  [when [cdddddr source] [throw [list :arity-error "[macro*] can only have 4 arguments" source [current-lambda]]]]
  [list 'macro*
        [cadr source]
        [caddr source]
        [cadddr source]
        [macroexpand [caddddr source]]]]

[defn macroexpand/ω* [source]
  [list 'ω* [macroexpand/do [cdr source]]]]

[defn macroexpand/try [source]
  [list 'try [macroexpand* [cadr source]] [macroexpand/do [cddr source]]]]

[defn macroexpand/return [source]
  [when [cddr source] [throw [list :arity-error "[return] can only return a single value" source [current-lambda]]]]
  [list 'return [macroexpand* [cadr source]]]]

[defn macroexpand/if [source]
  [when [cddddr source] [throw [list :arity-error "[if] can only have 3 arguments" source [current-lambda]]]]
  [list 'if
        [macroexpand* [cadr source]]
        [macroexpand* [caddr source]]
        [macroexpand* [cadddr source]]]]

[defn macroexpand/let* [source]
  [list 'let* [macroexpand/do [cdr source]]]]

[defn macroexpand/map [source]
  [map source macroexpand*]]

[defn macroexpand/while [source]
  [list 'while [macroexpand* [cadr source]] [macroexpand/do [cddr source]]]]

[defn macroexpand/macro [macro source]
  [macroexpand* [macro-apply macro [cdr source]]]]

[defn macroexpand/fold [op source]
  [if [cdr source]
      [if [cddr source]
          [list op
                [macroexpand/fold op [except-last-pair source]]
                [macroexpand* [car [last-pair source]]]]
          [list op
                [macroexpand* [car source]]
                [macroexpand* [cadr source]]]]
      [list op [macroexpand* [car source]]]]]

[defn macroexpand* [source]
  "Expand all macros within source"
  [def op [if [resolves? [car source] macroexpand/environment]
              [resolve [car source] macroexpand/environment]
              [car source]]]

  [case [type-of op]
    [:nil source]
    [:native-function
     [case op
       [[+ - * / %] [macroexpand/fold [car source] [cdr source]]]
       [do     [macroexpand/do     source]]
       [def    [macroexpand/def    source]]
       [set!   [macroexpand/set!   source]]
       [let*   [macroexpand/let*   source]]
       [fn*    [macroexpand/fn*    source]]
       [macro* [macroexpand/macro* source]]
       [environment* [macroexpand/ω* source]]
       [if     [macroexpand/if     source]]
       [try    [macroexpand/try    source]]
       [while  [macroexpand/while  source]]
       [return [macroexpand/return source]]
       [quote                  source ]
       [otherwise [map source macroexpand*]]]]
    [:macro                      [macroexpand/macro      op  source]]
    [otherwise                   [map source macroexpand*]]]]

[defn macroexpand [source new-environment]
  "Macroexpand the forms in source"
  [when-not new-environment [set! new-environment [current-closure]]]
  [set! macroexpand/environment new-environment]
  [macroexpand* source]]