Login
7 branches 0 tags
Benjamin Vincent Schulenburg Fixed *module* not being bound for fs modules 8f4a5ef 3 years ago 874 Commits
nujel / stdlib / compiler / compiler.nuj
;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; Contains some high level functions/macros, mainly abstacting the low level
;;; interface to the compiler

[defn load/forms [source environment]
      "Load multiple forms, evaluating the results in environment, so we can make use of macros we just defined"
      [doseq [form source]
             [bytecode-eval* [compile* source environment] environment]]]

[defn macroexpand/forms [source-raw environment]
      "Expand multiple forms, evaluating the source in a temporary environment, so we can make use of macros we just defined."
      [when-not environment [set! environment [environment*]]]
      [load/forms source-raw environment]
      [macroexpand source-raw environment]]

[defn compile* [source environment]
      "Compile SOURCE so it can be evaluated/applied"
      [-> [macroexpand source environment]
          constant-fold
          backend]]

[defn compile/debug [expr]
      [disassemble [compile expr]]]

[defn compile/do* [source environment]
      [if [pair? source]
          [compile* [cons do source] environment]
          source]]

[defmacro compile [source]
          "Compile SOURCE so it can be evaluated/applied"
          `[compile* ~source [current-closure]]]

[defmacro compile/do [source]
          "Compile SOURCE so it can be evaluated/applied"
          `[compile* [cons do ~source] [current-closure]]]

[defn meta/parse/body [type args body]
      [def meta @[]]
      [doseq [v body meta]
             [case [type-of v]
                   [:pair [return meta]]
                   [:string [tree/set! meta :documentation [trim [cat [string [tree/ref meta :documentation]]
                                                                      "\n"
                                                                      v]]]]
                   [:keyword [tree/set! meta v #t]]]]]

[defmacro defmacro [name args . body]
          "Define a new macro"
          `[def ~name [macro* '~name
                              '~args
                              ~[tree/set! [meta/parse/body :macro args body] :source body]
                              '~[compile/do* body [current-closure]]]]]

[defn fn/check [args body]
      [when-not args [exception :type-error "Every function needs an argument list" args]]
      [while args
        [when-not [or [symbol? args]
                      [pair? args]]
                  [exception :type-error "Wrong type for argument list" args]]
        [cdr! args]]
      [when-not body [exception :type-error "Every function needs a body" body]]]

[defmacro fn [args . body]
          "Define an anonymous function"
          [fn/check args body]
          `[fn* 'anonymous
                '~args
                ~[tree/set! [meta/parse/body :lambda args body] :source body]
                '~[compile/do* body [current-closure]]]]

[defmacro defn [name args . body]
          "Define a new function"
          [fn/check args body]
          [def fn-meta [tree/set! [meta/parse/body :lambda args body] :source body]]
          [def def-form `[def ~name [fn* '~name
                           '~args
                           ~fn-meta
                           '~[compile/do* body [current-closure]]]]]
          [if [tree/ref fn-meta :export]
              [list 'export name def-form]
              def-form]]

[defn eval-in [closure expr]
      "Compile and the immediatly evaluate the result"
      ""
      "Mostly used by lRun() and [eval]"
      [bytecode-eval* [compile* expr closure] closure]]

[defmacro eval [expr]
          "Compile, Evaluate and then return the result of EXPR"
          `[eval-in [current-closure] ~expr]]

[defmacro typecheck/only [v t]
          `[when-not [= [type-of ~v] ~t] [throw [list :type-error ~[fmt "Expected a value of type {t}"] ~v [current-lambda]]]]]

[defn typecheck/numeric/single [v]
      `[when-not [numeric? ~v] [throw [list :type-error ~[fmt "Expected numeric value"] ~v [current-lambda]]]]]

[defmacro typecheck/numeric v
          [map v typecheck/numeric/single]]

[defn profile-form [raw]
      [def start-time [time/milliseconds]]
      [def val [eval raw]]
      [def end-time [time/milliseconds]]
      [println [cat "Evaluating " [string/write raw] " to " [string/write val] " took " [cat [- end-time start-time] "ms"]]]]

[defmacro profile body
          "Measure and display how much time and ressources it takes for BODY to be evaluated"
          `[profile-form '~[if [last? body]
                               [car body]
                               [cons 'do body]]]]