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]
