application/octet-stream
•
8.02 KB
•
230 lines
;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; Contains various io routines for standalone Nujel runtimes
(defn file/copy (source-path destination-path)
"Copy a file from SOURCE-PATH to DESTINATION-PATH"
(spit destination-path (slurp source-path)))
(defn file/read (path)
"Read in a file using the Nujel reader"
(read (file/load path)))
(defn file/read/single (path)
"Read a single value from a file"
(car (file/read path)))
(defn file/eval (path environment)
"Evaluate a Nujel source file in the current context"
(eval-in (or environment root-closure)
(cons 'do (read (file/read path)))))
(defn file/eval-module (path args)
"Evaluate a Nujel source file in the current context"
(def mod-name (module/resolve-string (cat (path/without-extension path)) (path/working-directory)))
(def mod (module/load mod-name))
(when-not (= :environment (type-of mod))
(return mod))
(def exports (resolve 'exports mod))
(when-not exports (exception (fmt "Couldn't load {path} as a module since it has no exports")))
(when (tree/has? exports :main)
((tree/ref exports :main) args)))
(defn file/compile (path environment)
"Compile a Nujel source file into optimized object code"
(def source (cons 'do (read (file/read path))))
(def object-code (compile* source (or environment (environment*))))
(file/write (if object-code (string/write object-code) "")
(cat (path/without-extension path) ".no"))
(return object-code))
(defn file/compile/module (path environment base-dir)
"Compile a Nujel source file into optimized object code"
(def module-name (string->keyword (path/without-extension (string/cut path (length base-dir)))))
(def source `(defmodule/defer ~module-name (def *module* ~module-name) ~@(read (file/read path))))
(def object-code (compile* source (or environment (environment*))))
(file/write (if object-code (string/write object-code) "")
(cat (path/without-extension path) ".no"))
(return object-code))
(defn file/compile/argv ()
(def path (car (last-pair init/args)))
(def module (index-of path "_modules/"))
(if (>= module 0)
(file/compile/module path #nil (string/cut path 0 (+ module 9)))
(file/compile path))
(exit 0))
(defn file/test/module/run (tests module-name)
(import (run-test!) :test)
(doseq (expr tests)
(run-test! (eval (cadr expr))
`(do (require ~module-name) ~@(cddr expr)))))
(defn file/test/valid-test-form? (form)
(== (car form) 'deftest))
(defn file/test/module (path base-dir)
"Test a module by running all contained tests"
(def rel-path (string/cut path (length base-dir)))
(when (== (buffer/ref rel-path 0) #\/)
(set! rel-path (string/cut rel-path 1)))
(def module-name (string->keyword (path/without-extension rel-path)))
(import (blue) :ansi)
(import (init! finish!) :test)
(init!)
(-> (read (file/read path))
(filter file/test/valid-test-form?)
(file/test/module/run module-name))
(finish! (blue module-name)))
(defn file/test/directory (base-dir)
"Compile a Nujel source file into optimized object code"
(-> (directory/read-recursive base-dir)
(flatten)
(sort)
(filter (path/ext?! "nuj"))
(map (fn (path) (file/test/module path base-dir)))
(sum)))
(defn file/file? (filename)
(ref (file/stat filename) :regular-file?))
(defn file/dir? (filename)
(ref (file/stat filename) :directory?))
(defn directory/read-relative (path)
(map (directory/read path)
(fn (a) (cat path "/" a))))
(defn directory/read-recursive/fn (A)
(if (file/dir? A)
(directory/read-recursive A)
A))
(defn directory/read-recursive (path)
(flatten (filter (map (directory/read-relative path)
directory/read-recursive/fn)
identity)))
(defn load (filename)
(try (fn (err)
(print/error err)
#f)
(file/eval filename)
(pfmtln "Loaded {filename}")
#t))
(defn slurp/buffer (pathname)
"Read the entirety of PATHNAME and return it as a string if possible, otherwise return #nil."
(def fh (file/open-input* pathname))
(when-not fh (return #nil))
(try (fn ()
(file/close* fh)
(return #nil))
(file/seek* fh 0 2)
(def size (file/tell* fh))
(file/seek* fh 0 0)
(def buf (buffer/allocate size))
(file/read* fh buf size)
(file/close* fh)
(return buf)))
(def file/read/buffer slurp/buffer)
(defn slurp (pathname)
"Read the entirety of PATHNAME and return it as a string if possible, otherwise return #nil."
(buffer->string (slurp/buffer pathname)))
(def file/read slurp)
(defn spit (pathname content)
"Read the entirety of PATHNAME and return it as a string if possible, otherwise return #nil."
(def fh (file/open-output* pathname :replace))
(when-not fh (return #f))
(try (fn ()
(file/close* fh)
(return #f))
(file/write* fh content)
(file/close* fh))
(return #t))
(defn file/write (content pathname)
"Writes CONTENT into PATHNAME"
(spit pathname content))
(def stdin (make-input-port stdin*))
(defn current-input-port () stdin)
(defn current-input-port! (nport) (set! stdin nport))
(def stdout (make-output-port stdout*))
(defn current-output-port () stdout)
(defn current-output-port! (nport) (set! stdout nport))
(def stderr (make-output-port stderr*))
(defn current-error-port () stderr)
(defn current-error-port! (nport) (set! stderr nport))
(defn newline (port)
"Print a single line feed character"
((or port stdout) 'block-write "\r\n")
#nil)
(defn print (v port)
"Display V on the standard output port"
(write/raw v (or port stdout) #t)
(return v))
(defn error (v port)
"Prints v on the standard error port"
(print v stderr))
(defn read-line/raw (port buf)
"Reads in a line of user input and returns it"
(def i 0)
(def c 0)
(def view (buffer/u8* buf))
(while #t
(while (>= i (buffer/length buf))
(buffer/length! (+ 128 (buffer/length buf))))
(set! c (port 'char-read))
(when (== c :end-of-file)
(return (if (zero? i) #nil i)))
(when (== c #\lf)
(return i))
(buffer/set! view i c)
(set! i (inc i))))
(defn read-line ()
"Reads in a line of user input and returns it"
(def buf (buffer/allocate 128))
(def len (read-line/raw stdin buf))
(and len (buffer->string buf len)))
(def input read-line)
(defn readline (prompt)
"Read a line of input in a user friendly way after writing PROMPT"
(stdout 'block-write (or prompt ""))
(stdout 'flush-output)
(read-line))
(defn popen/trim (cmd)
"Run CMD using popen and return the trimmed stdout"
(trim (cdr (popen cmd))))
(def +root-working-dir+ (path/working-directory))
(def *module-path* (path/working-directory))
(defn module/loader/filesystem (name)
(def name-string (keyword->string name))
(when-not (== (buffer/ref name-string 0) #\/) (return #nil)) ; Paths have to start with a /
(when (== System/OS 'Windows) (set! name-string (string/cut name-string 1)))
(def module-path (fmt "{}.nuj" name-string))
(def source (file/read module-path))
(when-not source (return #nil))
(def expr (list 'module
`(def *module* ~name)
`(def *module-path* ~(path/dirname module-path))
(cons do (read source))))
(def mod (eval expr))
(return mod))
(module/add-loader module/loader/filesystem)
