Update cook and add an install test.

This commit is contained in:
Calvin Rose 2019-07-19 19:40:51 -05:00
parent 529b34d84e
commit 0d3986abbb
5 changed files with 69 additions and 45 deletions

View File

@ -91,23 +91,6 @@
(thunk))
(unless phony target))
(def- _env (fiber/getenv (fiber/current)))
(defn import-rules
"Import another file that defines more cook rules. This ruleset
is merged into the current ruleset."
[path]
(def env (make-env))
(unless (os/stat path :mode)
(error (string "cannot open " path)))
(loop [k :keys _env :when (symbol? k)]
(unless ((_env k) :private) (put env k (_env k))))
(def currenv (fiber/getenv (fiber/current)))
(loop [k :keys currenv :when (keyword? k)]
(put env k (currenv k)))
(dofile path :env env)
(when-let [rules (env :rules)] (merge-into (getrules) rules)))
#
# Configuration
#
@ -115,7 +98,7 @@
# Installation settings
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
(def JANET_HEADERPATH (os/getenv "JANET_HEADERPATH"))
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH") (unless is-win "/usr/local/bin")))
(def JANET_BINPATH (os/getenv "JANET_BINPATH"))
# Compilation settings
(def- OPTIMIZE (or (os/getenv "OPTIMIZE") 2))
@ -150,6 +133,35 @@
(error (string "option :" key " not set")))
ret)
#
# Importing a file
#
(def- _env (fiber/getenv (fiber/current)))
(defn- proto-flatten
[into x]
(when x
(proto-flatten into (table/getproto x))
(loop [k :keys x]
(put into k (x k))))
into)
(defn import-rules
"Import another file that defines more cook rules. This ruleset
is merged into the current ruleset."
[path]
(def env (make-env))
(unless (os/stat path :mode)
(error (string "cannot open " path)))
(loop [k :keys _env :when (symbol? k)]
(unless ((_env k) :private) (put env k (_env k))))
(def currenv (proto-flatten @{} (fiber/getenv (fiber/current))))
(loop [k :keys currenv :when (keyword? k)]
(put env k (currenv k)))
(dofile path :env env)
(when-let [rules (env :rules)] (merge-into (getrules) rules)))
#
# OS and shell helpers
#
@ -237,7 +249,7 @@
"Generate the c flags from the input options."
[opts]
@[;(opt opts :cflags CFLAGS)
(string (if is-win "/I" "-I") (opt opts :headerpath JANET_HEADERPATH))
(string (if is-win "/I" "-I") (dyn :headerpath JANET_HEADERPATH))
(string (if is-win "/O" "-O") (opt opts :optimize OPTIMIZE))])
(defn- compile-c
@ -262,7 +274,7 @@
(rule target objects
(print "linking " target "...")
(if is-win
(shell ld ;lflags (string "/OUT:" target) ;objects (string (opt opts :headerpath JANET_HEADERPATH) `\\janet.lib`))
(shell ld ;lflags (string "/OUT:" target) ;objects (string (dyn :headerpath JANET_HEADERPATH) `\\janet.lib`))
(shell ld ;cflags `-o` target ;objects ;lflags))))
(defn- create-buffer-c
@ -298,7 +310,7 @@
(def- filepath-replacer
"Convert url with potential bad characters into a file path element."
(peg/compile ~(% (* (+ (/ '(set "<>:\"/\\|?*") "_") '2)))))
(peg/compile ~(% (any (+ (/ '(set "<>:\"/\\|?*") "_") '1)))))
(defn repo-id
"Convert a repo url into a path component that serves as its id."
@ -308,24 +320,24 @@
(defn find-manifest-dir
"Get the path to the directory containing manifests for installed
packages."
[&opt opts]
(string (opt (or opts @{}) :modpath JANET_MODPATH) sep ".manifests"))
[]
(string (dyn :modpath JANET_MODPATH) sep ".manifests"))
(defn find-manifest
"Get the full path of a manifest file given a package name."
[name &opt opts]
(string (find-manifest-dir opts) sep name ".txt"))
[name]
(string (find-manifest-dir) sep name ".txt"))
(defn find-cache
"Return the path to the global cache."
[&opt opts]
(def path (opt (or opts @{}) :modpath JANET_MODPATH))
[]
(def path (dyn :modpath JANET_MODPATH))
(string path sep ".cache"))
(defn uninstall
"Uninstall bundle named name"
[name &opt opts]
(def manifest (find-manifest name opts))
[name]
(def manifest (find-manifest name))
(def f (file/open manifest :r))
(unless f (print manifest " does not exist") (break))
(loop [line :iterate (:read f :line)]
@ -341,14 +353,14 @@
(defn clear-cache
"Clear the global git cache."
[&opt opts]
(rm (find-cache opts)))
[]
(rm (find-cache)))
(defn install-git
"Install a bundle from git. If the bundle is already installed, the bundle
is reinistalled (but not rebuilt if artifacts are cached)."
[repo &opt opts]
(def cache (find-cache opts))
[repo]
(def cache (find-cache))
(os/mkdir cache)
(def id (repo-id repo))
(def module-dir (string cache sep id))
@ -400,31 +412,30 @@
(compile-c opts c-src o-src)))
(link-c opts lname ;objects)
(add-dep "build" lname)
(def path (opt opts :modpath JANET_MODPATH))
(def path (dyn :modpath JANET_MODPATH))
(install-rule lname path))
(defn declare-source
"Create a Janet modules. This does not actually build the module(s),
but registers it for packaging and installation."
[&keys opts]
(def sources (opts :source))
(def path (opt opts :modpath JANET_MODPATH))
(each s sources
(install-rule s path)))
[&keys {:source sources}]
(def path (dyn :modpath JANET_MODPATH))
(if (bytes? sources)
(install-rule sources path)
(each s sources
(install-rule s path))))
(defn declare-bin
"Declare a generic file to be installed as an executable."
[&keys opts]
(def main (opts :main))
(def binpath (opt opts :binpath JANET_BINPATH))
(install-rule main binpath))
[&keys {:main main}]
(install-rule main (dyn :binpath JANET_BINPATH)))
(defn declare-binscript
"Declare a janet file to be installed as an executable script. Creates
a shim on windows."
[&keys opts]
(def main (opts :main))
(def binpath (opt opts :binpath JANET_BINPATH))
(def binpath (dyn :binpath JANET_BINPATH))
(install-rule main binpath)
# Create a dud batch file when on windows.
(when is-win
@ -446,7 +457,7 @@
(def iname (string "build" sep name ".jimage"))
(rule iname (or (opts :deps) [])
(spit iname (make-image (require entry))))
(def path (opt opts :modpath JANET_MODPATH))
(def path (dyn :modpath JANET_MODPATH))
(install-rule iname path))
(defn declare-project

View File

@ -1782,6 +1782,12 @@
args))
(tuple import* (string path) ;argm))
(defmacro use
"Similar to import, but imported bindings are not prefixed with a namespace
identifier. Can also import multiple modules in one shot."
[& modules]
~(do ,;(map (fn [x] ~(,import* ,(string x) :prefix "")) modules)))
(defn repl
"Run a repl. The first parameter is an optional function to call to
get a chunk of source code that should return nil for end of file.

View File

@ -1 +1,2 @@
/build
.cache

View File

@ -0,0 +1 @@
/home/calvin/code/janet/test/install/json.so

View File

@ -1,3 +1,8 @@
(import build/testmod :as testmod)
(if (not= 5 (testmod/get5)) (error "testmod/get5 failed"))
(import cook)
(with-dyns [:modpath (os/cwd)]
(cook/install-git "https://github.com/janet-lang/json.git"))