More work on installation and moving files around.

Move all installed libraries into auxlib.
Move all installed executable scripts into auxbin.

tools/bars.janet

@@ -1,55 +0,0 @@
-# A flexible templater for janet. Compiles
-# templates to janet functions that produce buffers.
-
-(defn template
-  "Compile a template string into a function"
-  [source]
-
-  # State for compilation machine
-  (def p (parser/new))
-  (def forms @[])
-
-  (defn parse-chunk
-    "Parse a string and push produced values to forms."
-    [chunk]
-    (parser/consume p chunk)
-    (while (parser/has-more p)
-      (array/push forms (parser/produce p)))
-    (if (= :error (parser/status p))
-      (error (parser/error p))))
-
-  (defn code-chunk
-    "Parse all the forms in str and return them
-    in a tuple prefixed with 'do."
-    [str]
-    (parse-chunk str)
-    true)
-
-  (defn string-chunk
-    "Insert string chunk into parser"
-    [str]
-    (parser/insert p str)
-    (parse-chunk "")
-    true)
-
-  # Run peg
-  (def grammar 
-    ~{:code-chunk (* "{%" (drop (cmt '(any (if-not "%}" 1)) ,code-chunk)) "%}")
-      :main-chunk (drop (cmt '(any (if-not "{%" 1)) ,string-chunk))
-      :main (any (+ :code-chunk :main-chunk (error "")))})
-  (def parts (peg/match grammar source))
-
-  # Check errors in template and parser
-  (unless parts (error "invalid template syntax"))
-  (parse-chunk "\n")
-  (case (parser/status p)
-    :pending (error (string "unfinished parser state " (parser/state p)))
-    :error (error (parser/error p)))
-
-  # Make ast from forms
-  (def ast ~(fn [&opt params] (default params @{}) (,buffer ,;forms)))
-
-  (def ctor (compile ast (fiber/getenv (fiber/current)) source))
-  (if-not (function? ctor)
-    (error (string "could not compile template")))
-  (ctor))

tools/cook.janet

@@ -1,368 +0,0 @@
-### cook.janet
-###
-### Library to help build janet natives and other
-### build artifacts.
-###
-### Copyright 2019 © Calvin Rose
-
-#
-# Basic Path Settings
-#
-
-# Windows is the OS outlier
-(def- is-win (= (os/which) :windows))
-(def- is-mac (= (os/which) :macos))
-(def- sep (if is-win "\\" "/"))
-(def- objext (if is-win ".obj" ".o"))
-(def- modext (if is-win ".dll" ".so"))
-
-#
-# Rule Engine
-#
-
-(defn- getrules []
-  (def rules (dyn :rules))
-  (if rules rules (setdyn :rules @{})))
-
-(defn- gettarget [target]
-  (def item ((getrules) target))
-  (unless item (error (string "No rule for target " target)))
-  item)
-
-(defn- rule-impl
-  [target deps thunk &opt phony]
-  (put (getrules) target @[(array/slice deps) thunk phony]))
-
-(defmacro rule
-  "Add a rule to the rule graph."
-  [target deps & body]
-  ~(,rule-impl ,target ,deps (fn [] nil ,;body)))
-
-(defmacro phony
-  "Add a phony rule to the rule graph. A phony rule will run every time
-  (it is always considered out of date). Phony rules are good for defining
-  user facing tasks."
-  [target deps & body]
-  ~(,rule-impl ,target ,deps (fn [] nil ,;body) true))
-
-(defn add-dep
-  "Add a dependency to an existing rule. Useful for extending phony
-  rules or extending the dependency graph of existing rules."
-  [target dep]
-  (def [deps] (gettarget target))
-  (array/push deps dep))
-
-(defn- add-thunk
-  [target more]
-  (def item (gettarget target))
-  (def [_ thunk] item)
-  (put item 1 (fn [] (more) (thunk))))
-
-(defmacro add-body
-  "Add recipe code to an existing rule. This makes existing rules do more but
-  does not modify the dependency graph."
-  [target & body]
-  ~(,add-thunk ,target (fn [] ,;body)))
-
-(defn- needs-build
-  [dest src]
-  (let [mod-dest (os/stat dest :modified)
-        mod-src (os/stat src :modified)]
-    (< mod-dest mod-src)))
-
-(defn- needs-build-some
-  [dest sources]
-  (def f (file/open dest))
-  (if (not f) (break true))
-  (file/close f)
-  (some (partial needs-build dest) sources))
-
-(defn do-rule
-  "Evaluate a given rule."
-  [target]
-  (def item ((getrules) target))
-  (unless item
-    (if (os/stat target :mode)
-      (break target)
-      (error (string "No rule for file " target " found."))))
-  (def [deps thunk phony] item)
-  (def realdeps (seq [dep :in deps :let [x (do-rule dep)] :when x] x))
-  (when (or phony (needs-build-some target realdeps))
-    (thunk))
-  (unless phony target))
-
-(def- _env (fiber/getenv (fiber/current)))
-(defn- import-rules*
-  [path & args]
-  (def [realpath] (module/find path))
-  (def env (make-env))
-  (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)))
-  (require path :env env ;args)
-  (when-let [rules (env :rules)] (merge-into (getrules) rules)))
-
-(defmacro import-rules
-  "Import another file that defines more cook rules. This ruleset
-  is merged into the current ruleset."
-  [path & args]
-  ~(,import-rules* ,(string path) ,;args))
-
-#
-# Configuration
-#
-
-# Installation settings
-(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") module/*syspath*))
-(def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH") module/*headerpath*))
-(def JANET_BINPATH (or (os/getenv "JANET_BINPATH") (unless is-win "/usr/local/bin")))
-                    
-# Compilation settings
-(def OPTIMIZE (or (os/getenv "OPTIMIZE") 2))
-(def CC (or (os/getenv "CC") (if is-win "cl" "cc")))
-(def LD (or (os/getenv "LINKER") (if is-win "link" CC)))
-(def LDFLAGS (or (os/getenv "LFLAGS")
-                 (if is-win " /nologo"
-                   (string " -shared"
-                           (if is-mac " -undefined dynamic_lookup" "")))))
-(def CFLAGS (or (os/getenv "CFLAGS") (if is-win "" " -std=c99 -Wall -Wextra -fpic")))
-
-(defn- opt
-  "Get an option, allowing overrides via dynamic bindings AND some
-  default value dflt if no dynamic binding is set."
-  [opts key dflt]
-  (def ret (or (opts key) (dyn key dflt)))
-  (if (= nil ret)
-    (error (string "option :" key " not set")))
-  ret)
-
-#
-# OS and shell helpers
-#
-
-(defn shell
-  "Do a shell command"
-  [& args]
-  (def cmd (string/join args))
-  (print cmd)
-  (def res (os/shell cmd))
-  (unless (zero? res)
-    (error (string "command exited with status " res))))
-
-(defn rm
-  "Remove a directory and all sub directories."
-  [path]
-  (if (= (os/stat path :mode) :directory)
-    (do
-      (each subpath (os/dir path)
-        (rm (string path sep subpath)))
-      (os/rmdir path))
-    (os/rm path)))
-
-(defn copy
-  "Copy a file or directory recursively from one location to another."
-  [src dest]
-  (shell (if is-win "xcopy " "cp -rf ") `"` src `" "` dest (if is-win `" /y /e` `"`)))
-
-#
-# C Compilation
-#
-
-(defn- embed-name
-  "Rename a janet symbol for embedding."
-  [path]
-  (->> path
-       (string/replace-all sep "___")
-       (string/replace-all ".janet" "")))
-
-(defn- embed-c-name
-  "Rename a janet file for embedding."
-  [path]
-  (->> path
-       (string/replace-all sep "___")
-       (string/replace-all ".janet" ".janet.c")
-       (string "build" sep)))
-
-(defn- embed-o-name
-  "Get object file for c file."
-  [path]
-  (->> path
-       (string/replace-all sep "___")
-       (string/replace-all ".janet" (string ".janet" objext))
-       (string "build" sep)))
-
-(defn- object-name
-  "Rename a source file so it can be built in a flat source tree."
-  [path]
-  (->> path
-       (string/replace-all sep "___")
-       (string/replace-all ".c" (if is-win ".obj" ".o"))
-       (string "build" sep)))
-
-(defn- lib-name
-  "Generate name for dynamic library."
-  [name]
-  (string "build" sep name modext))
-
-(defn- make-define
-  "Generate strings for adding custom defines to the compiler."
-  [define value]
-  (def pre (if is-win "/D" "-D"))
-  (if value
-    (string pre define "=" value)
-    (string pre define)))
-
-(defn- make-defines
-  "Generate many defines. Takes a dictionary of defines. If a value is
-  true, generates -DNAME (/DNAME on windows), otherwise -DNAME=value."
-  [defines]
-  (seq [[d v] :pairs defines] (make-define d (if (not= v true) v))))
-
-(defn- getcflags
-  "Generate the c flags from the input options."
-  [opts]
-  (string (opt opts :cflags CFLAGS)
-          (if is-win " /I\"" " \"-I")
-          (opt opts :headerpath JANET_HEADERPATH)
-          `"`
-          (if is-win " /O\"" " \"-O")
-          (opt opts :optimize OPTIMIZE)
-          `"`))
-
-(defn- compile-c
-  "Compile a C file into an object file."
-  [opts src dest]
-  (def cc (opt opts :compiler CC))
-  (def cflags (getcflags opts))
-  (def defines (interpose " " (make-defines (opt opts :defines {}))))
-  (rule dest [src]
-        (if is-win
-          (shell cc " " ;defines " /nologo /c " cflags " /Fo\"" dest `" "` src `"`)
-          (shell cc " -c '" src "' " ;defines " " cflags " -o '" dest `'`))))
-
-(defn- link-c
-  "Link a number of object files together."
-  [opts target & objects]
-  (def ld (opt opts :linker LD))
-  (def cflags (getcflags opts))
-  (def lflags (opt opts :lflags LDFLAGS))
-  (def olist (string/join objects `" "`))
-  (rule target objects
-        (if is-win
-          (shell ld " " lflags " /DLL /OUT:" target ` "` olist `" "` (opt opts :headerpath JANET_HEADERPATH) `"\\janet.lib`)
-          (shell ld " " cflags ` -o "` target `" "` olist `" ` lflags))))
-
-(defn- create-buffer-c
-  "Inline raw byte file as a c file."
-  [source dest name]
-  (rule dest [source]
-        (def f (file/open source :r))
-        (if (not f) (error (string "file " f " not found")))
-        (def out (file/open dest :w))
-        (def chunks (seq [b :in (file/read f :all)] (string b)))
-        (file/write out
-                    "#include <janet.h>\n"
-                    "static const unsigned char bytes[] = {"
-                    ;(interpose ", " chunks)
-                    "};\n\n"
-                    "const unsigned char *" name "_embed = bytes;\n"
-                    "size_t " name "_embed_size = sizeof(bytes);\n")
-        (file/close out)
-        (file/close f)))
-
-#
-# Declaring Artifacts - used in project.janet, targets specifically
-# tailored for janet.
-#
-
-(defn- install-rule
-  "Add install and uninstall rule for moving file from src into destdir."
-  [src destdir]
-  (def parts (string/split sep src))
-  (def name (last parts))
-  (add-body "install"
-            (try (os/mkdir destdir) ([err] nil))
-            (copy src destdir))
-  (add-body "uninstall"
-            (def path (string destdir sep name))
-            (print "removing " path)
-            (try (rm path) ([err]
-                            (unless (= err "No such file or directory")
-                              (error err))))))
-
-(defn declare-native
-  "Declare a native binary. This is a shared library that can be loaded
-  dynamically by a janet runtime."
-  [&keys opts]
-  (def sources (opts :source))
-  (def name (opts :name))
-  (def lname (lib-name name))
-  (loop [src :in sources]
-    (compile-c opts src (object-name src)))
-  (def objects (map object-name sources))
-  (when-let [embedded (opts :embedded)]
-            (loop [src :in embedded]
-              (def c-src (embed-c-name src))
-              (def o-src (embed-o-name src))
-              (array/push objects o-src)
-              (create-buffer-c src c-src (embed-name src))
-              (compile-c opts c-src o-src)))
-  (link-c opts lname ;objects)
-  (add-dep "build" lname)
-  (def path (opt opts :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)))
-
-(defn declare-binscript
-  "Declare a janet file to be installed as an executable script."
-  [&keys opts]
-  (def main (opts :main))
-  (def binpath (opt opts :binpath JANET_BINPATH))
-  (install-rule main binpath))
-
-(defn declare-archive
-  "Build a janet archive. This is a file that bundles together many janet
-  scripts into a janet image. This file can the be moved to any machine with
-  a janet vm and the required dependencies and run there."
-  [&keys opts]
-  (def entry (opts :entry))
-  (def name (opts :name))
-  (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))
-  (install-rule iname path))
-
-(defn declare-project
-  "Define your project metadata. This should
-  be the first declaration in a project.janet file.
-  Also sets up basic phony targets like clean, build, test, etc."
-  [&keys meta]
-  (setdyn :project meta)
-  (try (os/mkdir "build") ([err] nil))
-  (phony "build" [])
-  (phony "install" ["build"] (print "Installed."))
-  (phony "uninstall" [] (print "Uninstalled."))
-  (phony "clean" [] (rm "build") (print "Deleted build directory."))
-  (phony "test" ["build"]
-         (defn dodir
-           [dir]
-           (each sub (os/dir dir)
-             (def ndir (string dir sep sub))
-             (case (os/stat ndir :mode)
-               :file (when (string/has-suffix? ".janet" ndir)
-                       (print "running " ndir " ...")
-                       (dofile ndir :exit true))
-               :directory (dodir ndir))))
-         (dodir "test")
-         (print "All tests passed.")))

tools/highlight.janet

@@ -1,198 +0,0 @@
-# Copyright (C) Calvin Rose 2019
-#
-# Takes in a janet string and colorizes for multiple
-# output formats.
-
-# Constants for checking if symbols should be
-# highlighted.
-(def- core-env (table/getproto *env*))
-(def- specials {'fn true
-               'var true
-               'do true
-               'while true
-               'def true
-               'splice true
-               'set true
-               'break true
-               'unquote true
-               'quasiquote true
-               'quote true
-               'if true})
-
-(defn check-number [text] (and (scan-number text) text))
-
-(defn- make-grammar
-  "Creates the grammar based on the paint function, which
-  colorizes fragments of text."
-  [paint]
-
-  (defn <-c
-    "Peg rule for capturing and coloring a rule."
-    [color what]
-    ~(/ (<- ,what) ,(partial paint color)))
-
-  (defn color-symbol
-    "Color a symbol only if it is a core library binding or special."
-    [text]
-    (def sym (symbol text))
-    (def should-color (or (specials sym) (core-env sym)))
-    (paint (if should-color :coresym :symbol) text))
-
-  ~{:ws (set " \t\r\f\n\v\0")
-    :readermac (set "';~,")
-    :symchars (+ (range "09" "AZ" "az" "\x80\xFF") (set "!$%&*+-./:<?=>@^_|"))
-    :token (some :symchars)
-    :hex (range "09" "af" "AF")
-    :escape (* "\\" (+ (set "ntrvzf0\"\\e")
-                       (* "x" :hex :hex)
-                       (error (constant "bad hex escape"))))
-
-    :comment ,(<-c :comment ~(* "#" (any (if-not (+ "\n" -1) 1))))
-
-    :symbol (/ ':token ,color-symbol)
-    :keyword ,(<-c :keyword ~(* ":" (any :symchars)))
-    :constant ,(<-c :constant ~(+ "true" "false" "nil"))
-    :bytes (* "\"" (any (+ :escape (if-not "\"" 1))) "\"")
-    :string ,(<-c :string :bytes)
-    :buffer ,(<-c :string ~(* "@" :bytes))
-    :long-bytes {:delim (some "`")
-                 :open (capture :delim :n)
-                 :close (cmt (* (not (> -1 "`")) (-> :n) ':delim) ,=)
-                 :main (drop (* :open (any (if-not :close 1)) :close))}
-    :long-string ,(<-c :string :long-bytes)
-    :long-buffer ,(<-c :string ~(* "@" :long-bytes))
-    :number (/ (cmt ':token ,check-number) ,(partial paint :number))
-
-    :raw-value (+ :comment :constant :number :keyword
-                  :string :buffer :long-string :long-buffer
-                  :parray :barray :ptuple :btuple :struct :dict :symbol)
-
-    :value (* (? '(some (+ :ws :readermac))) :raw-value '(any :ws))
-    :root (any :value)
-    :root2 (any (* :value :value))
-    :ptuple (* '"(" :root (+ '")" (error "")))
-    :btuple (* '"[" :root (+ '"]" (error "")))
-    :struct (* '"{" :root2 (+ '"}" (error "")))
-    :parray (* '"@" :ptuple)
-    :barray (* '"@" :btuple)
-    :dict (* '"@"  :struct)
-
-    :main (+ (% :root) (error ""))})
-
-# Terminal syntax highlighting
-
-(def- terminal-colors
-  {:number 32
-   :keyword 33
-   :string 35
-   :coresym 31
-   :constant 34
-   :comment 36})
-
-(defn- terminal-paint
-  "Paint colors for ansi terminals"
-  [what str]
-  (def code (get terminal-colors what))
-  (if code (string "\e[" code "m" str "\e[0m") str))
-
-# HTML syntax highlighting
-
-(def- html-colors
-  {:number "j-number"
-   :keyword "j-keyword"
-   :string "j-string"
-   :coresym "j-coresym"
-   :constant "j-constant"
-   :comment "j-comment"
-   :line "j-line"})
-
-(def- escapes
-  {38 "&amp;"
-   60 "&lt;"
-   62 "&gt;"
-   34 "&quot;"
-   39 "&#39;"
-   47 "&#47;"})
-
-(def html-style
-  "Style tag to add to a page to highlight janet code"
-```
-<style type="text/css">
-.j-main { color: white; background: #111; font-size: 1.4em; }
-.j-number { color: #89dc76; }
-.j-keyword { color: #ffd866; }
-.j-string { color: #ab90f2; }
-.j-coresym { color: #ff6188; }
-.j-constant { color: #fc9867; }
-.j-comment { color: darkgray; }
-.j-line { color: gray; }
-</style>
-```)
-
-(defn html-escape
-  "Escape special characters for HTML encoding."
-  [str]
-  (def buf @"")
-  (loop [byte :in str]
-    (if-let [rep (get escapes byte)]
-      (buffer/push-string buf rep)
-      (buffer/push-byte buf byte)))
-  buf)
-
-(defn- html-paint
-  "Paint colors for HTML"
-  [what str]
-  (def color (get html-colors what))
-  (def escaped (html-escape str))
-  (if color
-    (string "<span class=\"" color "\">" escaped "</span>")
-    escaped))
-
-# Create Pegs
-
-(def- terminal-grammar (peg/compile (make-grammar terminal-paint)))
-(def- html-grammar (peg/compile (make-grammar html-paint)))
-
-# API
-
-(defn ansi
-  "Highlight janet source code ANSI Termianl escape colors."
-  [source]
-  (0 (peg/match terminal-grammar source)))
-
-(defn html
-  "Highlight janet source code and output HTML."
-  [source]
-  (string "<pre class=\"j-main\"><code>"
-          (0 (peg/match html-grammar source))
-          "</code></pre>"))
-
-(defn html-file
-  "Highlight a janet file and print out a highlighted HTML version
-  of the file. Must provide a default title when creating the file."
-  [in-path out-path title &]
-  (default title in-path)
-  (def f (file/open in-path :r))
-  (def source (file/read f :all))
-  (file/close f)
-  (def markup (0 (peg/match html-grammar source)))
-  (def out (file/open out-path :w))
-  (file/write out
-              "<!doctype html><html><head><meta charset=\"UTF-8\">"
-              html-style
-              "<title>"
-              title
-              "</title></head>"
-              "<body class=\"j-main\"><pre>"
-              markup
-              "</pre></body></html>")
-  (file/close out))
-
-(defn ansi-file
-  "Highlight a janet file and print the highlighted output to stdout."
-  [in-path]
-  (def f (file/open in-path :r))
-  (def source (file/read f :all))
-  (file/close f)
-  (def markup (0 (peg/match terminal-grammar source)))
-  (print markup))

tools/jpm

@@ -1,41 +0,0 @@
-#!/usr/bin/env janet
-
-# CLI tool for building janet projects. Wraps cook.
-
-(import cook)
-
-(def- argpeg
-  (peg/compile
-    '(* "--" '(some (if-not "=" 1)) "=" '(any 1))))
-
-(defn- help
-  []
-  (print "usage: jpm [targets]... --key=value ...")
-  (print "Available targets are:")
-  (each k (sort (keys (dyn :rules @{})))
-    (print "  " k))
-  (print `
-
-Keys are:
-  --modpath : The directory to install modules to. Defaults to $JANET_MODPATH or module/*syspath*
-  --headerpath : The directory containing janet headers. Defaults to $JANET_HEADERPATH or module/*headerpath*
-  --binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH.
-  --optimize : Optimization level for natives. Defaults to $OPTIMIZE or 2.
-  --compiler : C compiler to use for natives. Defaults to $CC or cc.
-  --linker : C linker to use for linking natives. Defaults to $LINKER or cc.
-  --cflags : Extra compiler flags for native modules. Defaults to $CFLAGS if set.
-  --lflags : Extra linker flags for native modules. Defaults to $LFLAGS if set.
-    `))
-
-(def args (tuple/slice process/args 2))
-(def todo @[])
-(each arg args
-  (if (string/has-prefix? "--" arg)
-    (let [[key value] (peg/match argpeg arg)]
-      (setdyn (keyword key) value))
-    (array/push todo arg)))
-
-(cook/import-rules "./project.janet")
-
-(if (empty? todo) (help))
-(each rule todo (cook/do-rule rule))