~bakpakin/janet

baf7be1e52d4a80bad4e97953aad73e5f871072e — Calvin Rose 3 years ago f198071 newjpm
More work on bringing jpm port to functional levels.

Can now compiler jaylib quickly and bootstrap.
M jpm => jpm +2 -2
@@ 1065,7 1065,7 @@ int main(int argc, const char **argv) {
  :prefix can optionally be given to modify the destination path to be
  (string JANET_PATH prefix source)."
  [&keys {:source sources :prefix prefix}]
  (def path (string (dyn :modpath JANET_MODPATH) (or prefix "")))
  (def path (string (dyn :modpath JANET_MODPATH) "/" (or prefix "")))
  (if (bytes? sources)
    (install-rule sources path)
    (each s sources


@@ 1075,7 1075,7 @@ int main(int argc, const char **argv) {
  "Declare headers for a library installation. Installed headers can be used by other native
  libraries."
  [&keys {:headers headers :prefix prefix}]
  (def path (string (dyn :modpath JANET_MODPATH) (or prefix "")))
  (def path (string (dyn :modpath JANET_MODPATH) "/" (or prefix "")))
  (if (bytes? headers)
    (install-rule headers path)
    (each h headers

M src/jpm/cc.janet => src/jpm/cc.janet +3 -3
@@ 70,7 70,7 @@
  (def defines [;(make-defines (opt opts :defines {})) ;entry-defines])
  (def headers (or (opts :headers) []))
  (rule dest [src ;headers]
        (print "compiling " src " to " dest "...")
        (unless (dyn:verbose) (print "compiling " src " to " dest "..."))
        (create-dirs dest)
        (if (dyn :is-msvc)
          (shell cc ;defines "/c" ;cflags (string "/Fo" dest) src)


@@ 89,7 89,7 @@
  (def dep-importlibs (seq [x :in deplibs] (string (dyn:modpath) "/" x ".lib")))
  (def ldflags [;(opt opts :ldflags []) ;dep-ldflags])
  (rule target objects
        (print "linking " target "...")
        (unless (dyn:verbose) (print "linking " target "..."))
        (create-dirs target)
        (if (dyn :is-msvc)
          (shell linker ;ldflags (string "/OUT:" target) ;objects


@@ 101,7 101,7 @@
  [opts target & objects]
  (def ar (opt opts :ar))
  (rule target objects
        (print "creating static library " target "...")
        (unless (dyn:verbose) (print "creating static library " target "..."))
        (create-dirs target)
        (if (dyn :is-msvc)
          (shell ar "/nologo" (string "/out:" target) ;objects)

M src/jpm/cli.janet => src/jpm/cli.janet +31 -16
@@ 55,9 55,9 @@
  (setdyn :lflags @[])
  (setdyn :ldflags @[])
  (setdyn :cflags @["-std=c99" "-Wall" "-Wextra"])
  (setdyn :cppflags @["-std=c99" "-Wall" "-Wextra"])
  (setdyn :cppflags @["-std=c++11" "-Wall" "-Wextra"])
  (setdyn :dynamic-lflags @["-shared" "-lpthread"])
  (setdyn :dynamic-cflags @[])
  (setdyn :dynamic-cflags @["-fPIC"])
  (setdyn :optimize 2)
  (setdyn :modext ".so")
  (setdyn :statext ".a")


@@ 69,23 69,38 @@
  (setdyn :jpm-env _env)
  (setdyn :janet (dyn :executable))
  (setdyn :auto-shebang true)
  (setdyn :workers nil)
  (setdyn :verbose false)

  # Get flags
  (while (< i len)
    (if-let [m (peg/match argpeg (args i))]
      (if (= 2 (length m))
        (let [[key value] m]
          (setdyn (keyword key) value))
        (setdyn (keyword (m 0)) true))
      (break))
    (++ i))
  (def cmdbuf @[])
  (var flags-done false)
  (each a args
    (cond
      (= a "--")
      (set flags-done true)

      flags-done
      (array/push cmdbuf a)

      (if-let [m (peg/match argpeg a)]
        (do
          (def key (keyword (get m 0)))
          (def value-parser (get config-dyns key))
          (unless value-parser
            (error (string "unknown cli option " key)))
          (if (= 2 (length m))
            (do
              (def v (value-parser key (get m 1)))
              (setdyn key v))
            (setdyn key true)))
        (array/push cmdbuf a))))

  # Run subcommand
  (if (= i len)
  (if (empty? cmdbuf)
    (commands/help)
    (do
      (if-let [com (get commands/subcommands (args i))]
        (com ;(tuple/slice args (+ i 1)))
    (if-let [com (get commands/subcommands (first cmdbuf))]
        (com ;(slice cmdbuf 1))
        (do
          (print "invalid command " (args i))
          (commands/help))))))
          (print "invalid command " (first cmdbuf))
          (commands/help)))))

M src/jpm/commands.janet => src/jpm/commands.janet +2 -6
@@ 9,7 9,7 @@
(use ./cc)
(use ./pm)

(defn- help
(defn help
  []
  (print `
usage: jpm [--key=value, --flag] ... [subcommand] [args] ...


@@ 87,10 87,6 @@ Flags are:
  (import-rules "./project.janet" no-deps)
  (do-rule rule))

(defn show-help
  []
  (print help))

(defn show-paths
  []
  (print "binpath:    " (dyn:binpath))


@@ 213,7 209,7 @@ Flags are:
(def subcommands
  {"build" build
   "clean" clean
   "help" show-help
   "help" help
   "install" install
   "test" test
   "help" help

M src/jpm/config.janet => src/jpm/config.janet +68 -32
@@ 7,11 7,44 @@
  "A table of all of the dynamic config bindings."
  @{})

(defn- parse-boolean
  [kw x]
  (case (string/ascii-lower x)
    "f" false
    "0" false
    "false" false
    "off" false
    "no" false
    "t" true
    "1" true
    "on" true
    "yes" true
    "true" true
    (errorf "option :%s, unknown boolean option %s" kw x)))

(defn- parse-integer
  [kw x]
  (if-let [n (scan-number x)]
    (if (not= n (math/floor n))
      (errorf "option :%s, expected integer, got %v" kw x)
      n)
    (errorf "option :%s, expected integer, got %v" kw x)))

(defn- parse-string
  [kw x]
  x)

(def- config-parsers
  "A table of all of the option parsers."
  @{:int parse-integer
    :string parse-string
    :boolean parse-boolean})

(defmacro defdyn
  "Define a function that wraps (dyn :keyword). This will
  allow use of dynamic bindings with static runtime checks."
  [kw & meta]
  (put config-dyns kw true)
  [kw parser & meta]
  (put config-dyns kw (get config-parsers parser))
  (let [s (symbol "dyn:" kw)]
    ~(defn ,s ,;meta [&opt dflt]
       (def x (,dyn ,kw dflt))


@@ 29,33 62,36 @@
  ret)

# All jpm settings.
(defdyn :ar)
(defdyn :auto-shebang)
(defdyn :binpath)
(defdyn :c++)
(defdyn :c++-link)
(defdyn :cc)
(defdyn :cc-link)
(defdyn :cflags)
(defdyn :cppflags)
(defdyn :dynamic-cflags)
(defdyn :dynamic-lflags)
(defdyn :gitpath)
(defdyn :headerpath)
(defdyn :is-msvc)
(defdyn :janet)
(defdyn :janet-cflags)
(defdyn :janet-ldflags)
(defdyn :janet-lflags)
(defdyn :ldflags)
(defdyn :lflags)
(defdyn :libjanet)
(defdyn :libpath)
(defdyn :modext)
(defdyn :modpath)
(defdyn :offline)
(defdyn :optimize)
(defdyn :pkglist)
(defdyn :statext)
(defdyn :syspath)
(defdyn :use-batch-shell)
(defdyn :ar :string)
(defdyn :auto-shebang :string)
(defdyn :binpath :string)
(defdyn :c++ :string)
(defdyn :c++-link :string)
(defdyn :cc :string)
(defdyn :cc-link :string)
(defdyn :cflags nil)
(defdyn :cppflags nil)
(defdyn :dynamic-cflags nil)
(defdyn :dynamic-lflags nil)
(defdyn :gitpath :string)
(defdyn :headerpath :string)
(defdyn :is-msvc :boolean)
(defdyn :janet :string)
(defdyn :janet-cflags nil)
(defdyn :janet-ldflags nil)
(defdyn :janet-lflags nil)
(defdyn :ldflags nil)
(defdyn :lflags nil)
(defdyn :libjanet :string)
(defdyn :libpath :string)
(defdyn :modext nil)
(defdyn :modpath :string)
(defdyn :offline :boolean)
(defdyn :optimize :int)
(defdyn :pkglist :string)
(defdyn :silent :boolean)
(defdyn :statext nil)
(defdyn :syspath nil)
(defdyn :use-batch-shell :boolean)
(defdyn :verbose :boolean)
(defdyn :workers :int)

M src/jpm/dagbuild.janet => src/jpm/dagbuild.janet +1 -0
@@ 45,6 45,7 @@
    (if (seen node) (break))
    (put seen node true)
    (def depends-on (get dag node []))
    (put dep-counts node (length depends-on))
    (if (empty? depends-on)
      (ev/give q node))
    (each r depends-on

M src/jpm/declare.janet => src/jpm/declare.janet +2 -1
@@ 94,6 94,7 @@
        (array/push sobjects o-src)
        # Buffer c-src is already declared by dynamic module
        (compile-c :cc opts c-src o-src true)))

    (archive-c opts sname ;sobjects)
    (add-dep "build" sname)
    (install-rule sname path)))


@@ 236,7 237,7 @@
  (task "build" [])

  (task "manifest" [manifest])
  (rule manifest []
  (rule manifest ["uninstall"]
        (print "generating " manifest "...")
        (os/mkdir manifests)
        (def sha (pslurp (string "\"" (dyn:gitpath) "\" rev-parse HEAD")))

M src/jpm/pm.janet => src/jpm/pm.janet +6 -1
@@ 24,6 24,11 @@
  (def currenv (proto-flatten @{} (curenv)))
  (loop [k :keys currenv :when (keyword? k)]
    (put env k (currenv k)))
  # For compatibility reasons
  (put env 'default-cflags @{:value (dyn:cflags)})
  (put env 'default-lflags @{:value (dyn:lflags)})
  (put env 'default-ldflags @{:value (dyn:ldflags)})
  (put env 'default-cppflags @{:value (dyn:cppflags)})
  env)

(defn require-jpm


@@ 204,4 209,4 @@
(defn do-rule
  "Evaluate a given rule in a one-off manner."
  [target]
  (build-rules (dyn :rules) [target]))
  (build-rules (dyn :rules) [target] (dyn :workers)))

M src/jpm/project.janet => src/jpm/project.janet +2 -1
@@ 15,5 15,6 @@

(declare-binscript
  :main "jpm"
  :hardcode-syspath false
  :hardcode-syspath true
  :auto-shebang true
  :is-janet true)

M src/jpm/shutil.janet => src/jpm/shutil.janet +9 -1
@@ 79,12 79,20 @@
    (def path (string/join (slice segs 0 i) "/"))
    (unless (empty? path) (os/mkdir path))))

(defn devnull
  []
  (os/open (if (= :windows (os/which)) "NUL" "/dev/null") :rw))

(defn shell
  "Do a shell command"
  [& args]
  (def args (map string args))
  (if (dyn :verbose)
    (print ;(interpose " " args)))
  (os/execute args :px))
  (if (dyn :silent)
    (with [dn (devnull)]
      (os/execute args :px {:out dn :err dn}))
    (os/execute args :px)))

(defn copy
  "Copy a file or directory recursively from one location to another."