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 module system

(def module/cache {})
(def module/store {})
(def module/loader #nil)

(defn module/save-state ()
      :internal
      {:cache module/cache :loader module/loader})

(defn module/restore-state (c)
      :internal
      (set! module/cache (ref c :cache))
      (set! module/loader (ref c :loader)))

(defn module/qualify-symbol (module-name symbol)
      :internal
      (case (:type-name module-name)
            (:string (module/qualify-symbol (:keyword module-name) symbol))
            (:keyword (:symbol (cat (:symbol module-name) "/" (:string symbol))))
            (otherwise (exception "Can't qualify that" module-name))))

(defn require* (module env qualify?)
      :internal
      (def mod (module/load module env))
      (when-not mod (exception "Can't load that module" module))
      (def exports (ref mod :exports))
      (doseq (k (:keys exports))
             (set! env
               (if qualify?
                   (module/qualify-symbol module (:symbol k))
                   (:symbol k))
               (ref exports k))))

(defn module/load/cache (name)
      :internal
      (ref module/cache name))

(defn module/load/store (name)
      :internal
      (def source (ref module/store name))
      (when source
        (eval-in (environment*) `(defmodule ~name ~@(read source)))
        (module/load/cache name)))

(defn module/load/external (name)
      :internal
      (doseq (loader module/loader)
             (def mod (loader name))
             (when mod
               (set! module/cache name mod)
               (return mod))))

(defn module/insert/defer (name module-source)
      :internal
      (set! module/store name module-source))

(defn module/insert (name module)
      :internal
      (set! module/cache name module))

(defn module/resolve-string/join (parts ret)
      :internal
      (cond ((not parts) ret)
            ((or (= "" (car parts))
                 (= "." (car parts)))
             (module/resolve-string/join (cdr parts) ret))
            ((= ".." (car parts))
             (when-not (cadr parts)
                       (exception "Invalid path" parts))
             (module/resolve-string/join (cddr parts) ret))
            (otherwise (module/resolve-string/join (cdr parts) (cons (car parts) ret)))))

(defn module/resolve-string (name wd)
      :internal
      (def mod-path wd)
      (def parts (module/resolve-string/join (nreverse (append (split mod-path "/") (split name "/"))) #nil))
      (:keyword (join (cons "" parts) "/"))) ; The cons is for the leading /

(defn module/load (name env)
      :internal
      (case (:type-name name)
            (:environment name)
            (:string (module/load (module/resolve-string name (ref env :*module-path*)) env))
            (:keyword (or (module/load/cache name)
                          (module/load/store name)
                          (module/load/external name)))
            (otherwise (exception "Can't load that value as a module" name))))

(defn module/import-all (module symbol)
      :internal
      (def exports (ref module :exports))
      (typecheck/only exports :tree)
      (return exports))

(defn module/import (module symbol)
      :internal
      (def exports (module/import-all module symbol))
      (when-not (:has? exports symbol)
                (exception :import-error (if (resolves? symbol module)
                                             "That symbol was not exported"
                                             "That symbol does not exist in that module")))
      (ref exports symbol))


(defn module/add-loader (f)
      (set! module/loader (cons f module/loader)))

(defmacro module body
          "Define a new module and return it"
          (macroexpand* (cons 'environment* (cons '(def exports {}) body)) (current-closure)))

(defmacro defmodule (name . body)
          "Define a new named module"
          `(module/insert ~name (module (def *module* ~name) ~@body)))

(defmacro defmodule/defer (name . body)
          "Define a new named module"
          `(module/insert/defer ~name (string/write ~(list 'quote (cons 'do body)))))

(defmacro export (name value)
          `(set! exports '~name ~value))

(defmacro use (module)
          `(require* ~module (current-closure) #f))

(defmacro require (module)
          `(require* ~module (current-closure) #t))

(defmacro import* (local-symbol module module-symbol)
          `(def ~local-symbol (module/import ~module '~module-symbol)))

(defmacro import (names module)
          (when-not (list? names)
                    (return `(import* ~names (module/load ~module (current-closure)) ~names)))
          (def ret #nil)
          (while names
                 (if (= (cadr names) :as)
                     (do (set! ret (cons `(import* ~(caddr names) (module/load ~module (current-closure)) ~(car names)) ret))
                         (set! names (cddr names)))
                     (set! ret (cons `(import* ~(car names) (module/load ~module (current-closure)) ~(car names)) ret)))
                 (cdr! names))
          (cons do (nreverse ret)))

(defn module/main (module args)
      "Import and run MODULE's main function with ARGS"
      (def mod (module/load module (current-closure)))
      (when-not mod (exception "Module not found" module))
      (def exports (ref mod :exports))
      (when-not exports (exception "Invalid module, can't resolve exports" module))
      (def main (ref exports :main))
      (when-not main (exception "There is no symbol exported as main" module))
      (when-not (procedure? main) (exception "main is not a callable value" module))
      (main args))