mirror of
				https://github.com/janet-lang/janet
				synced 2025-11-04 09:33:02 +00:00 
			
		
		
		
	Merge branch 'master' of github.com:janet-lang/janet
This commit is contained in:
		@@ -1,6 +1,9 @@
 | 
				
			|||||||
# Changelog
 | 
					# Changelog
 | 
				
			||||||
All notable changes to this project will be documented in this file.
 | 
					All notable changes to this project will be documented in this file.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					## Unreleased
 | 
				
			||||||
 | 
					- Change semantics of `-l` flag to be import rather than dofile.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
## 1.0.0 - 2019-07-01
 | 
					## 1.0.0 - 2019-07-01
 | 
				
			||||||
- Add `with` macro for resource handling.
 | 
					- Add `with` macro for resource handling.
 | 
				
			||||||
- Add `propagate` function so we can "rethrow" signals after they are
 | 
					- Add `propagate` function so we can "rethrow" signals after they are
 | 
				
			||||||
 
 | 
				
			|||||||
							
								
								
									
										91
									
								
								auxbin/jpm
									
									
									
									
									
								
							
							
						
						
									
										91
									
								
								auxbin/jpm
									
									
									
									
									
								
							@@ -8,13 +8,27 @@
 | 
				
			|||||||
  (peg/compile
 | 
					  (peg/compile
 | 
				
			||||||
    '(* "--" '(some (if-not "=" 1)) "=" '(any 1))))
 | 
					    '(* "--" '(some (if-not "=" 1)) "=" '(any 1))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(defn- local-rule
 | 
				
			||||||
 | 
					  [rule]
 | 
				
			||||||
 | 
					  (cook/import-rules "./project.janet")
 | 
				
			||||||
 | 
					  (cook/do-rule rule))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(defn- help
 | 
					(defn- help
 | 
				
			||||||
  []
 | 
					  []
 | 
				
			||||||
  (print "usage: jpm [targets]... --key=value ...")
 | 
					 | 
				
			||||||
  (print "Available targets are:")
 | 
					 | 
				
			||||||
  (each k (sort (keys (dyn :rules @{})))
 | 
					 | 
				
			||||||
    (print "  " k))
 | 
					 | 
				
			||||||
  (print `
 | 
					  (print `
 | 
				
			||||||
 | 
					usage: jpm --key=value ... [subcommand] [args]...
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					Subcommands are:
 | 
				
			||||||
 | 
					  build : build all artifacts
 | 
				
			||||||
 | 
					  install (repo) : install artifacts. If a repo is given, install the contents of that
 | 
				
			||||||
 | 
					                   git repository, assuming that the repository is a jpm project. If not, build
 | 
				
			||||||
 | 
					                   and install the current project.
 | 
				
			||||||
 | 
					  uninstall (module) : uninstall a module. If no module is given, uninstall the module
 | 
				
			||||||
 | 
					                       defined by the current directory.
 | 
				
			||||||
 | 
					  clean : remove any generated files or artifacts
 | 
				
			||||||
 | 
					  test : run tests
 | 
				
			||||||
 | 
					  deps : install dependencies.
 | 
				
			||||||
 | 
					  clear-cache : clear the git cache. Useful for updating dependencies.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
Keys are:
 | 
					Keys are:
 | 
				
			||||||
  --modpath : The directory to install modules to. Defaults to $JANET_MODPATH or (dyn :syspath)
 | 
					  --modpath : The directory to install modules to. Defaults to $JANET_MODPATH or (dyn :syspath)
 | 
				
			||||||
@@ -27,17 +41,64 @@ Keys are:
 | 
				
			|||||||
  --lflags : Extra linker flags for native modules. Defaults to $LFLAGS if set.
 | 
					  --lflags : Extra linker flags for native modules. Defaults to $LFLAGS if set.
 | 
				
			||||||
    `))
 | 
					    `))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(defn build
 | 
				
			||||||
 | 
					  []
 | 
				
			||||||
 | 
					  (local-rule "build"))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(defn clean
 | 
				
			||||||
 | 
					  []
 | 
				
			||||||
 | 
					  (local-rule "clean"))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(defn install
 | 
				
			||||||
 | 
					  [&opt repo]
 | 
				
			||||||
 | 
					  (if repo
 | 
				
			||||||
 | 
					    (cook/install-git repo)
 | 
				
			||||||
 | 
					    (local-rule "install")))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(defn test
 | 
				
			||||||
 | 
					  []
 | 
				
			||||||
 | 
					  (local-rule "test"))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(defn uninstall
 | 
				
			||||||
 | 
					  [&opt what]
 | 
				
			||||||
 | 
					  (if what
 | 
				
			||||||
 | 
					    (cook/uninstall what)
 | 
				
			||||||
 | 
					    (local-rule "uninstall")))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(defn deps
 | 
				
			||||||
 | 
					  []
 | 
				
			||||||
 | 
					  (local-rule "install-deps"))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(def subcommands
 | 
				
			||||||
 | 
					  {"build" build
 | 
				
			||||||
 | 
					   "clean" clean
 | 
				
			||||||
 | 
					   "install" install
 | 
				
			||||||
 | 
					   "test" test
 | 
				
			||||||
 | 
					   "help" help
 | 
				
			||||||
 | 
					   "deps" deps
 | 
				
			||||||
 | 
					   "clear-cache" cook/clear-cache
 | 
				
			||||||
 | 
					   "uninstall" uninstall})
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(def args (tuple/slice process/args 2))
 | 
					(def args (tuple/slice process/args 2))
 | 
				
			||||||
(def todo @[])
 | 
					(def len (length args))
 | 
				
			||||||
(each arg args
 | 
					(var i 0)
 | 
				
			||||||
  (if (string/has-prefix? "--" arg)
 | 
					 | 
				
			||||||
    (if-let [m (peg/match argpeg arg)]
 | 
					 | 
				
			||||||
      (let [[key value] m]
 | 
					 | 
				
			||||||
        (setdyn (keyword key) value))
 | 
					 | 
				
			||||||
      (print "invalid argument " arg))
 | 
					 | 
				
			||||||
    (array/push todo arg)))
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
(cook/import-rules "./project.janet")
 | 
					# Get flags
 | 
				
			||||||
 | 
					(while (< i len)
 | 
				
			||||||
 | 
					  (def arg (args i))
 | 
				
			||||||
 | 
					  (unless (string/has-prefix? "--" arg) (break))
 | 
				
			||||||
 | 
					  (if-let [m (peg/match argpeg arg)]
 | 
				
			||||||
 | 
					    (let [[key value] m]
 | 
				
			||||||
 | 
					      (setdyn (keyword key) value))
 | 
				
			||||||
 | 
					    (print "invalid argument " arg))
 | 
				
			||||||
 | 
					  (++ i))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(if (empty? todo) (help))
 | 
					# Run subcommand
 | 
				
			||||||
(each rule todo (cook/do-rule rule))
 | 
					(if (= i len)
 | 
				
			||||||
 | 
					  (help)
 | 
				
			||||||
 | 
					  (do
 | 
				
			||||||
 | 
					    (if-let [com (subcommands (args i))]
 | 
				
			||||||
 | 
					      (com ;(tuple/slice args (+ i 1)))
 | 
				
			||||||
 | 
					      (do
 | 
				
			||||||
 | 
					        (print "invalid command " (args i))
 | 
				
			||||||
 | 
					        (help)))))
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -15,14 +15,14 @@
 | 
				
			|||||||
(def- sep (if is-win "\\" "/"))
 | 
					(def- sep (if is-win "\\" "/"))
 | 
				
			||||||
(def- objext (if is-win ".obj" ".o"))
 | 
					(def- objext (if is-win ".obj" ".o"))
 | 
				
			||||||
(def- modext (if is-win ".dll" ".so"))
 | 
					(def- modext (if is-win ".dll" ".so"))
 | 
				
			||||||
 | 
					(def- absprefix (if is-win "C:\\" "/"))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#
 | 
					#
 | 
				
			||||||
# Rule Engine
 | 
					# Rule Engine
 | 
				
			||||||
#
 | 
					#
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(defn- getrules []
 | 
					(defn- getrules []
 | 
				
			||||||
  (def rules (dyn :rules))
 | 
					  (if-let [rules (dyn :rules)] rules (setdyn :rules @{})))
 | 
				
			||||||
  (if rules rules (setdyn :rules @{})))
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
(defn- gettarget [target]
 | 
					(defn- gettarget [target]
 | 
				
			||||||
  (def item ((getrules) target))
 | 
					  (def item ((getrules) target))
 | 
				
			||||||
@@ -284,25 +284,98 @@
 | 
				
			|||||||
        (file/close out)
 | 
					        (file/close out)
 | 
				
			||||||
        (file/close f)))
 | 
					        (file/close f)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(defn- abspath
 | 
				
			||||||
 | 
					  "Create an absolute path. Does not resolve . and .. (useful for
 | 
				
			||||||
 | 
					  generating entries in install manifest file)."
 | 
				
			||||||
 | 
					  [path]
 | 
				
			||||||
 | 
					  (if (string/has-prefix? absprefix)
 | 
				
			||||||
 | 
					    path
 | 
				
			||||||
 | 
					    (string (os/cwd) sep path)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#
 | 
					#
 | 
				
			||||||
# Declaring Artifacts - used in project.janet, targets specifically
 | 
					# Public utilities
 | 
				
			||||||
# tailored for janet.
 | 
					 | 
				
			||||||
#
 | 
					#
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(defn- install-rule
 | 
					(defn repo-id
 | 
				
			||||||
 | 
					  "Convert a repo url into a path component that serves as its id."
 | 
				
			||||||
 | 
					  [repo]
 | 
				
			||||||
 | 
					  (string/replace-all "\\" "_" (string/replace-all "/" "_" repo)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(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"))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(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"))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(defn find-cache
 | 
				
			||||||
 | 
					  "Return the path to the global cache."
 | 
				
			||||||
 | 
					  [&opt opts]
 | 
				
			||||||
 | 
					  (def path (opt (or opts @{}) :modpath JANET_MODPATH))
 | 
				
			||||||
 | 
					  (string path sep ".cache"))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(defn uninstall
 | 
				
			||||||
 | 
					  "Uninstall bundle named name"
 | 
				
			||||||
 | 
					  [name &opt opts]
 | 
				
			||||||
 | 
					  (def manifest (find-manifest name opts))
 | 
				
			||||||
 | 
					  (def f (file/open manifest :r))
 | 
				
			||||||
 | 
					  (unless f (print manifest " does not exist") (break))
 | 
				
			||||||
 | 
					  (loop [line :iterate (:read f :line)]
 | 
				
			||||||
 | 
					    (def path ((string/split "\n" line) 0))
 | 
				
			||||||
 | 
					    (print "removing " path)
 | 
				
			||||||
 | 
					    (try (rm path) ([err]
 | 
				
			||||||
 | 
					                    (unless (= err "No such file or directory")
 | 
				
			||||||
 | 
					                      (error err)))))
 | 
				
			||||||
 | 
					  (print "removing " manifest)
 | 
				
			||||||
 | 
					  (rm manifest)
 | 
				
			||||||
 | 
					  (:close f)
 | 
				
			||||||
 | 
					  (print "Uninstalled."))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(defn clear-cache
 | 
				
			||||||
 | 
					  "Clear the global git cache."
 | 
				
			||||||
 | 
					  [&opt opts]
 | 
				
			||||||
 | 
					  (rm (find-cache opts)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(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))
 | 
				
			||||||
 | 
					  (os/mkdir cache)
 | 
				
			||||||
 | 
					  (def id (repo-id repo))
 | 
				
			||||||
 | 
					  (def module-dir (string cache sep id))
 | 
				
			||||||
 | 
					  (when (os/mkdir module-dir)
 | 
				
			||||||
 | 
					    (os/execute ["git" "clone" repo module-dir] :p))
 | 
				
			||||||
 | 
					  (def olddir (os/cwd))
 | 
				
			||||||
 | 
					  (os/cd module-dir)
 | 
				
			||||||
 | 
					  (try
 | 
				
			||||||
 | 
					    (with-dyns [:rules @{}]
 | 
				
			||||||
 | 
					      (import-rules "./project.janet")
 | 
				
			||||||
 | 
					      (do-rule "install-deps")
 | 
				
			||||||
 | 
					      (do-rule "build")
 | 
				
			||||||
 | 
					      (do-rule "install"))
 | 
				
			||||||
 | 
					    ([err] nil))
 | 
				
			||||||
 | 
					  (os/cd olddir))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(defn install-rule
 | 
				
			||||||
  "Add install and uninstall rule for moving file from src into destdir."
 | 
					  "Add install and uninstall rule for moving file from src into destdir."
 | 
				
			||||||
  [src destdir]
 | 
					  [src destdir]
 | 
				
			||||||
  (def parts (string/split sep src))
 | 
					  (def parts (string/split sep src))
 | 
				
			||||||
  (def name (last parts))
 | 
					  (def name (last parts))
 | 
				
			||||||
 | 
					  (def path (string destdir sep name))
 | 
				
			||||||
 | 
					  (array/push (dyn :installed-files) path)
 | 
				
			||||||
  (add-body "install"
 | 
					  (add-body "install"
 | 
				
			||||||
            (try (os/mkdir destdir) ([err] nil))
 | 
					            (try (os/mkdir destdir) ([err] nil))
 | 
				
			||||||
            (copy src destdir))
 | 
					            (copy src destdir)))
 | 
				
			||||||
  (add-body "uninstall"
 | 
					
 | 
				
			||||||
            (def path (string destdir sep name))
 | 
					#
 | 
				
			||||||
            (print "removing " path)
 | 
					# Declaring Artifacts - used in project.janet, targets specifically
 | 
				
			||||||
            (try (rm path) ([err]
 | 
					# tailored for janet.
 | 
				
			||||||
                            (unless (= err "No such file or directory")
 | 
					#
 | 
				
			||||||
                              (error err))))))
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
(defn declare-native
 | 
					(defn declare-native
 | 
				
			||||||
  "Declare a native binary. This is a shared library that can be loaded
 | 
					  "Declare a native binary. This is a shared library that can be loaded
 | 
				
			||||||
@@ -378,11 +451,37 @@
 | 
				
			|||||||
  Also sets up basic phony targets like clean, build, test, etc."
 | 
					  Also sets up basic phony targets like clean, build, test, etc."
 | 
				
			||||||
  [&keys meta]
 | 
					  [&keys meta]
 | 
				
			||||||
  (setdyn :project meta)
 | 
					  (setdyn :project meta)
 | 
				
			||||||
  (try (os/mkdir "build") ([err] nil))
 | 
					
 | 
				
			||||||
  (phony "build" [])
 | 
					  (def installed-files @[])
 | 
				
			||||||
  (phony "install" ["build"] (print "Installed."))
 | 
					  (def manifests (find-manifest-dir))
 | 
				
			||||||
  (phony "uninstall" [] (print "Uninstalled."))
 | 
					  (def manifest (find-manifest (meta :name)))
 | 
				
			||||||
  (phony "clean" [] (rm "build") (print "Deleted build directory."))
 | 
					  (setdyn :manifest manifest)
 | 
				
			||||||
 | 
					  (setdyn :manifest-dir manifests)
 | 
				
			||||||
 | 
					  (setdyn :installed-files installed-files)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  (rule "./build" [] (os/mkdir "build"))
 | 
				
			||||||
 | 
					  (phony "build" ["./build"])
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  (phony "manifest" []
 | 
				
			||||||
 | 
					         (print "generating " manifest "...")
 | 
				
			||||||
 | 
					         (os/mkdir manifests)
 | 
				
			||||||
 | 
					         (spit manifest (string (string/join installed-files "\n") "\n")))
 | 
				
			||||||
 | 
					  (phony "install" ["uninstall" "build" "manifest"]
 | 
				
			||||||
 | 
					         (print "Installed as '" (meta :name) "'."))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  (phony "install-deps" []
 | 
				
			||||||
 | 
					         (if-let [deps (meta :dependencies)]
 | 
				
			||||||
 | 
					           (each dep deps
 | 
				
			||||||
 | 
					             (install-git dep))
 | 
				
			||||||
 | 
					           (print "no dependencies found")))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  (phony "uninstall" []
 | 
				
			||||||
 | 
					         (uninstall (meta :name)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  (phony "clean" []
 | 
				
			||||||
 | 
					         (rm "build")
 | 
				
			||||||
 | 
					         (print "Deleted build directory."))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  (phony "test" ["build"]
 | 
					  (phony "test" ["build"]
 | 
				
			||||||
         (defn dodir
 | 
					         (defn dodir
 | 
				
			||||||
           [dir]
 | 
					           [dir]
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -130,9 +130,7 @@ section "Janet" BfWSection
 | 
				
			|||||||
	WriteRegStr SHCTX "${UNINST_KEY}" "HelpLink" "${HELPURL}"
 | 
						WriteRegStr SHCTX "${UNINST_KEY}" "HelpLink" "${HELPURL}"
 | 
				
			||||||
	WriteRegStr SHCTX "${UNINST_KEY}" "URLUpdateInfo" "${HELPURL}"
 | 
						WriteRegStr SHCTX "${UNINST_KEY}" "URLUpdateInfo" "${HELPURL}"
 | 
				
			||||||
	WriteRegStr SHCTX "${UNINST_KEY}" "URLInfoAbout" "${HELPURL}"
 | 
						WriteRegStr SHCTX "${UNINST_KEY}" "URLInfoAbout" "${HELPURL}"
 | 
				
			||||||
	WriteRegStr SHCTX "${UNINST_KEY}" "DisplayVersion" "1.0.0"
 | 
						WriteRegStr SHCTX "${UNINST_KEY}" "DisplayVersion" "${VERSION}"
 | 
				
			||||||
	WriteRegDWORD SHCTX "${UNINST_KEY}" "VersionMajor" 1
 | 
					 | 
				
			||||||
	WriteRegDWORD SHCTX "${UNINST_KEY}" "VersionMinor" 0
 | 
					 | 
				
			||||||
	WriteRegDWORD SHCTX "${UNINST_KEY}" "NoModify" 1
 | 
						WriteRegDWORD SHCTX "${UNINST_KEY}" "NoModify" 1
 | 
				
			||||||
	WriteRegDWORD SHCTX "${UNINST_KEY}" "NoRepair" 1
 | 
						WriteRegDWORD SHCTX "${UNINST_KEY}" "NoRepair" 1
 | 
				
			||||||
	WriteRegDWORD SHCTX "${UNINST_KEY}" "EstimatedSize" 1000
 | 
						WriteRegDWORD SHCTX "${UNINST_KEY}" "EstimatedSize" 1000
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -29,8 +29,8 @@
 | 
				
			|||||||
#define JANET_VERSION_MAJOR 1
 | 
					#define JANET_VERSION_MAJOR 1
 | 
				
			||||||
#define JANET_VERSION_MINOR 0
 | 
					#define JANET_VERSION_MINOR 0
 | 
				
			||||||
#define JANET_VERSION_PATCH 0
 | 
					#define JANET_VERSION_PATCH 0
 | 
				
			||||||
#define JANET_VERSION_EXTRA ""
 | 
					#define JANET_VERSION_EXTRA "-dev"
 | 
				
			||||||
#define JANET_VERSION "1.0.0"
 | 
					#define JANET_VERSION "1.0.0-dev"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* #define JANET_BUILD "local" */
 | 
					/* #define JANET_BUILD "local" */
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -50,7 +50,7 @@
 | 
				
			|||||||
           3)
 | 
					           3)
 | 
				
			||||||
     "-" (fn [&] (set *handleopts* false) 1)
 | 
					     "-" (fn [&] (set *handleopts* false) 1)
 | 
				
			||||||
     "l" (fn [i &]
 | 
					     "l" (fn [i &]
 | 
				
			||||||
           (dofile (get process/args (+ i 1))
 | 
					           (import* (get process/args (+ i 1))
 | 
				
			||||||
                    :prefix "" :exit *exit-on-error*)
 | 
					                    :prefix "" :exit *exit-on-error*)
 | 
				
			||||||
           2)
 | 
					           2)
 | 
				
			||||||
     "e" (fn [i &]
 | 
					     "e" (fn [i &]
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -1,4 +1,4 @@
 | 
				
			|||||||
@echo off
 | 
					@echo off
 | 
				
			||||||
@rem Wrapper arounf jpm
 | 
					@rem Wrapper around jpm
 | 
				
			||||||
 | 
					
 | 
				
			||||||
janet %~dp0\jpm.janet %*
 | 
					janet %~dp0\jpm.janet %*
 | 
				
			||||||
 
 | 
				
			|||||||
		Reference in New Issue
	
	Block a user