├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── bootstrap.janet ├── configs ├── README.md ├── bsd_config.janet ├── linux_config.janet ├── macos_config.janet ├── msvc_config.janet └── msvc_config.jdn ├── content ├── api │ ├── cc.mdz │ ├── cgen.mdz │ ├── commands.mdz │ ├── config.mdz │ ├── dagbuild.mdz │ ├── declare.mdz │ ├── index.mdz │ ├── pm.mdz │ ├── rules.mdz │ └── shutil.mdz └── index.mdz ├── jpm.1 ├── jpm ├── cc.janet ├── cgen.janet ├── cli.janet ├── commands.janet ├── config.janet ├── dagbuild.janet ├── declare.janet ├── default-config.janet ├── init.janet ├── jpm ├── make-config.janet ├── pm.janet ├── rules.janet ├── scaffold.janet └── shutil.janet ├── project.janet ├── test └── installtest.janet └── testinstall ├── .gitignore ├── project.janet ├── runtest.janet ├── test └── test1.janet ├── testexec.janet ├── testmod.c ├── testmod2.c ├── testmod3.cpp ├── testmod4.c └── testmod5.cc /.gitignore: -------------------------------------------------------------------------------- 1 | build/ 2 | jpm_tree/ 3 | site/ 4 | temp-config.janet 5 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | All notable changes to this project will be documented in this file. 3 | 4 | ## 0.0.1 - 2021-09-15 5 | - Moved project from Janet source to separate repository. 6 | - Add tarball support, parallel builds, and more. 7 | - Change configuration process to use a config file at install time. 8 | - Add support for multiple outputs in commands. 9 | - Allow self build and install (self host) 10 | - Add `--local` flag to set install path to /jpm\_tree/lib. Also sets the binpath and manpath as well. 11 | - Add `--tree` flag to set install path to custom root, along with binpath and manpath. 12 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2022 Calvin Rose and contributors 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of 4 | this software and associated documentation files (the "Software"), to deal in 5 | the Software without restriction, including without limitation the rights to 6 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies 7 | of the Software, and to permit persons to whom the Software is furnished to do 8 | so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in all 11 | copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 19 | SOFTWARE. 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # jpm 2 | 3 | JPM is the Janet Project Manager tool. It is for automating builds and downloading 4 | dependencies of Janet projects. This project is a port of the original `jpm` tool 5 | (which started as a single file script) to add more functionality, clean up code, make 6 | more portable and configurable, and 7 | refactor `jpm` into independent, reusable pieces that can be imported as normal Janet modules. 8 | 9 | This also introduces parallel builds, possible MSYS support, a `jpm` configuration file, and more 10 | CLI options. Other improvements are planned such as parallel dependency downloading, more 11 | out of the box support for non-C toolchains and pkg-config, installation from sources besides git 12 | such as remote tarballs, zipfiles, or local directories, and more. 13 | 14 | ## Self Installation (Bootstrapping) 15 | 16 | clone this repo, and from its directory, run 17 | 18 | ``` 19 | $ [sudo] janet bootstrap.janet 20 | ``` 21 | 22 | There are also several example config files in the `configs` directory, and you can use the environment 23 | variable `JANET_JPM_CONFIG` to use a configuration file. The config files can be either `janet` or `jdn` 24 | files. To override/set the default configuration, replace the contents of default-config.janet with a 25 | customized config file before installing. To select a configuration file to use to override the default 26 | when installing, pass in a config file argument to the `bootstrap.janet` script, for example: 27 | 28 | ``` 29 | $ [sudo] janet bootstrap.janet configs/msvc_config.janet 30 | ``` 31 | 32 | The bootstrapping process can also be configured by setting PREFIX to install to a different system directory. 33 | Generally, you will want to install to the same directory that Janet was installed to so jpm can find the 34 | required headers and libraries for compiling C libraries. 35 | 36 | ``` 37 | $ [sudo] PREFIX=/usr janet bootstrap.janet 38 | ``` 39 | 40 | ## Updating 41 | 42 | If you aleady have an installation of jpm configured, you can update `jpm` with 43 | 44 | ``` 45 | $ [sudo] jpm install jpm 46 | ``` 47 | 48 | which should automatically update to the latest `jpm`. 49 | -------------------------------------------------------------------------------- /bootstrap.janet: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env janet 2 | 3 | # A script to install jpm to a given tree. This script can be run during installation 4 | # time and will try to autodetect the host platform and generate the correct config file 5 | # for installation and then install jpm 6 | 7 | (import ./jpm/shutil) 8 | (import ./jpm/make-config) 9 | 10 | (def destdir (os/getenv "DESTDIR")) 11 | (defn do-bootstrap 12 | [conf] 13 | (print "Running jpm to self install...") 14 | (os/execute [(dyn :executable) "jpm/cli.janet" "install" ;(if destdir [(string "--dest-dir=" destdir)] [])] 15 | :epx 16 | (merge-into (os/environ) 17 | {"JPM_BOOTSTRAP_CONFIG" conf 18 | "JANET_JPM_CONFIG" conf}))) 19 | 20 | (when-let [override-config (get (dyn :args) 1)] 21 | (do-bootstrap override-config) 22 | (os/exit 0)) 23 | 24 | (def temp-config-path "./temp-config.janet") 25 | (spit temp-config-path (make-config/generate-config (or destdir ""))) 26 | (do-bootstrap temp-config-path) 27 | (os/rm temp-config-path) 28 | -------------------------------------------------------------------------------- /configs/README.md: -------------------------------------------------------------------------------- 1 | # Example Configs 2 | 3 | This directory contains some example configs for installing jpm for 4 | various platforms. Package maintainers or people writing scripts to install jpm 5 | may need to adopt (especially on windows!) if the default config does not work. 6 | -------------------------------------------------------------------------------- /configs/bsd_config.janet: -------------------------------------------------------------------------------- 1 | (def prefix "/usr/local") 2 | 3 | (def config 4 | {:ar "ar" 5 | :auto-shebang true 6 | :binpath (string prefix "/bin") 7 | :c++ "c++" 8 | :c++-link "c++" 9 | :cc "cc" 10 | :cc-link "cc" 11 | :cflags @["-std=c99"] 12 | :cflags-verbose @["-Wall" "-Wextra"] 13 | :cppflags @["-std=c++11"] 14 | :curlpath "curl" 15 | :dynamic-cflags @["-fPIC"] 16 | :dynamic-lflags @["-shared" "-pthread"] 17 | :gitpath "git" 18 | :headerpath (string prefix "/include/janet") 19 | :is-msvc false 20 | :janet "janet" 21 | :janet-cflags @[] 22 | :janet-lflags @["-lm" "-pthread"] 23 | :ldflags @[] 24 | :lflags @[] 25 | :libpath (string prefix "/lib") 26 | :local false 27 | :manpath (string prefix "/share/man/man1") 28 | :modext ".so" 29 | :modpath (string prefix "/lib/janet") 30 | :nocolor false 31 | :optimize 2 32 | :pkglist "https://github.com/janet-lang/pkgs.git" 33 | :silent false 34 | :statext ".a" 35 | :tarpath "tar" 36 | :test false 37 | :use-batch-shell false 38 | :verbose false}) 39 | -------------------------------------------------------------------------------- /configs/linux_config.janet: -------------------------------------------------------------------------------- 1 | (def prefix "/usr/local") 2 | 3 | (def config 4 | {:ar "ar" 5 | :auto-shebang true 6 | :binpath (string prefix "/bin") 7 | :c++ "c++" 8 | :c++-link "c++" 9 | :cc "cc" 10 | :cc-link "cc" 11 | :cflags @["-std=c99"] 12 | :cflags-verbose @["-Wall" "-Wextra"] 13 | :cppflags @["-std=c++11"] 14 | :curlpath "curl" 15 | :dynamic-cflags @["-fPIC"] 16 | :dynamic-lflags @["-shared" "-pthread"] 17 | :gitpath "git" 18 | :headerpath (string prefix "/include/janet") 19 | :is-msvc false 20 | :janet "janet" 21 | :janet-cflags @[] 22 | :janet-lflags @["-lm" "-ldl" "-lrt" "-pthread"] 23 | :ldflags @[] 24 | :lflags @[] 25 | :libpath (string prefix "/lib") 26 | :local false 27 | :manpath (string prefix "/share/man/man1") 28 | :modext ".so" 29 | :modpath (string prefix "/lib/janet") 30 | :nocolor false 31 | :optimize 2 32 | :pkglist "https://github.com/janet-lang/pkgs.git" 33 | :silent false 34 | :statext ".a" 35 | :tarpath "tar" 36 | :test false 37 | :use-batch-shell false 38 | :verbose false}) 39 | -------------------------------------------------------------------------------- /configs/macos_config.janet: -------------------------------------------------------------------------------- 1 | (def prefix "/usr/local") 2 | 3 | (def config 4 | {:ar "ar" 5 | :auto-shebang true 6 | :binpath (string prefix "/bin") 7 | :c++ "c++" 8 | :c++-link "c++" 9 | :cc "cc" 10 | :cc-link "cc" 11 | :cflags @["-std=c99"] 12 | :cflags-verbose @["-Wall" "-Wextra"] 13 | :cppflags @["-std=c++11"] 14 | :curlpath "curl" 15 | :dynamic-cflags @["-fPIC"] 16 | :dynamic-lflags @["-shared" "-undefined" "dynamic_lookup" "-lpthread"] 17 | :gitpath "git" 18 | :headerpath (string prefix "/include/janet") 19 | :is-msvc false 20 | :janet "janet" 21 | :janet-cflags @[] 22 | :janet-lflags @["-lm" "-ldl" "-lpthread"] 23 | :ldflags @[] 24 | :lflags @[] 25 | :libpath (string prefix "/lib") 26 | :local false 27 | :manpath (string prefix "/share/man/man1") 28 | :modext ".so" 29 | :modpath (string prefix "/lib/janet") 30 | :nocolor false 31 | :optimize 2 32 | :pkglist "https://github.com/janet-lang/pkgs.git" 33 | :silent false 34 | :statext ".a" 35 | :tarpath "tar" 36 | :test false 37 | :use-batch-shell false 38 | :verbose false}) 39 | -------------------------------------------------------------------------------- /configs/msvc_config.janet: -------------------------------------------------------------------------------- 1 | (unless (os/getenv "INCLUDE") 2 | (errorf "Run from a developer console or run the vcvars%d.bat script to setup compiler environment." 3 | (if (= (os/arch) :x64) 64 32))) 4 | 5 | (def config 6 | {:ar "lib.exe" 7 | :auto-shebang true 8 | :c++ "cl.exe" 9 | :c++-link "link.exe" 10 | :cc "cl.exe" 11 | :cc-link "link.exe" 12 | :cflags @["/nologo" "/MD"] 13 | :cppflags @["/nologo" "/MD" "/EHsc"] 14 | :cflags-verbose @["-Wall" "-Wextra"] 15 | :curlpath "curl" 16 | :dynamic-cflags @["/LD"] 17 | :dynamic-lflags @["/DLL"] 18 | :gitpath "git" 19 | :is-msvc true 20 | :janet "janet" 21 | :janet-cflags @[] 22 | :janet-lflags @[] 23 | :ldflags @[] 24 | :lflags @["/nologo"] 25 | :local false 26 | :modext ".dll" 27 | :nocolor false 28 | :optimize 2 29 | :pkglist "https://github.com/janet-lang/pkgs.git" 30 | :silent false 31 | :statext ".static.lib" 32 | :tarpath "tar" 33 | :test false 34 | :use-batch-shell true 35 | :verbose false}) 36 | -------------------------------------------------------------------------------- /configs/msvc_config.jdn: -------------------------------------------------------------------------------- 1 | {:ar "lib.exe" 2 | :auto-shebang true 3 | :c++ "cl.exe" 4 | :c++-link "link.exe" 5 | :cc "cl.exe" 6 | :cc-link "link.exe" 7 | :cflags @["/nologo" "/MD"] 8 | :cppflags @["/nologo" "/MD" "/EHsc"] 9 | :cflags-verbose @["-Wall" "-Wextra"] 10 | :curlpath "curl" 11 | :dynamic-cflags @["/LD"] 12 | :dynamic-lflags @["/DLL"] 13 | :gitpath "git" 14 | :is-msvc true 15 | :janet "janet" 16 | :janet-cflags @[] 17 | :janet-lflags @[] 18 | :ldflags @[] 19 | :lflags @["/nologo"] 20 | :local false 21 | :modext ".dll" 22 | :nocolor false 23 | :optimize 2 24 | :pkglist "https://github.com/janet-lang/pkgs.git" 25 | :silent false 26 | :statext ".static.lib" 27 | :tarpath "tar" 28 | :test false 29 | :use-batch-shell true 30 | :verbose false} 31 | -------------------------------------------------------------------------------- /content/api/cc.mdz: -------------------------------------------------------------------------------- 1 | {:title "Compiler Utilities" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | ## Index 8 | 9 | @api-index[jpm/][cc/] 10 | 11 | ## Reference 12 | 13 | @api-docs[jpm/][cc/] 14 | 15 | -------------------------------------------------------------------------------- /content/api/cgen.mdz: -------------------------------------------------------------------------------- 1 | {:title "C Generation" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | ## Index 8 | 9 | @api-index[jpm/][cgen/] 10 | 11 | ## Reference 12 | 13 | @api-docs[jpm/][cgen/] 14 | 15 | -------------------------------------------------------------------------------- /content/api/commands.mdz: -------------------------------------------------------------------------------- 1 | {:title "Commands" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | ## Index 8 | 9 | @api-index[jpm/][commands/] 10 | 11 | ## Reference 12 | 13 | @api-docs[jpm/][commands/] 14 | 15 | -------------------------------------------------------------------------------- /content/api/config.mdz: -------------------------------------------------------------------------------- 1 | {:title "Configuration" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | ## Index 8 | 9 | @api-index[jpm/][config/] 10 | 11 | ## Reference 12 | 13 | @api-docs[jpm/][config/] 14 | 15 | -------------------------------------------------------------------------------- /content/api/dagbuild.mdz: -------------------------------------------------------------------------------- 1 | {:title "Parallel DAG Processing" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | ## Index 8 | 9 | @api-index[jpm/][dagbuild/] 10 | 11 | ## Reference 12 | 13 | @api-docs[jpm/][dagbuild/] 14 | 15 | -------------------------------------------------------------------------------- /content/api/declare.mdz: -------------------------------------------------------------------------------- 1 | {:title "Rule Declarations" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | ## Index 8 | 9 | @api-index[jpm/][declare/] 10 | 11 | ## Reference 12 | 13 | @api-docs[jpm/][declare/] 14 | 15 | -------------------------------------------------------------------------------- /content/api/index.mdz: -------------------------------------------------------------------------------- 1 | {:title "API" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html" 5 | :order 1} 6 | --- 7 | 8 | ## Index 9 | 10 | @api-index[jpm/] 11 | 12 | ## Reference 13 | 14 | @api-docs[jpm/] 15 | -------------------------------------------------------------------------------- /content/api/pm.mdz: -------------------------------------------------------------------------------- 1 | {:title "Project Management" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | ## Index 8 | 9 | @api-index[jpm/][declare/] 10 | 11 | ## Reference 12 | 13 | @api-docs[jpm/][declare/] 14 | 15 | -------------------------------------------------------------------------------- /content/api/rules.mdz: -------------------------------------------------------------------------------- 1 | {:title "Rule Engine" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | ## Index 8 | 9 | @api-index[jpm/][rules/] 10 | 11 | ## Reference 12 | 13 | @api-docs[jpm/][rules/] 14 | 15 | -------------------------------------------------------------------------------- /content/api/shutil.mdz: -------------------------------------------------------------------------------- 1 | {:title "Shell Utilities" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html"} 5 | --- 6 | 7 | ## Index 8 | 9 | @api-index[jpm/][shutil/] 10 | 11 | ## Reference 12 | 13 | @api-docs[jpm/][shutil/] 14 | 15 | -------------------------------------------------------------------------------- /content/index.mdz: -------------------------------------------------------------------------------- 1 | {:title "jpm" 2 | :author "Calvin Rose" 3 | :license "MIT" 4 | :template "mdzdoc/main.html" 5 | :order 0} 6 | --- 7 | 8 | JPM is that Janet project manager. 9 | -------------------------------------------------------------------------------- /jpm.1: -------------------------------------------------------------------------------- 1 | .TH JPM 1 2 | .SH NAME 3 | jpm \- the Janet Project Manager, a build tool for Janet 4 | .SH SYNOPSIS 5 | .B jpm 6 | [\fB\-\-flag ...\fR] 7 | [\fB\-\-option=value ...\fR] 8 | .IR command 9 | .IR args ... 10 | .SH DESCRIPTION 11 | jpm is used for building Janet projects, installing dependencies, 12 | installing projects, building native modules, and exporting your Janet 13 | project to a standalone executable. Although not required for working 14 | with Janet, it removes much of the boilerplate with installing 15 | dependencies and building native modules. jpm requires only janet to 16 | run, and uses git to install dependencies (jpm will work without git 17 | installed). 18 | .SH DOCUMENTATION 19 | 20 | jpm has several subcommands, each used for managing either a single Janet project or 21 | all Janet modules installed on the system. Global commands, those that manage modules 22 | at the system level, do things like install and uninstall packages, as well as clear the cache. 23 | More interesting are the local commands. For more information on jpm usage, see https://janet-lang.org/docs/index.html 24 | 25 | For information on flags, see the usage documentation in the tool. 26 | 27 | .SH COMMANDS 28 | .TP 29 | .BR help 30 | Shows the usage text and exits immediately. 31 | 32 | .TP 33 | .BR build 34 | Builds all artifacts specified in the project.janet file in the current directory. Artifacts will 35 | be created in the ./build/ directory. 36 | 37 | .TP 38 | .BR configure [\fBpath\fR] 39 | Create a directory for out-of-tree builds, and also set project options. While jpm does not 40 | require an explicit configure step, this can be used to avoid needing to set the same options 41 | repeatedly. Out of tree builds are also a convenient way to have multiple configurations at the 42 | same time, such as a relase build and a debug build. 43 | 44 | .TP 45 | .BR install\ [\fBrepo...\fR] 46 | When run with no arguments, installs all installable artifacts in the current project to 47 | the current JANET_MODPATH for modules and JANET_BINPATH for executables and scripts. Can also 48 | take an optional git repository URL and will install all artifacts in that repository instead. 49 | When run with an argument, install does not need to be run from a jpm project directory. Will also 50 | install multiple dependencies in one command. 51 | .TP 52 | 53 | .BR update-installed 54 | Update to the latest version of all installed packges. Will do this by reinstalling from source 55 | control with latest available tag for each bundle. May overwrite any bundles that have been installed 56 | to a specific tag. 57 | 58 | .TP 59 | .BR uninstall\ [\fBname...\fR] 60 | Uninstall a project installed with install. uninstall expects the name of the project, not the 61 | repository url, path to installed file, or executable name. The name of the project must be specified 62 | at the top of the project.janet file in the declare-project form. If no name is given, uninstalls 63 | the current project if installed. Will also uninstall multiple packages in one command. 64 | 65 | .TP 66 | .BR clean 67 | Remove all artifacts created by jpm. This just deletes the build folder. 68 | 69 | .TP 70 | .BR test 71 | Runs jpm tests. jpm will run all janet source files in the test directory as tests. A test 72 | is considered failing if it exits with a non-zero exit code. 73 | 74 | .TP 75 | .BR deps 76 | Install all dependencies that this project requires recursively. jpm does not 77 | resolve dependency issues, like conflicting versions of the same module are required, or 78 | different modules with the same name. Dependencies are installed with git, so deps requires 79 | git to be on the PATH. 80 | 81 | .TP 82 | .BR clear-cache 83 | jpm caches git repositories that are needed to install modules from a remote 84 | source in a global cache ($JANET_PATH/.cache). If these dependencies are out of 85 | date or too large, clear-cache will remove the cache and jpm will rebuild it 86 | when needed. clear-cache is a global command, so a project.janet is not 87 | required. 88 | 89 | .TP 90 | .BR list-installed 91 | List all installed packages in the current syspath. 92 | 93 | .TP 94 | .BR list-pkgs\ [\fBsearch\fR] 95 | List all package aliases in the current package listing that contain the given search string. 96 | If no search string is given, prints the entire listing. 97 | 98 | .TP 99 | .BR clear-manifest 100 | jpm creates a manifest directory that contains a list of all installed files. 101 | By deleting this directory, jpm will think that nothing is installed and will 102 | try reinstalling everything on the jpm deps or jpm load-lockfile commands. Be careful with 103 | this command, as it may leave extra files on your system and shouldn't be needed 104 | most of the time in a healthy install. 105 | 106 | .TP 107 | .BR run\ [\fBrule\fR] 108 | Run a given rule defined in project.janet. Project definitions files (project.janet) usually 109 | contain a few artifact declarations, which set up rules that jpm can then resolve, or execute. 110 | A project.janet can also create custom rules to create arbitrary files or run arbitrary code, much 111 | like make. run will run a single rule or build a single file. 112 | 113 | .TP 114 | .BR rules 115 | List all rules that can be run via run. This is useful for exploring rules in the project. 116 | 117 | .TP 118 | .BR rule-tree\ [\fBroot\fR]\ [\fBdepth\fR] 119 | Show rule dependency tree in a pretty format. Optionally provide a rule to use as the tree 120 | root, as well as a max depth to print. By default, prints the full tree for all rules. This 121 | can be quite long, so it is recommended to give a root rule. 122 | 123 | .TP 124 | .BR show-paths 125 | Show all of the paths used when installing and building artifacts. 126 | 127 | .TP 128 | .BR update-pkgs 129 | Update the package listing by installing the 'pkgs' package. Same as jpm install pkgs 130 | 131 | .TP 132 | .BR quickbin\ [\fBentry\fR]\ [\fBexecutable\fR] 133 | Create a standalone, statically linked executable from a Janet source file that contains a main function. 134 | The main function is the entry point of the program and will receive command line arguments 135 | as function arguments. The entry file can import other modules, including native C modules, and 136 | jpm will attempt to include the dependencies into the generated executable. 137 | 138 | .TP 139 | .BR repl 140 | Run a repl in the same environment as the test environment. Allows 141 | you to use built natives without installing them. 142 | 143 | .TP 144 | .BR debug-repl 145 | Load the current project.janet file and start a repl in it's environment. This lets a user better 146 | debug the project file, as well as run rules manually. 147 | 148 | .TP 149 | .BR make-lockfile\ [\fBfilename\fR] 150 | Create a lockfile. A lockfile is a record that describes what dependencies were installed at the 151 | time of the lockfile's creation, including exact versions. A lockfile can then be later used 152 | to set up that environment on a different machine via load-lockfile. By default, the lockfile 153 | is created at lockfile.jdn, although any path can be used. 154 | 155 | .TP 156 | .BR load-lockfile\ [\fBfilename\fR] 157 | Install dependencies from a lockfile previously created with make-lockfile. By default, will look 158 | for a lockfile at lockfile.jdn, although any path can be used. 159 | 160 | .TP 161 | .BR new-project\ [\fBname\fR] 162 | Create a new Janet project interactively in a directory "name". 163 | 164 | .TP 165 | .BR new-c-project\ [\fBname\fR] 166 | Create a new C+Janet project interactively in a directory "name". 167 | 168 | .TP 169 | .BR new-exe-project\ [\fBname\fR] 170 | Create a new project for an executable in a directory "name". 171 | 172 | .SH ENVIRONMENT 173 | 174 | .B JANET_TREE 175 | .RS 176 | A convenient way to set the modpath, binpath, syspath, and manpath all at once. This is equivalent to the 177 | --tree parameter to jpm. 178 | .RE 179 | 180 | .B JANET_PATH 181 | .RS 182 | The location to look for Janet libraries. This is the only environment variable Janet needs to 183 | find native and source code modules. If no JANET_PATH is set, Janet will look in 184 | the default location set at compile time, which can be determined with (dyn :syspath) 185 | .RE 186 | 187 | .B JANET_MODPATH 188 | .RS 189 | The location that jpm will use to install libraries to. Defaults to JANET_PATH, but you could 190 | set this to a different directory if you want to. Doing so would let you import Janet modules 191 | on the normal system path (JANET_PATH or (dyn :syspath)), but install to a different directory. It is also a more reliable way to install. 192 | This variable is overwritten by the --modpath=/some/path if it is provided. 193 | .RE 194 | 195 | .B JANET_HEADERPATH 196 | .RS 197 | The location that jpm will look for janet header files (janet.h and janetconf.h) that are used 198 | to build native modules and standalone executables. If janet.h and janetconf.h are available as 199 | default includes on your system, this value is not required. If not provided, will default to 200 | /../include/janet. The --headerpath=/some/path option will override this 201 | variable. 202 | .RE 203 | 204 | .B JANET_LIBPATH 205 | .RS 206 | Similar to JANET_HEADERPATH, this path is where jpm will look for 207 | libjanet.a for creating standalone executables. This does not need to be 208 | set on a normal install. 209 | If not provided, this will default to /../lib. 210 | The --libpath=/some/path option will override this variable. 211 | .RE 212 | 213 | .B JANET_BINPATH 214 | .RS 215 | The directory where jpm will install binary scripts and executables to. 216 | Defaults to 217 | (dyn :syspath)/bin 218 | The --binpath=/some/path will override this variable. 219 | .RE 220 | 221 | .B JANET_BUILDPATH 222 | .RS 223 | The directory where jpm will put intermediate files, object code, and compiled executables. 224 | Defaults to ./build 225 | The --buildpath=/some/path will override this variable. You should make that directories above this 226 | directory exist before building. 227 | .RE 228 | 229 | .B JANET_PKGLIST 230 | .RS 231 | The git repository URL that contains a listing of packages. This allows installing packages with short names, which 232 | is mostly a convenience. However, package dependencies can use short names, package listings 233 | can be used to choose a particular set of dependency versions for a whole project. 234 | .RE 235 | 236 | .B JANET_GIT 237 | .RS 238 | An optional path to a git executable to use to clone git dependencies. By default, uses "git" on the current $PATH. You shouldn't need to set this 239 | if you have a normal install of git. 240 | .RE 241 | 242 | .B JANET_JPM_CONFIG 243 | .RS 244 | An optional path to a config file to load. This option is overridden by the --config-file command 245 | line option. 246 | 247 | .SH AUTHOR 248 | Written by Calvin Rose 249 | -------------------------------------------------------------------------------- /jpm/cc.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### C and C++ compiler rule utilties 3 | ### 4 | 5 | (use ./config) 6 | (use ./rules) 7 | (use ./shutil) 8 | 9 | (def- entry-replacer 10 | "Convert url with potential bad characters into an entry-name" 11 | (peg/compile ~(% (any (+ '(range "AZ" "az" "09" "__") (/ '1 ,|(string "_" ($ 0) "_"))))))) 12 | 13 | (defn entry-replace 14 | "Escape special characters in the entry-name" 15 | [name] 16 | (get (peg/match entry-replacer name) 0)) 17 | 18 | (defn embed-name 19 | "Rename a janet symbol for embedding." 20 | [path] 21 | (->> path 22 | (string/replace-all "\\" "___") 23 | (string/replace-all "/" "___") 24 | (string/replace-all ".janet" ""))) 25 | 26 | (defn out-path 27 | "Take a source file path and convert it to an output path." 28 | [path from-ext to-ext] 29 | (->> path 30 | (string/replace-all "\\" "___") 31 | (string/replace-all "/" "___") 32 | (string/replace-all from-ext to-ext) 33 | (string (find-build-dir)))) 34 | 35 | (defn make-define 36 | "Generate strings for adding custom defines to the compiler." 37 | [define value] 38 | (if value 39 | (string "-D" define "=" value) 40 | (string "-D" define))) 41 | 42 | (defn make-defines 43 | "Generate many defines. Takes a dictionary of defines. If a value is 44 | true, generates -DNAME (/DNAME on windows), otherwise -DNAME=value." 45 | [defines] 46 | (def ret (seq [[d v] :pairs defines] (make-define d (if (not= v true) v)))) 47 | (array/push ret (make-define "JANET_BUILD_TYPE" (dyn:build-type "release"))) 48 | ret) 49 | 50 | (defn- getflags 51 | "Generate the c flags from the input options." 52 | [opts compiler] 53 | (def flags (if (= compiler :cc) :cflags :cppflags)) 54 | (def bt (dyn:build-type "release")) 55 | (def bto 56 | (opt opts 57 | :optimize 58 | (case bt 59 | "release" 2 60 | "debug" 0 61 | "develop" 2 62 | 2))) 63 | (def oflag 64 | (if (dyn :is-msvc) 65 | (case bto 0 "/Od" 1 "/O1" 2 "/O2" "/O2") 66 | (case bto 0 "-O0" 1 "-O1" 2 "-O2" "-O3"))) 67 | (def debug-syms 68 | (if (or (= bt "develop") (= bt "debug")) 69 | (if (dyn :is-msvc) ["/DEBUG"] ["-g"]) 70 | [])) 71 | @[;(opt opts flags) 72 | ;(if (dyn:verbose) (dyn:cflags-verbose) []) 73 | ;debug-syms 74 | (string "-I" (dyn:headerpath)) 75 | (string "-I" (dyn:modpath)) 76 | oflag]) 77 | 78 | (defn entry-name 79 | "Name of symbol that enters static compilation of a module." 80 | [name] 81 | (string "janet_module_entry_" (entry-replace name))) 82 | 83 | (defn compile-c 84 | "Compile a C file into an object file." 85 | [compiler opts src dest &opt static?] 86 | (def cc (opt opts compiler)) 87 | (def cflags [;(getflags opts compiler) 88 | ;(if static? [] (dyn :dynamic-cflags))]) 89 | (def entry-defines (if-let [n (and static? (opts :entry-name))] 90 | [(make-define "JANET_ENTRY_NAME" n)] 91 | [])) 92 | (def defines [;(make-defines (opt opts :defines {})) ;entry-defines]) 93 | (def headers (or (opts :headers) [])) 94 | (rule dest [src ;headers] 95 | (unless (dyn:verbose) (print "compiling " src " to " dest "...") (flush)) 96 | (create-dirs dest) 97 | (if (dyn :is-msvc) 98 | (clexe-shell cc ;defines "/c" ;cflags (string "/Fo" dest) src) 99 | (shell cc "-c" src ;defines ;cflags "-o" dest)))) 100 | 101 | (defn link-c 102 | "Link C or C++ object files together to make a native module." 103 | [has-cpp opts target & objects] 104 | (def linker (dyn (if has-cpp :c++-link :cc-link))) 105 | (def cflags (getflags opts (if has-cpp :c++ :cc))) 106 | (def lflags [;(opt opts :lflags) 107 | ;(if (opts :static) [] (dyn:dynamic-lflags))]) 108 | (def deplibs (get opts :native-deps [])) 109 | (def linkext 110 | (if (is-win-or-mingw) 111 | (dyn :importlibext) 112 | (dyn :modext))) 113 | (def dep-ldflags (seq [x :in deplibs] (string (dyn:modpath) "/" x linkext))) 114 | # Use import libs on windows - we need an import lib to link natives to other natives. 115 | (def dep-importlibs 116 | (if (is-win-or-mingw) 117 | (seq [x :in deplibs] (string (dyn:modpath) "/" x (dyn :importlibext))) 118 | @[])) 119 | (when-let [import-lib (dyn :janet-importlib)] 120 | (array/push dep-importlibs import-lib)) 121 | (def dep-importlibs (distinct dep-importlibs)) 122 | (def ldflags [;(opt opts :ldflags []) ;dep-ldflags]) 123 | (rule target objects 124 | (unless (dyn:verbose) (print "creating native module " target "...") (flush)) 125 | (create-dirs target) 126 | (if (dyn :is-msvc) 127 | (clexe-shell linker (string "/OUT:" target) ;objects ;dep-importlibs ;ldflags ;lflags) 128 | (shell linker ;cflags `-o` target ;objects ;dep-importlibs ;ldflags ;lflags)))) 129 | 130 | (defn archive-c 131 | "Link object files together to make a static library." 132 | [opts target & objects] 133 | (def ar (opt opts :ar)) 134 | (rule target objects 135 | (unless (dyn:verbose) (print "creating static library " target "...") (flush)) 136 | (create-dirs target) 137 | (if (dyn :is-msvc) 138 | (shell ar "/nologo" (string "/out:" target) ;objects) 139 | (shell ar "rcs" target ;objects)))) 140 | 141 | # 142 | # Standalone C compilation 143 | # 144 | 145 | (defn create-buffer-c-impl 146 | [bytes dest name] 147 | (create-dirs dest) 148 | (def out (file/open dest :wn)) 149 | (def chunks (seq [b :in bytes] (string b))) 150 | (file/write out 151 | "#include \n" 152 | "static const unsigned char bytes[] = {" 153 | (string/join (interpose ", " chunks)) 154 | "};\n\n" 155 | "const unsigned char *" name "_embed = bytes;\n" 156 | "size_t " name "_embed_size = sizeof(bytes);\n") 157 | (file/close out)) 158 | 159 | (defn create-buffer-c 160 | "Inline raw byte file as a c file." 161 | [source dest name] 162 | (rule dest [source] 163 | (print "generating " dest "...") 164 | (flush) 165 | (create-dirs dest) 166 | (with [f (file/open source :rn)] 167 | (create-buffer-c-impl (:read f :all) dest name)))) 168 | 169 | (defn modpath-to-meta 170 | "Get the meta file path (.meta.janet) corresponding to a native module path (.so)." 171 | [path] 172 | (string (string/slice path 0 (- (length (dyn:modext)))) "meta.janet")) 173 | 174 | (defn modpath-to-static 175 | "Get the static library (.a) path corresponding to a native module path (.so)." 176 | [path] 177 | (string (string/slice path 0 (- -1 (length (dyn:modext)))) (dyn:statext))) 178 | 179 | (defn make-bin-source 180 | [declarations lookup-into-invocations no-core] 181 | (string 182 | declarations 183 | ``` 184 | 185 | int main(int argc, const char **argv) { 186 | 187 | #if defined(JANET_PRF) 188 | uint8_t hash_key[JANET_HASH_KEY_SIZE + 1]; 189 | #ifdef JANET_REDUCED_OS 190 | char *envvar = NULL; 191 | #else 192 | char *envvar = getenv("JANET_HASHSEED"); 193 | #endif 194 | if (NULL != envvar) { 195 | strncpy((char *) hash_key, envvar, sizeof(hash_key) - 1); 196 | } else if (janet_cryptorand(hash_key, JANET_HASH_KEY_SIZE) != 0) { 197 | fputs("unable to initialize janet PRF hash function.\n", stderr); 198 | return 1; 199 | } 200 | janet_init_hash_key(hash_key); 201 | #endif 202 | 203 | janet_init(); 204 | 205 | ``` 206 | (if no-core 207 | ``` 208 | /* Get core env */ 209 | JanetTable *env = janet_table(8); 210 | JanetTable *lookup = janet_core_lookup_table(NULL); 211 | JanetTable *temptab; 212 | int handle = janet_gclock(); 213 | ``` 214 | ``` 215 | /* Get core env */ 216 | JanetTable *env = janet_core_env(NULL); 217 | JanetTable *lookup = janet_env_lookup(env); 218 | JanetTable *temptab; 219 | int handle = janet_gclock(); 220 | ```) 221 | lookup-into-invocations 222 | ``` 223 | /* Unmarshal bytecode */ 224 | Janet marsh_out = janet_unmarshal( 225 | janet_payload_image_embed, 226 | janet_payload_image_embed_size, 227 | 0, 228 | lookup, 229 | NULL); 230 | 231 | /* Verify the marshalled object is a function */ 232 | if (!janet_checktype(marsh_out, JANET_FUNCTION)) { 233 | fprintf(stderr, "invalid bytecode image - expected function."); 234 | return 1; 235 | } 236 | JanetFunction *jfunc = janet_unwrap_function(marsh_out); 237 | 238 | /* Check arity */ 239 | janet_arity(argc, jfunc->def->min_arity, jfunc->def->max_arity); 240 | 241 | /* Collect command line arguments */ 242 | JanetArray *args = janet_array(argc); 243 | for (int i = 0; i < argc; i++) { 244 | janet_array_push(args, janet_cstringv(argv[i])); 245 | } 246 | 247 | /* Create enviornment */ 248 | temptab = env; 249 | janet_table_put(temptab, janet_ckeywordv("args"), janet_wrap_array(args)); 250 | janet_table_put(temptab, janet_ckeywordv("executable"), janet_cstringv(argv[0])); 251 | janet_gcroot(janet_wrap_table(temptab)); 252 | 253 | /* Unlock GC */ 254 | janet_gcunlock(handle); 255 | 256 | /* Run everything */ 257 | JanetFiber *fiber = janet_fiber(jfunc, 64, argc, argc ? args->data : NULL); 258 | fiber->env = temptab; 259 | #ifdef JANET_EV 260 | janet_gcroot(janet_wrap_fiber(fiber)); 261 | janet_schedule(fiber, janet_wrap_nil()); 262 | janet_loop(); 263 | int status = janet_fiber_status(fiber); 264 | janet_deinit(); 265 | return status; 266 | #else 267 | Janet out; 268 | JanetSignal result = janet_continue(fiber, janet_wrap_nil(), &out); 269 | if (result != JANET_SIGNAL_OK && result != JANET_SIGNAL_EVENT) { 270 | janet_stacktrace(fiber, out); 271 | janet_deinit(); 272 | return result; 273 | } 274 | janet_deinit(); 275 | return 0; 276 | #endif 277 | } 278 | 279 | ```)) 280 | 281 | (defn create-executable 282 | "Links an image with libjanet.a (or .lib) to produce an 283 | executable. Also will try to link native modules into the 284 | final executable as well." 285 | [opts source dest no-core] 286 | 287 | # Create executable's janet image 288 | (def cimage_dest (string dest ".c")) 289 | (def no-compile (opts :no-compile)) 290 | (def bd (find-build-dir)) 291 | (rule (if no-compile cimage_dest dest) [source] 292 | (print "generating executable c source " cimage_dest " from " source "...") 293 | (flush) 294 | (create-dirs dest) 295 | 296 | # Monkey patch stuff 297 | (def token (do-monkeypatch bd)) 298 | (defer (undo-monkeypatch token) 299 | 300 | # Load entry environment and get main function. 301 | (def env (make-env)) 302 | (def entry-env (dofile source :env env)) 303 | (def main ((entry-env 'main) :value)) 304 | (def dep-lflags @[]) 305 | (def dep-ldflags @[]) 306 | 307 | # Create marshalling dictionary 308 | (def mdict1 (invert (env-lookup root-env))) 309 | (def mdict 310 | (if no-core 311 | (let [temp @{}] 312 | (eachp [k v] mdict1 313 | (if (or (cfunction? k) (abstract? k)) 314 | (put temp k v))) 315 | temp) 316 | mdict1)) 317 | 318 | # Load all native modules 319 | (def prefixes @{}) 320 | (def static-libs @[]) 321 | (loop [[name m] :pairs module/cache 322 | :let [n (m :native)] 323 | :when n 324 | :let [prefix (gensym)]] 325 | (print "found native " n "...") 326 | (flush) 327 | (put prefixes prefix n) 328 | (array/push static-libs (modpath-to-static n)) 329 | (def oldproto (table/getproto m)) 330 | (table/setproto m nil) 331 | (loop [[sym value] :pairs (env-lookup m)] 332 | (put mdict value (symbol prefix sym))) 333 | (table/setproto m oldproto)) 334 | 335 | # Find static modules 336 | (var has-cpp false) 337 | (def declarations @"") 338 | (def lookup-into-invocations @"") 339 | (loop [[prefix name] :pairs prefixes] 340 | (def meta (eval-string (slurp (modpath-to-meta name)))) 341 | (if (meta :cpp) (set has-cpp true)) 342 | (buffer/push-string lookup-into-invocations 343 | " temptab = janet_table(0);\n" 344 | " temptab->proto = env;\n" 345 | " " (meta :static-entry) "(temptab);\n" 346 | " janet_env_lookup_into(lookup, temptab, \"" 347 | prefix 348 | "\", 0);\n\n") 349 | (when-let [lfs (meta :lflags)] 350 | (array/concat dep-lflags lfs)) 351 | (when-let [lfs (meta :ldflags)] 352 | (array/concat dep-ldflags lfs)) 353 | (buffer/push-string declarations 354 | "extern void " 355 | (meta :static-entry) 356 | "(JanetTable *);\n")) 357 | 358 | # Build image 359 | (def image (marshal main mdict)) 360 | # Make image byte buffer 361 | (create-buffer-c-impl image cimage_dest "janet_payload_image") 362 | # Append main function 363 | (spit cimage_dest (make-bin-source declarations lookup-into-invocations no-core) :ab) 364 | (def oimage_dest (out-path cimage_dest ".c" ".o")) 365 | # Compile and link final exectable 366 | (unless no-compile 367 | (def ldflags [;dep-ldflags ;(opt opts :ldflags [])]) 368 | (def lflags [;static-libs 369 | (string (dyn:libpath) "/libjanet." (last (string/split "." (dyn:statext)))) 370 | ;dep-lflags ;(opt opts :lflags []) ;(dyn:janet-lflags)]) 371 | (def defines (make-defines (opt opts :defines {}))) 372 | (def cc (opt opts :cc)) 373 | (def cflags [;(getflags opts :cc) ;(dyn:janet-cflags)]) 374 | (print "compiling " cimage_dest " to " oimage_dest "...") 375 | (flush) 376 | (create-dirs oimage_dest) 377 | (if (dyn:is-msvc) 378 | (clexe-shell cc ;defines "/c" ;cflags (string "/Fo" oimage_dest) cimage_dest) 379 | (shell cc "-c" cimage_dest ;defines ;cflags "-o" oimage_dest)) 380 | (if has-cpp 381 | (let [linker (opt opts (if (dyn :is-msvc) :c++-link :c++)) 382 | cppflags [;(getflags opts :c++) ;(dyn:janet-cflags)]] 383 | (print "linking " dest "...") 384 | (flush) 385 | (if (dyn:is-msvc) 386 | (clexe-shell linker (string "/OUT:" dest) oimage_dest ;ldflags ;lflags) 387 | (shell linker ;cppflags `-o` dest oimage_dest ;ldflags ;lflags))) 388 | (let [linker (opt opts (if (dyn:is-msvc) :cc-link :cc))] 389 | (print "linking " dest "...") 390 | (flush) 391 | (create-dirs dest) 392 | (if (dyn:is-msvc) 393 | (clexe-shell linker (string "/OUT:" dest) oimage_dest ;ldflags ;lflags) 394 | (shell linker ;cflags `-o` dest oimage_dest ;ldflags ;lflags)))))))) 395 | -------------------------------------------------------------------------------- /jpm/cgen.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### cgen.janet 3 | ### 4 | ### 5 | ### A DSL that compiles to C. Let's 6 | ### you use Janet's macro system to 7 | ### emit C code. 8 | ### 9 | ### The semantics of the IR are basically the 10 | ### same as C so a higher level language (or type system) 11 | ### should be built on top of this. This IR emits a very useful 12 | ### subset of valid C 99. 13 | ### 14 | 15 | (defmacro- setfn 16 | [name & body] 17 | ~(set ,name (fn ,name ,;body))) 18 | 19 | (def- mangle-peg 20 | (peg/compile 21 | ~{:valid (range "az" "AZ" "__") 22 | :one (+ (/ "-" "_") ':valid (/ '1 ,|(string "_X" ($ 0)))) 23 | :main (% (* :one (any (+ ':d :one))))})) 24 | 25 | (defn mangle 26 | "Convert any sequence of bytes to a valid C identifier in a way that is unlikely to collide. 27 | `print-ir` will not mangle symbols for you." 28 | [token] 29 | (first (peg/match mangle-peg token))) 30 | 31 | (defn print-ir 32 | "Compile the CGEN IR to C and print it to (dyn :out)." 33 | [ir] 34 | 35 | # Basic utilities 36 | 37 | (def indent @"") 38 | (defn emit-indent [] (prin indent)) 39 | (defn emit-block-start [] (prin "{") (buffer/push indent " ") (print)) 40 | (defn emit-block-end [&opt nl] (buffer/popn indent 2) (emit-indent) (prin "}") (when nl (print))) 41 | 42 | # Mutually recrusive functions 43 | 44 | (var emit-type nil) 45 | (var emit-expression nil) 46 | (var emit-statement nil) 47 | (var emit-block nil) 48 | (var emit-top nil) 49 | 50 | # Types (for type declarations) 51 | 52 | (defn emit-struct-union-def 53 | [which name args defname] 54 | (assert (even? (length args)) "expected even number of arguments") 55 | (prin which " ") 56 | (if name (prin name " ")) 57 | (emit-block-start) 58 | (each [field ftype] (partition 2 args) 59 | (emit-indent) 60 | (emit-type ftype field) 61 | (print ";")) 62 | (emit-block-end) 63 | (if defname (prin " " defname))) 64 | 65 | (defn emit-struct-def 66 | [name args defname] 67 | (emit-struct-union-def "struct" name args defname)) 68 | 69 | (defn emit-union-def 70 | [name args defname] 71 | (emit-struct-union-def "union" name args defname)) 72 | 73 | (defn emit-enum-def 74 | [name args defname] 75 | (prin "enum ") 76 | (if name (prin name " ")) 77 | (emit-block-start) 78 | (each x args 79 | (emit-indent) 80 | (if (tuple? x) 81 | (do 82 | (prin (x 0) " = ") 83 | (emit-expression (x 1)) 84 | (print ",")) 85 | (print x ","))) 86 | (emit-block-end) 87 | (if defname (prin " " defname))) 88 | 89 | (defn emit-fn-pointer-type 90 | [ret-type args defname] 91 | (prin "(") 92 | (emit-type ret-type) 93 | (prin ")(*" defname ")(") 94 | (var is-first true) 95 | (each x args 96 | (unless is-first (prin ", ")) 97 | (set is-first false) 98 | (if (tuple? x) 99 | (emit-type (x 1) (x 0)) 100 | (emit-type x))) 101 | (prin ")")) 102 | 103 | (defn emit-ptr-type 104 | [x alias] 105 | (emit-type x) 106 | (prin " *") 107 | (if alias (prin alias))) 108 | 109 | (defn emit-ptr-ptr-type 110 | [x alias] 111 | (emit-type x) 112 | (prin " **") 113 | (if alias (prin alias))) 114 | 115 | (defn emit-const-type 116 | [x alias] 117 | (prin "const ") 118 | (emit-type x) 119 | (if alias (prin " " alias))) 120 | 121 | (defn emit-array-type 122 | [x n alias] 123 | (if-not alias (prin "(")) 124 | (emit-type x) 125 | (if alias (prin " " alias)) 126 | (prin "[") 127 | (when n 128 | (emit-expression n true)) 129 | (prin "]") 130 | (if-not alias (prin ")"))) 131 | 132 | (setfn emit-type 133 | [definition &opt alias] 134 | (case (type definition) 135 | :tuple 136 | (case (get definition 0) 137 | 'struct (emit-struct-def nil (slice definition 1) alias) 138 | 'named-struct (emit-struct-def (definition 1) (slice definition 1) alias) 139 | 'enum (emit-enum-def nil (slice definition 1) alias) 140 | 'named-enum (emit-enum-def (definition 1) (slice definition 2) alias) 141 | 'union (emit-union-def nil (slice definition 1) alias) 142 | 'named-union (emit-union-def (definition 1) (slice definition 2) alias) 143 | 'fn (emit-fn-pointer-type (definition 1) (slice definition 2) alias) 144 | 'ptr (emit-ptr-type (definition 1) alias) 145 | '* (emit-ptr-type (definition 1) alias) 146 | 'ptrptr (emit-ptr-ptr-type (definition 1) alias) 147 | '** (emit-ptr-ptr-type (definition 1) alias) 148 | 'array (emit-array-type (definition 1) (get definition 2) alias) 149 | 'const (emit-const-type (definition 1) alias) 150 | (errorf "unexpected type form %v" definition)) 151 | :keyword (do (prin definition) (if alias (prin " " alias))) 152 | :symbol (do (prin definition) (if alias (prin " " alias))) 153 | (errorf "unexpected type form %v" definition))) 154 | 155 | (defn emit-typedef 156 | [alias definition] 157 | (prin "typedef ") 158 | (emit-type definition alias) 159 | (print ";")) 160 | 161 | # Expressions 162 | 163 | (defn emit-funcall 164 | [items] 165 | (def f (get items 0)) 166 | (emit-expression f (symbol? f)) 167 | (prin "(") 168 | (for i 1 (length items) 169 | (if (not= i 1) (prin ", ")) 170 | (emit-expression (in items i) true)) 171 | (prin ")")) 172 | 173 | (defn emit-binop 174 | [op & xs] 175 | (var is-first true) 176 | (each x xs 177 | (if-not is-first (prin " " op " ")) 178 | (set is-first false) 179 | (emit-expression x))) 180 | 181 | (defn emit-indexer 182 | [op ds field] 183 | (emit-expression ds) 184 | (prin op field)) 185 | 186 | (defn emit-unop 187 | [op x] 188 | (prin op) 189 | (emit-expression x)) 190 | 191 | (defn emit-aindex 192 | [a index] 193 | (emit-expression a) 194 | (prin "[") 195 | (emit-expression index true) 196 | (prin "]")) 197 | 198 | (defn emit-set 199 | [lvalue rvalue] 200 | (emit-expression lvalue true) 201 | (prin " = ") 202 | (emit-expression rvalue true)) 203 | 204 | (defn emit-deref 205 | [ptr] 206 | (prin "*") 207 | (emit-expression ptr)) 208 | 209 | (defn emit-address 210 | [expr] 211 | (prin "&") 212 | (emit-expression expr)) 213 | 214 | (defn emit-cast 215 | [ctype expr] 216 | (prin "(" ctype ")") 217 | (emit-expression expr)) 218 | 219 | (defn emit-struct-ctor 220 | [args] 221 | (assert (even? (length args)) "expected an even number of arguments for a struct literal") 222 | (emit-block-start) 223 | (each [k v] (partition 2 args) 224 | (emit-indent) 225 | (prin "." k " = ") 226 | (emit-expression v true) 227 | (print ",")) 228 | (emit-block-end)) 229 | 230 | (defn emit-array-ctor 231 | [args] 232 | (var is-first true) 233 | (prin "{") 234 | (each x args 235 | (if-not is-first (prin ", ")) 236 | (set is-first false) 237 | (emit-expression x true)) 238 | (prin "}")) 239 | 240 | (setfn emit-expression 241 | [form &opt noparen] 242 | (case (type form) 243 | :symbol (prin form) 244 | :keyword (prin form) 245 | :number (prinf "%.17g" form) 246 | :string (prinf "%v" form) # todo - better match escape codes 247 | :tuple 248 | (do 249 | (unless noparen (prin "(")) 250 | (case (get form 0) 251 | 'literal (prin (string (form 1))) 252 | 'quote (prin (string (form 1))) 253 | '+ (emit-binop ;form) 254 | '- (emit-binop ;form) 255 | '* (emit-binop ;form) 256 | '/ (emit-binop ;form) 257 | '% (emit-binop ;form) 258 | '< (emit-binop ;form) 259 | '> (emit-binop ;form) 260 | '<= (emit-binop ;form) 261 | '>= (emit-binop ;form) 262 | '== (emit-binop ;form) 263 | '!= (emit-binop ;form) 264 | 'and (emit-binop "&&" ;(slice form 1)) 265 | 'or (emit-binop "||" ;(slice form 1)) 266 | 'band (emit-binop "&" ;(slice form 1)) 267 | 'bor (emit-binop "|" ;(slice form 1)) 268 | 'bxor (emit-binop "^" ;(slice form 1)) 269 | 'bnot (emit-unop "~" (form 1)) 270 | 'not (emit-unop "!" (form 1)) 271 | 'neg (emit-unop "-" (form 1)) 272 | 'blshift (emit-binop "<<" (form 1) (form 2)) 273 | 'brshift (emit-binop ">>" (form 1) (form 2)) 274 | 'index (emit-aindex (form 1) (form 2)) 275 | 'call (emit-funcall (slice form 1)) 276 | 'set (emit-set (form 1) (form 2)) 277 | 'deref (emit-deref (form 1)) 278 | 'addr (emit-address (form 1)) 279 | 'cast (emit-cast (form 1) (form 2)) 280 | 'struct (emit-struct-ctor (slice form 1)) 281 | 'array (emit-array-ctor (slice form 1)) 282 | '-> (emit-indexer "->" (form 1) (form 2)) 283 | '. (emit-indexer "." (form 1) (form 2)) 284 | (emit-funcall form)) 285 | (unless noparen (prin ")"))) 286 | :array (do 287 | (unless noparen (prin "(")) 288 | (emit-array-ctor form) 289 | (unless noparen (prin ")"))) 290 | :struct (do 291 | (unless noparen (prin "(")) 292 | (emit-struct-ctor (mapcat identity (sort (pairs form)))) 293 | (unless noparen (print ")"))) 294 | :table (do 295 | (unless noparen (prin "(")) 296 | (emit-struct-ctor (mapcat identity (sort (pairs form)))) 297 | (unless noparen (print ")"))) 298 | (errorf "invalid expression %v" form))) 299 | 300 | # Statements 301 | 302 | (defn emit-declaration 303 | [v vtype &opt value] 304 | (emit-type vtype) 305 | (prin " " v) 306 | (when (not= nil value) 307 | (prin " = ") 308 | (emit-expression value true))) 309 | 310 | (setfn emit-statement 311 | [form] 312 | (case (get form 0) 313 | 'def (emit-declaration (form 1) (form 2) (form 3)) 314 | (emit-expression form true))) 315 | 316 | # Blocks 317 | 318 | (defn emit-do 319 | [statements] 320 | (emit-indent) 321 | (emit-block-start) 322 | (each s statements 323 | (emit-block s true)) 324 | (emit-block-end) 325 | (print)) 326 | 327 | (defn emit-cond 328 | [args] 329 | (assert (>= (length args) 2) "expected at least 2 arguments to if") 330 | (var is-first true) 331 | (each [condition branch] (partition 2 args) 332 | (if (= nil branch) 333 | (do 334 | (prin " else ") 335 | (emit-block condition)) 336 | (do 337 | (if is-first 338 | (do (emit-indent) (prin "if (")) 339 | (prin " else if (")) 340 | (set is-first false) 341 | (emit-expression condition true) 342 | (prin ") ") 343 | (emit-block branch)))) 344 | (print)) 345 | 346 | (defn emit-while 347 | [condition body] 348 | (emit-indent) 349 | (prin "while (") 350 | (emit-expression condition true) 351 | (prin ") ") 352 | (emit-block body) 353 | (print)) 354 | 355 | (defn emit-return 356 | [v] 357 | (emit-indent) 358 | (prin "return ") 359 | (emit-expression v true) 360 | (print ";")) 361 | 362 | (setfn emit-block 363 | [form &opt nobracket] 364 | (unless nobracket 365 | (emit-block-start)) 366 | (case (get form 0) 367 | 'do (emit-do (slice form 1)) 368 | 'while (emit-while (form 1) (form 2)) 369 | 'if (emit-cond (slice form 1)) 370 | 'cond (emit-cond (slice form 1)) 371 | 'return (emit-return (form 1)) 372 | 'break (do (emit-indent) (print "break;")) 373 | 'continue (do (emit-indent) (print "continue;")) 374 | 'label (print "label " (form 1) ":") 375 | 'goto (do (emit-indent) (print "goto " (form 1))) 376 | (do (emit-indent) (emit-statement form) (print ";"))) 377 | (unless nobracket (emit-block-end))) 378 | 379 | # Top level forms 380 | 381 | (defn emit-storage-classes 382 | [classes] 383 | (each class classes 384 | (prin class " "))) 385 | 386 | (defn emit-function 387 | [classes name arglist rtype body] 388 | (print) 389 | (emit-storage-classes classes) 390 | (prin rtype " " name "(") 391 | (var is-first true) 392 | (each arg arglist 393 | (unless is-first (prin ", ")) 394 | (set is-first false) 395 | (emit-type (arg 1)) 396 | (prin " " (arg 0))) 397 | (prin ") ") 398 | (emit-do body)) 399 | 400 | (defn emit-directive 401 | [& args] 402 | (print "#" (string/join (map string args) " "))) 403 | 404 | (setfn emit-top 405 | [form] 406 | (case (get form 0) 407 | 'defn (if (indexed? (form 1)) 408 | (emit-function (form 1) (form 2) (form 3) (form 4) (slice form 5)) 409 | (emit-function [] (form 1) (form 2) (form 3) (slice form 4))) 410 | 'deft (do (print) (emit-typedef (form 1) (form 2))) 411 | 'def (do (print) 412 | (if (indexed? (form 1)) 413 | (do 414 | (emit-storage-classes (form 1)) 415 | (emit-declaration (form 2) (form 3) (form 4)) (print ";")) 416 | (emit-declaration (form 1) (form 2) (form 3) (print ";")))) 417 | 'directive (emit-directive ;(slice form 1)) 418 | '@ (emit-directive ;(slice form 1)) 419 | (errorf "unknown top-level form %v" form))) 420 | 421 | # Final compilation 422 | (each top ir 423 | (emit-top top))) 424 | 425 | (defmacro ir 426 | "Macro that automatically quotes the body provided and calls (print-ir ...) on the body." 427 | [& body] 428 | ~(,print-ir ',body)) 429 | 430 | # 431 | # Module loading 432 | # 433 | 434 | (defn- loader 435 | [path &] 436 | (with-dyns [:current-file path] 437 | (let [p (parser/new) 438 | c @[]] 439 | (:consume p (slurp path)) 440 | (while (:has-more p) 441 | (array/push c (:produce p))) 442 | (defn tmpl [&opt rp] 443 | (default rp (string/slice path 0 -4)) 444 | (with [o (file/open rp :wbn)] 445 | (with-dyns [:out o :current-file path] (print-ir c)))) 446 | @{'render @{:doc "Main template function." 447 | :value tmpl}}))) 448 | 449 | (defn add-loader 450 | "Adds the custom template loader to Janet's module/loaders and 451 | update module/paths." 452 | [] 453 | (put module/loaders :cgen loader) 454 | (module/add-paths ".cgen" :cgen)) 455 | -------------------------------------------------------------------------------- /jpm/cli.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### Command Line interface for jpm. 3 | ### 4 | 5 | (use ./config) 6 | (import ./commands) 7 | (import ./default-config) 8 | 9 | (def- argpeg 10 | (peg/compile 11 | '(+ 12 | (* "--" '(some (if-not "=" 1)) (+ (* "=" '(any 1)) -1)) 13 | (* '"-" (some '(range "az" "AZ")))))) 14 | 15 | (defn setup 16 | ``Load configuration from the command line, environment variables, and 17 | configuration files. Returns array of non-configuration arguments as well. 18 | Config settings are prioritized as follows: 19 | 1. Commmand line settings 20 | 2. The value of `(dyn :jpm-config)` 21 | 3. Environment variables 22 | 4. Config file settings (default-config if non specified) 23 | `` 24 | [args] 25 | (read-env-variables) 26 | (load-options) 27 | (def cmdbuf @[]) 28 | (var flags-done false) 29 | (each a args 30 | (cond 31 | (= a "--") 32 | (set flags-done true) 33 | 34 | flags-done 35 | (array/push cmdbuf a) 36 | 37 | (if-let [m (peg/match argpeg a)] 38 | (do 39 | (def key (keyword (get m 0))) 40 | (if (= key :-) # short args 41 | (for i 1 (length m) 42 | (setdyn (get shorthand-mapping (get m i)) true)) 43 | (do 44 | # logn args 45 | (def value-parser (get config-parsers key)) 46 | (unless value-parser 47 | (error (string "unknown cli option " key))) 48 | (if (= 2 (length m)) 49 | (do 50 | (def v (value-parser key (get m 1))) 51 | (setdyn key v)) 52 | (setdyn key true))))) 53 | (do 54 | (if (index-of a ["janet" "exec"]) (set flags-done true)) 55 | (array/push cmdbuf a))))) 56 | 57 | # Load the configuration file, or use default config. 58 | (if-let [cd (dyn :jpm-config)] 59 | (load-config cd true) 60 | (if-let [cf (dyn :config-file (os/getenv "JANET_JPM_CONFIG"))] 61 | (load-config-file cf false) 62 | (load-config default-config/config false))) 63 | 64 | # Local development - if --local flag is used, do a local installation to a tree. 65 | # Same for --tree= 66 | (cond 67 | (dyn :local) (commands/enable-local-mode) 68 | (dyn :tree) (commands/set-tree (dyn :tree))) 69 | 70 | # Make sure loaded project files and rules execute correctly. 71 | (unless (dyn :janet) 72 | (setdyn :janet (dyn :executable))) 73 | (put root-env :syspath (dyn :modpath)) 74 | 75 | # Update packages if -u flag given 76 | (if (dyn :update-pkgs) 77 | (commands/update-pkgs)) 78 | 79 | cmdbuf) 80 | 81 | (defn run 82 | "Run CLI commands." 83 | [& args] 84 | (def cmdbuf (setup args)) 85 | (if (empty? cmdbuf) 86 | (commands/help) 87 | (if-let [com (get commands/subcommands (first cmdbuf))] 88 | (com ;(slice cmdbuf 1)) 89 | (do 90 | (print "invalid command " (first cmdbuf)) 91 | (commands/help))))) 92 | 93 | (defmacro jpm 94 | "A Macro User Interface for jpm to be used from a repl in a way similar to the command line." 95 | [& argv] 96 | ~(,run ,;(map |(if (bytes? $) (string $) $) argv))) 97 | 98 | (defn main 99 | "Script entry." 100 | [& argv] 101 | (run ;(tuple/slice argv 1))) 102 | -------------------------------------------------------------------------------- /jpm/commands.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### All of the CLI sub commands 3 | ### 4 | 5 | (use ./config) 6 | (use ./declare) 7 | (use ./rules) 8 | (use ./shutil) 9 | (use ./cc) 10 | (use ./pm) 11 | (use ./scaffold) 12 | 13 | (defn help 14 | [] 15 | (print 16 | ``` 17 | usage: jpm [--key=value, --flag] ... [subcommand] [args] ... 18 | 19 | Run from a directory containing a project.janet file to perform 20 | operations on a project, or from anywhere to do operations on the 21 | global module cache (modpath). Commands that need write permission to 22 | the modpath are considered privileged commands - in some environments 23 | they may require super user privileges. Other project-level commands 24 | need to have a ./project.janet file in the current directory. 25 | 26 | To install/manage packages in a local subtree, use the --local flag 27 | (or -l) to install packages to ./jpm_tree. This should generally not 28 | require elevated privileges. 29 | 30 | Unprivileged global subcommands: 31 | 32 | help 33 | Show this help text. 34 | 35 | show-paths 36 | Prints the paths that will be used to install things. 37 | 38 | quickbin entry executable 39 | Create an executable from a janet script with a main function. 40 | 41 | exec 42 | Run any shell command with JANET_PATH set to the correct 43 | module tree. 44 | 45 | janet 46 | Run the Janet interpreter with JANET_PATH set to the correct 47 | module tree. 48 | 49 | new-project name 50 | Create a new Janet project in a directory `name`. 51 | 52 | new-c-project name 53 | Create a new C+Janet project in a directory `name`. 54 | 55 | new-exe-project name 56 | Create a new project for an executable in a directory `name`. 57 | 58 | Privileged global subcommands: 59 | 60 | install (repo or name)... 61 | Install artifacts. If a repo is given, install the contents of 62 | that git repository, assuming that the repository is a jpm 63 | project. If not, build and install the current project. 64 | 65 | update-installed 66 | Reinstall all installed packages. For packages that are not pinned 67 | to a specific version, this will get that latest version of packages. 68 | 69 | uninstall (module)... 70 | Uninstall a module. If no module is given, uninstall the 71 | module defined by the current directory. 72 | 73 | clear-cache 74 | Clear the git cache. Useful for updating dependencies. 75 | 76 | clear-manifest 77 | Clear the manifest. Useful for fixing broken installs. 78 | 79 | make-lockfile (lockfile) 80 | Create a lockfile based on repositories in the cache. The 81 | lockfile will record the exact versions of dependencies used 82 | to ensure a reproducible build. Lockfiles are best used with 83 | applications, not libraries. The default lockfile name is 84 | lockfile.jdn. 85 | 86 | load-lockfile (lockfile) 87 | Install modules from a lockfile in a reproducible way. The 88 | default lockfile name is lockfile.jdn. 89 | 90 | update-pkgs 91 | Update the current package listing from the remote git 92 | repository selected. 93 | 94 | Privileged project subcommands: 95 | 96 | deps 97 | Install dependencies for the current project. 98 | 99 | install 100 | Install artifacts of the current project. 101 | 102 | uninstall 103 | Uninstall the current project's artifacts. 104 | 105 | Unprivileged project subcommands: 106 | 107 | build 108 | Build all artifacts in the build/ directory, or the value specified in --buildpath. 109 | 110 | configure path 111 | Create a directory for out-of-tree builds, and also set project options. 112 | 113 | clean 114 | Remove any generated files or artifacts. 115 | 116 | test 117 | Run tests. Tests should be .janet files in the test/ directory 118 | relative to project.janet. Will patch the module paths to load 119 | built native code without installing it. 120 | 121 | run rule 122 | Run a rule. Can also run custom rules added via `(phony "task" 123 | [deps...] ...)` or `(rule "ouput.file" [deps...] ...)`. 124 | 125 | rules 126 | List rules available with run. 127 | 128 | list-installed 129 | List installed packages in the current syspath. 130 | 131 | list-pkgs (search) 132 | List packages in the package listing that the contain the 133 | string search. If no search pattern is given, prints the 134 | entire package listing. 135 | 136 | rule-tree (root rule) (depth) 137 | Print a nice tree to see what rules depend on other rules. 138 | Optionally provide a root rule to start printing from, and a 139 | max depth to print. Without these options, all rules will 140 | print their full dependency tree. 141 | 142 | repl 143 | Run a repl in the same environment as the test environment. Allows 144 | you to use built natives without installing them. 145 | 146 | debug-repl 147 | Run a repl in the context of the current project.janet 148 | file. This lets you run rules and otherwise debug the current 149 | project.janet file. 150 | 151 | save-config path 152 | Save the input configuration to a file. 153 | ```) 154 | 155 | (print) 156 | (print "Global options:") 157 | (each k (sort (keys config-docs)) 158 | (when (builtin-configs k) 159 | (print " --" k " : " (get config-docs k)))) 160 | (unless (= (length config-docs) (length builtin-configs)) 161 | (print) 162 | (print "Project options:") 163 | (each k (sort (keys config-docs)) 164 | (unless (builtin-configs k) 165 | (print " --" k " : " (get config-docs k))))) 166 | (print)) 167 | 168 | (defn- local-rule 169 | [rule &opt no-deps] 170 | (import-rules "./project.janet" @{:jpm-no-deps no-deps}) 171 | (do-rule rule)) 172 | 173 | (defn show-config 174 | [] 175 | (def configs (sorted (keys config-set))) 176 | (each conf configs 177 | (printf (if (dyn :nocolor) ":%-26s%.99q" ":%-26s%.99Q") (string conf) (dyn conf)))) 178 | 179 | (defn show-paths 180 | [] 181 | (print "tree: " (dyn :tree)) 182 | (print "binpath: " (dyn:binpath)) 183 | (print "modpath: " (dyn:modpath)) 184 | (print "syspath: " (dyn :syspath)) 185 | (print "manpath: " (dyn :manpath)) 186 | (print "libpath: " (dyn:libpath)) 187 | (print "headerpath: " (dyn:headerpath)) 188 | (print "buildpath: " (dyn :buildpath "build/")) 189 | (print "gitpath: " (dyn :gitpath)) 190 | (print "tarpath: " (dyn :tarpath)) 191 | (print "curlpath: " (dyn :curlpath))) 192 | 193 | (defn build 194 | [] 195 | (local-rule "build")) 196 | 197 | (defn clean 198 | [] 199 | (local-rule "clean")) 200 | 201 | (defn install 202 | [& repo] 203 | (if (empty? repo) 204 | (local-rule "install") 205 | (each rep repo (bundle-install rep)))) 206 | 207 | (defn test 208 | [] 209 | (local-rule "test")) 210 | 211 | (defn- uninstall-cmd 212 | [& what] 213 | (if (empty? what) 214 | (local-rule "uninstall") 215 | (each wha what (uninstall wha)))) 216 | 217 | (defn deps 218 | [] 219 | (def env (import-rules "./project.janet" @{:jpm-no-deps true})) 220 | (def meta (get env :project)) 221 | (if-let [deps (meta :dependencies)] 222 | (each dep deps 223 | (bundle-install dep)) 224 | (do (print "no dependencies found") (flush)))) 225 | 226 | (defn- print-rule-tree 227 | "Show dependencies for a given rule recursively in a nice tree." 228 | [root depth prefix prefix-part] 229 | (print prefix root) 230 | (when-let [{:inputs root-deps} ((getrules) root)] 231 | (when (pos? depth) 232 | (def l (-> root-deps length dec)) 233 | (eachp [i d] (sorted root-deps) 234 | (print-rule-tree 235 | d (dec depth) 236 | (string prefix-part (if (= i l) " └─" " ├─")) 237 | (string prefix-part (if (= i l) " " " │ "))))))) 238 | 239 | (defn show-rule-tree 240 | [&opt root depth] 241 | (import-rules "./project.janet") 242 | (def max-depth (if depth (scan-number depth) math/inf)) 243 | (if root 244 | (print-rule-tree root max-depth "" "") 245 | (let [ks (sort (seq [k :keys (dyn :rules)] k))] 246 | (each k ks (print-rule-tree k max-depth "" ""))))) 247 | 248 | (defn list-rules 249 | [&opt ctx] 250 | (import-rules "./project.janet") 251 | (def ks (sort (seq [k :keys (dyn :rules)] k))) 252 | (each k ks (print k))) 253 | 254 | (defn list-tasks 255 | [&opt ctx] 256 | (import-rules "./project.janet") 257 | (def ts 258 | (sort (seq [[t r] :pairs (dyn :rules) 259 | :when (get r :task)] 260 | t))) 261 | (each t ts (print t))) 262 | 263 | (defn list-installed 264 | [] 265 | (def xs 266 | (seq [x :in (os/dir (find-manifest-dir)) 267 | :when (string/has-suffix? ".jdn" x)] 268 | (string/slice x 0 -5))) 269 | (sort xs) 270 | (each x xs (print x))) 271 | 272 | (defn list-pkgs 273 | [&opt search] 274 | (def [ok _] (module/find "pkgs")) 275 | (unless ok 276 | (eprint "no local package listing found. Run `jpm update-pkgs` to get listing.") 277 | (os/exit 1)) 278 | (def pkgs-mod (require "pkgs")) 279 | (def ps 280 | (seq [p :keys (get-in pkgs-mod ['packages :value] []) 281 | :when (if search (string/find search p) true)] 282 | p)) 283 | (sort ps) 284 | (each p ps (print p))) 285 | 286 | (defn update-pkgs 287 | [] 288 | (bundle-install (dyn:pkglist)) false true) 289 | 290 | (defn quickbin 291 | [input output] 292 | (if (= (os/stat output :mode) :file) 293 | (print "output " output " exists.")) 294 | (create-executable @{:no-compile (dyn :no-compile)} input output (dyn :no-core)) 295 | (do-rule output)) 296 | 297 | (defn jpm-debug-repl 298 | [] 299 | (def env 300 | (try 301 | (require-jpm "./project.janet") 302 | ([err f] 303 | (if (= "cannot open ./project.janet" err) 304 | (put (make-jpm-env) :project {}) 305 | (propagate err f))))) 306 | (setdyn :pretty-format (if-not (dyn :nocolor) "%.20Q" "%.20q")) 307 | (setdyn :err-color (if-not (dyn :nocolor) true)) 308 | (def p (env :project)) 309 | (def name (p :name)) 310 | (if name (print "Project: " name)) 311 | (if-let [r (p :repo)] (print "Repository: " r)) 312 | (if-let [a (p :author)] (print "Author: " a)) 313 | (defn getchunk [buf p] 314 | (def [line] (parser/where p)) 315 | (getline (string "jpm[" (or name "repl") "]:" line ":" (parser/state p :delimiters) "> ") buf env)) 316 | (repl getchunk nil env)) 317 | 318 | (defn set-tree 319 | "Set the module tree for installing dependencies. This just sets the modpath 320 | binpath and manpath. Also creates the tree if it doesn't exist. However, still 321 | uses the system libraries and headers for janet." 322 | [tree] 323 | (def abs-tree (abspath tree)) 324 | (def sep (if (is-win) "\\" "/")) 325 | (def tree-bin (string abs-tree sep "bin")) 326 | (def tree-lib (string abs-tree sep "lib")) 327 | (def tree-man (string abs-tree sep "man")) 328 | (os/mkdir abs-tree) 329 | (os/mkdir tree-bin) 330 | (os/mkdir tree-lib) 331 | (os/mkdir tree-man) 332 | (setdyn :manpath tree-man) 333 | (setdyn :binpath tree-bin) 334 | (setdyn :modpath tree-lib)) 335 | 336 | (defn enable-local-mode 337 | "Modify the config to enable local development. Creates a local tree if one does not exist in ./jpm_tree/" 338 | [] 339 | (set-tree "jpm_tree")) 340 | 341 | (defn configure 342 | "Setup an out-of-tree build with certain configuration options." 343 | [&opt path] 344 | (def opts @{}) 345 | (def module (require-jpm "./project.janet" @{:jpm-no-deps true})) 346 | (eachk key config-set 347 | (put opts key (dyn key))) 348 | (default path (string "_" (dyn :build-type "out"))) 349 | (out-of-tree-config path opts)) 350 | 351 | (defn new-project 352 | "Create a new project" 353 | [name] 354 | (scaffold-project name {:c false})) 355 | 356 | (defn new-c-project 357 | "Create a new C project" 358 | [name] 359 | (scaffold-project name {:c true})) 360 | 361 | (defn new-exe-project 362 | "Create a new executable project" 363 | [name] 364 | (scaffold-project name {:c false :exe true})) 365 | 366 | (def subcommands 367 | {"build" build 368 | "clean" clean 369 | "help" help 370 | "install" install 371 | "test" test 372 | "help" help 373 | "deps" deps 374 | "debug-repl" jpm-debug-repl 375 | "rule-tree" show-rule-tree 376 | "show-paths" show-paths 377 | "show-config" show-config 378 | "list-installed" list-installed 379 | "list-pkgs" list-pkgs 380 | "clear-cache" clear-cache 381 | "clear-manifest" clear-manifest 382 | "repl" run-repl 383 | "run" local-rule 384 | "rules" list-rules 385 | "tasks" list-tasks 386 | "update-pkgs" update-pkgs 387 | "update-installed" update-installed 388 | "uninstall" uninstall-cmd 389 | "make-lockfile" make-lockfile 390 | "load-lockfile" load-lockfile 391 | "quickbin" quickbin 392 | "configure" configure 393 | "exec" shell 394 | "new-project" new-project 395 | "new-c-project" new-c-project 396 | "new-exe-project" new-exe-project 397 | "janet" (fn [& args] (shell (dyn :executable) ;args)) 398 | "save-config" save-config}) 399 | -------------------------------------------------------------------------------- /jpm/config.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### Various defaults that can be set at compile time 3 | ### and configure the behavior of the module. 4 | ### 5 | 6 | (import ./default-config) 7 | 8 | (defn opt 9 | "Get an option, allowing overrides via dynamic bindings AND some 10 | default value dflt if no dynamic binding is set." 11 | [opts key &opt dflt] 12 | (def ret (or (get opts key) (dyn key dflt))) 13 | (if (= nil ret) 14 | (error (string "option :" key " not set"))) 15 | ret) 16 | 17 | (var- builtins-loaded false) 18 | 19 | (def config-parsers 20 | "A table of all of the dynamic config bindings to parsers." 21 | @{}) 22 | 23 | (def config-options 24 | "A table of possible options for enum option types." 25 | @{}) 26 | 27 | (def config-checkers 28 | "A table of all of the dynamic config bindings to checkers (validators)." 29 | @{}) 30 | 31 | (def config-docs 32 | "Table of all of the help text for each config option." 33 | @{}) 34 | 35 | (def config-set 36 | "Listing of all config dyns." 37 | @{}) 38 | 39 | (def builtin-configs 40 | "Table of all built-in options, as opposed to project deifned options." 41 | @{}) 42 | 43 | # 44 | # Entry Parsers 45 | # 46 | 47 | (defn- parse-boolean 48 | [kw x] 49 | (case (string/ascii-lower x) 50 | "f" false 51 | "0" false 52 | "false" false 53 | "off" false 54 | "no" false 55 | "t" true 56 | "1" true 57 | "on" true 58 | "yes" true 59 | "true" true 60 | (errorf "option :%s, unknown boolean option %s" kw x))) 61 | 62 | (defn- parse-integer 63 | [kw x] 64 | (if-let [n (scan-number x)] 65 | (if (not= n (math/floor n)) 66 | (errorf "option :%s, expected integer, got %v" kw x) 67 | n) 68 | (errorf "option :%s, expected integer, got %v" kw x))) 69 | 70 | (defn- parse-string 71 | [kw x] 72 | x) 73 | 74 | (defn- parse-string-array 75 | [kw x] 76 | (string/split "," x)) 77 | 78 | (def- config-parser-types 79 | "A table of all of the option parsers." 80 | @{:int parse-integer 81 | :int-opt parse-integer 82 | :int? parse-integer 83 | :string parse-string 84 | :string-opt parse-string 85 | :string? parse-string 86 | :string-array parse-string-array 87 | :boolean parse-boolean}) 88 | 89 | # 90 | # Entry Checkers 91 | # 92 | 93 | (defn- string-array? 94 | [x] 95 | (and (indexed? x) 96 | (all string? x))) 97 | 98 | (defn- boolean-or-nil? 99 | [x] 100 | (or (nil? x) (boolean? x))) 101 | 102 | (defn- string-or-nil? 103 | [x] 104 | (or (nil? x) (string? x))) 105 | 106 | (defn- int-or-nil? 107 | [x] 108 | (or (nil? x) (int? x))) 109 | 110 | (def- config-checker-types 111 | "A table of all of the option checkers" 112 | @{:int int? 113 | :int-opt int-or-nil? 114 | :int? int-or-nil? 115 | :string string? 116 | :string-opt string-or-nil? 117 | :string? string-or-nil? 118 | :string-array string-array? 119 | :boolean boolean-or-nil?}) 120 | 121 | (defmacro defconf 122 | "Define a function that wraps (dyn :keyword). This will 123 | allow use of dynamic bindings with static runtime checks." 124 | [kw &opt parser docs options] 125 | (put config-parsers kw (get config-parser-types parser)) 126 | (put config-checkers kw (get config-checker-types parser)) 127 | (put config-options kw options) 128 | (put config-docs kw docs) 129 | (put config-set kw parser) 130 | (unless builtins-loaded (put builtin-configs kw true)) 131 | (let [s (symbol "dyn:" kw)] 132 | ~(defn ,s [&opt dflt] 133 | (def x (,dyn ,kw dflt)) 134 | (if (= x nil) 135 | (,errorf "no value found for dynamic binding %v" ,kw) 136 | x)))) 137 | 138 | (defn save-config 139 | "Write the current configuration information to a file." 140 | [path] 141 | (def data @{}) 142 | (eachk k config-set (put data k (dyn k))) 143 | (def d (table/to-struct data)) 144 | (def buf @"") 145 | (buffer/format buf "%j" d) # ensure no funny stuff gets written to config file 146 | (buffer/clear buf) 147 | (def output (buffer/format buf "%.99m" d)) 148 | (spit path output)) 149 | 150 | (defn load-config 151 | "Load a configuration from a table or struct." 152 | [settings &opt override] 153 | (assert (dictionary? settings) "expected config file to be a dictionary") 154 | (eachp [k v] settings 155 | (setdyn k (if override v (dyn k v)))) 156 | # now check 157 | (eachk k config-set 158 | (def ctype (get config-set k)) 159 | (def checker (get config-checkers k)) 160 | (def options (get config-options k)) 161 | (def value (dyn k)) 162 | (when (and options (not (index-of value options))) 163 | (when (not= nil value) 164 | (errorf "invalid configuration option %v, expected one of %j, got %v" k options value))) 165 | (when (and checker (not (checker value))) 166 | (errorf "invalid configuration option %v, expected %v, got %v" k ctype value))) 167 | # Final patches 168 | (unless (dyn :modpath) 169 | (setdyn :modpath (dyn :syspath))) 170 | nil) 171 | 172 | (defn load-config-file 173 | "Load a configuration from a file. If override is set, will override already set values. 174 | Otherwise will prefer the current value over the settings from the config file." 175 | [path &opt override] 176 | (def config-table 177 | (if (string/has-suffix? ".janet" path) 178 | (-> path dofile (get-in ['config :value])) 179 | (-> path slurp parse))) 180 | (load-config config-table override)) 181 | 182 | (defn load-default 183 | "Load the default configuration." 184 | [&opt override] 185 | (load-config default-config/config override)) 186 | 187 | (def- mod-config (curenv)) 188 | 189 | (defn load-options 190 | "Load a file that contains config options that can be set. If no such 191 | file exists, then do nothing." 192 | [&opt path] 193 | (default path "./options.janet") 194 | (unless (os/stat path :mode) 195 | (break)) 196 | (def env (make-env)) 197 | (loop [k :keys mod-config :when (symbol? k) 198 | :let [x (get mod-config k)]] 199 | (unless (get x :private) 200 | (put env k x))) 201 | (dofile path :env env) 202 | # inherit dyns 203 | (loop [k :keys env :when (keyword? k)] 204 | (setdyn k (get env k))) 205 | nil) 206 | 207 | (defn- setwhen [k envvar] 208 | (when-let [v (os/getenv envvar)] 209 | (setdyn k v))) 210 | 211 | (defn read-env-variables 212 | "Read environment variables that correspond to config variables into dyns." 213 | [] 214 | (setwhen :gitpath "JANET_GIT") 215 | (setwhen :tarpath "JANET_TAR") 216 | (setwhen :curlpath "JANET_CURL") 217 | (setwhen :pkglist "JANET_PKGLIST") 218 | (setwhen :modpath "JANET_MODPATH") 219 | (setwhen :headerpath "JANET_HEADERPATH") 220 | (setwhen :libpath "JANET_LIBPATH") 221 | (setwhen :binpath "JANET_BINPATH") 222 | (setwhen :buildpath "JANET_BUILDPATH") 223 | (setwhen :manpath "JANET_MANPATH") 224 | (setwhen :tree "JANET_TREE")) 225 | 226 | (def shorthand-mapping 227 | "Map some single characters to long options." 228 | {"v" :verbose 229 | "l" :local 230 | "s" :silent 231 | "n" :nocolor 232 | "u" :update-pkgs 233 | "t" :test}) 234 | 235 | # All jpm settings. 236 | (defconf :binpath :string "The directory to install executable binaries and scripts to") 237 | (defconf :config-file :string-opt "A config file to load to load settings from") 238 | (defconf :gitpath :string "The path or command name of git used by jpm") 239 | (defconf :tarpath :string "The path or command name of tar used by jpm") 240 | (defconf :curlpath :string "The path or command name of curl used by jpm") 241 | (defconf :headerpath :string "Directory containing Janet headers") 242 | (defconf :manpath :string-opt "Directory to install man pages to") 243 | (defconf :janet :string "The path or command name of the Janet binary used when spawning janet subprocesses") 244 | (defconf :libpath :string 245 | "The directory that contains janet libraries for standalone binaries and other native artifacts") 246 | (defconf :modpath :string-opt "The directory tree to install packages to") 247 | (defconf :optimize :int-opt "The default optimization level to use for C/C++ compilation if otherwise unspecified" [0 1 2 3]) 248 | (defconf :pkglist :string-opt "The package listing bundle to use for mapping short package names to full URLs.") 249 | (defconf :offline :boolean "Do not download remote repositories when installing packages") 250 | (defconf :update-pkgs :boolean "Update package listing before doing anything.") 251 | (defconf :buildpath :string-opt "The path to output intermediate files and build outputs to. Default is build/") 252 | 253 | # Settings that probably shouldn't be set from the command line. 254 | (defconf :ar :string "The archiver used to generate static C/C++ libraries") 255 | (defconf :c++ :string "The C++ compiler to use for natives") 256 | (defconf :c++-link :string "The C++ linker to use for natives - on posix, should be the same as the compiler") 257 | (defconf :cc :string "The C compiler to use for natives") 258 | (defconf :cc-link :string "The C linker to use for natives - on posix, should be the same as the compiler") 259 | (defconf :cflags :string-array "List of flags to pass when compiling .c files to object files") 260 | (defconf :cppflags :string-array "List of flags to pass when compiling .cpp files to object files") 261 | (defconf :cflags-verbose :string-array "List of extra flags to pass when compiling in verbose mode") 262 | (defconf :dynamic-cflags :string-array "List of flags to pass only when compiler shared objects") 263 | (defconf :dynamic-lflags :string-array "List of flags to pass when linking shared objects") 264 | (defconf :is-msvc :boolean "Switch to turn on if using MSVC compiler instead of POSIX compliant compiler") 265 | (defconf :ldflags :string-array "Linker flags for OS libraries needed when compiling C/C++ artifacts") 266 | (defconf :lflags :string-array "Non-library linker flags when compiling C/C++ artifacts") 267 | (defconf :modext :string "File extension for shared objects") 268 | (defconf :statext :string "File extension for static libraries") 269 | (defconf :use-batch-shell :boolean "Switch to turn on if using the Batch shell on windows instead of POSIX shell") 270 | (defconf :janet-lflags :string-array "Link flags to pass when linking to libjanet") 271 | (defconf :janet-cflags :string-array "Compiler flags to pass when linking to libjanet") 272 | (defconf :janet-importlib :string-opt "Import library that lets native modules link to the host program (usually the interpreter)") 273 | 274 | # Settings that should probably only be set from the command line 275 | (defconf :auto-shebang :boolean "Automatically add a shebang line to installed janet scripts") 276 | (defconf :silent :boolean "Show less output than usually and silence output from subprocesses") 277 | (defconf :verbose :boolean "Show more ouput than usual and turn on warn flags in compilers") 278 | (defconf :workers :int-opt "The number of parallel workers to build with") 279 | (defconf :nocolor :boolean "Disables color in the debug repl") 280 | (defconf :test :boolean "Enable testing when installing.") 281 | (defconf :local :boolean "Switch to use a local tree ./jpm_tree instead of the config specified tree.") 282 | (defconf :tree :string-opt "Switch to use a custom tree instead of the config specified tree.") 283 | (defconf :dest-dir :string-opt "Prefix to add to installed files. Useful for bootstrapping.") 284 | (defconf :build-type :string-opt "A preset of options for debug, release, and develop builds." ["release" "debug" "develop"]) 285 | 286 | (set builtins-loaded true) 287 | -------------------------------------------------------------------------------- /jpm/dagbuild.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### dagbuild.janet 3 | ### 4 | ### A module for building files / running commands in an order. 5 | ### Building blocks for a Make-like build system. 6 | ### 7 | 8 | # 9 | # DAG Execution 10 | # 11 | 12 | (defn pmap 13 | "Function form of `ev/gather`. If any of the 14 | sibling fibers error, all other siblings will be canceled. 15 | Returns the gathered results in an array." 16 | [f data] 17 | (def chan (ev/chan)) 18 | (def res @[]) 19 | (def fibers 20 | (seq [[i x] :pairs data] 21 | (ev/go (fiber/new (fn pmap-worker [] (put res i (f x))) :tp) nil chan))) 22 | (repeat (length fibers) 23 | (def [sig fiber] (ev/take chan)) 24 | (unless (= sig :ok) 25 | (each f fibers (ev/cancel f "sibling canceled")) 26 | (propagate (fiber/last-value fiber) fiber))) 27 | res) 28 | 29 | (defn pdag 30 | "Executes a dag by calling f on every node in the graph. 31 | Can set the number of workers 32 | for parallel execution. The graph is represented as a table 33 | mapping nodes to arrays of child nodes. Each node will only be evaluated 34 | after all children have been evaluated. Returns a table mapping each node 35 | to the result of `(f node)`." 36 | [f dag &opt n-workers] 37 | 38 | # preprocess 39 | (def res @{}) 40 | (def seen @{}) 41 | (def q (ev/chan math/int32-max)) 42 | (def dep-counts @{}) 43 | (def inv @{}) 44 | (defn visit [node] 45 | (if (seen node) (break)) 46 | (put seen node true) 47 | (def depends-on (get dag node [])) 48 | (put dep-counts node (length depends-on)) 49 | (if (empty? depends-on) 50 | (ev/give q node)) 51 | (each r depends-on 52 | (put inv r (array/push (get inv r @[]) node)) 53 | (visit r))) 54 | (eachk r dag (visit r)) 55 | 56 | # run n workers in parallel 57 | (default n-workers (dyn :workers (max 1 (length seen)))) 58 | (assert (> n-workers 0)) 59 | (var short-circuit false) 60 | (defn worker [n] 61 | (while (next seen) 62 | (if short-circuit (break)) 63 | (def node (ev/take q)) 64 | (if-not node (break)) 65 | (when (in seen node) 66 | (put seen node nil) 67 | (def status (f node)) 68 | (case status 69 | :error (set short-circuit true) 70 | # default 71 | (put res node status))) 72 | (unless short-circuit 73 | (each r (get inv node []) 74 | (when (zero? (set (dep-counts r) (dec (get dep-counts r 1)))) 75 | (ev/give q r))))) 76 | (ev/give q nil)) 77 | 78 | (pmap worker (range n-workers)) 79 | (when short-circuit (error "build fail")) 80 | res) 81 | -------------------------------------------------------------------------------- /jpm/declare.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### Rule generation for adding native source code 3 | ### 4 | 5 | (use ./config) 6 | (use ./rules) 7 | (use ./shutil) 8 | (use ./cc) 9 | 10 | (defn- check-release 11 | [] 12 | (= "release" (dyn:build-type "release"))) 13 | 14 | (defn- dofile-codegen 15 | [in-path out-path] 16 | (with [f (file/open out-path :wbn)] 17 | (def env (make-env)) 18 | (put env :out f) 19 | (dofile in-path :env env))) 20 | 21 | (defn install-rule 22 | "Add install and uninstall rule for moving files from src into destdir." 23 | [src destdir] 24 | (unless (check-release) (break)) 25 | (def name (last (peg/match path-splitter src))) 26 | (def path (string destdir "/" name)) 27 | (array/push (dyn :installed-files) path) 28 | (def dir (string (dyn :dest-dir "") destdir)) 29 | (task "install" [] 30 | (os/mkdir dir) 31 | (copy src dir))) 32 | 33 | (defn install-file-rule 34 | "Add install and uninstall rule for moving file from src into destdir." 35 | [src dest] 36 | (unless (check-release) (break)) 37 | (array/push (dyn :installed-files) dest) 38 | (def dest1 (string (dyn :dest-dir "") dest)) 39 | (task "install" [] 40 | (copyfile src dest1))) 41 | 42 | (defn uninstall 43 | "Uninstall bundle named name" 44 | [name] 45 | (def manifest (find-manifest name)) 46 | (when-with [f (file/open manifest)] 47 | (def man (parse (:read f :all))) 48 | (each path (get man :paths []) 49 | (def path1 (string (dyn :dest-dir "") path)) 50 | (print "removing " path1) 51 | (rm path1)) 52 | (print "removing manifest " manifest) 53 | (:close f) # I hate windows 54 | (rm manifest) 55 | (print "Uninstalled."))) 56 | 57 | (defn declare-native 58 | "Declare a native module. This is a shared library that can be loaded 59 | dynamically by a janet runtime. This also builds a static libary that 60 | can be used to bundle janet code and native into a single executable." 61 | [&keys opts] 62 | (def sources (opts :source)) 63 | (def name (opts :name)) 64 | (def path (string (dyn:modpath) "/" (dirname name))) 65 | (def declare-targets @{}) 66 | 67 | (def modext (dyn:modext)) 68 | (def statext (dyn:statext)) 69 | (def importlibext (dyn :importlibext nil)) 70 | 71 | # Make dynamic module 72 | (def lname (string (find-build-dir) name modext)) 73 | 74 | # Get objects to build with 75 | (var has-cpp false) 76 | (def objects 77 | (seq [src :in sources] 78 | (def suffix 79 | (cond 80 | (string/has-suffix? ".cpp" src) ".cpp" 81 | (string/has-suffix? ".cc" src) ".cc" 82 | (string/has-suffix? ".c" src) ".c" 83 | (string/has-suffix? ".janet" src) ".janet" 84 | (errorf "unknown source file type: %s, expected .c, .cc, .cpp, or .janet" src))) 85 | (def op (out-path src suffix ".o")) 86 | (case suffix 87 | ".c" (compile-c :cc opts src op) 88 | ".janet" (do 89 | (create-dirs op) 90 | (def csrc (out-path src suffix ".c")) 91 | (rule csrc [src] (dofile-codegen src csrc)) 92 | (compile-c :cc opts csrc op)) 93 | (do (compile-c :c++ opts src op) 94 | (set has-cpp true))) 95 | op)) 96 | 97 | (when-let [embedded (opts :embedded)] 98 | (loop [src :in embedded] 99 | (def c-src (out-path src ".janet" ".janet.c")) 100 | (def o-src (out-path src ".janet" ".janet.o")) 101 | (array/push objects o-src) 102 | (create-buffer-c src c-src (embed-name src)) 103 | (compile-c :cc opts c-src o-src))) 104 | (link-c has-cpp opts lname ;objects) 105 | (put declare-targets :native lname) 106 | (add-dep "build" lname) 107 | (install-rule lname path) 108 | 109 | # Add meta file 110 | (def metaname (modpath-to-meta lname)) 111 | (def ename (entry-name name)) 112 | (rule metaname [] 113 | (print "generating meta file " metaname "...") 114 | (flush) 115 | (os/mkdir (find-build-dir)) 116 | (create-dirs metaname) 117 | (spit metaname (string/format 118 | "# Metadata for static library %s\n\n%.20p" 119 | (string name statext) 120 | {:static-entry ename 121 | :cpp has-cpp 122 | :ldflags ~',(opts :ldflags) 123 | :lflags ~',(opts :lflags)}))) 124 | (add-dep "build" metaname) 125 | (put declare-targets :meta metaname) 126 | (install-rule metaname path) 127 | 128 | # Make static module 129 | (unless (dyn :nostatic) 130 | (def sname (string (find-build-dir) name statext)) 131 | (def impname (if importlibext (string (find-build-dir) name importlibext) nil)) 132 | (def opts (merge @{:entry-name ename} opts)) 133 | (def sobjext ".static.o") 134 | (def sjobjext ".janet.static.o") 135 | 136 | # Get static objects 137 | (def sobjects 138 | (seq [src :in sources] 139 | (def suffix 140 | (cond 141 | (string/has-suffix? ".cpp" src) ".cpp" 142 | (string/has-suffix? ".cc" src) ".cc" 143 | (string/has-suffix? ".c" src) ".c" 144 | (string/has-suffix? ".janet" src) ".janet" 145 | (errorf "unknown source file type: %s, expected .c, .cc, .cpp, or .janet" src))) 146 | (def op (out-path src suffix sobjext)) 147 | (case suffix 148 | ".c" (compile-c :cc opts src op true) 149 | ".janet" (do 150 | (def csrc (out-path src suffix ".c")) 151 | (rule csrc [src] (dofile-codegen src csrc)) 152 | (compile-c :cc opts csrc op true)) 153 | (compile-c :c++ opts src op true)) 154 | # Add artificial dep between static object and non-static object - prevents double errors 155 | # when doing default builds. 156 | (add-dep op (out-path src suffix ".o")) 157 | op)) 158 | 159 | (when-let [embedded (opts :embedded)] 160 | (loop [src :in embedded] 161 | (def c-src (out-path src ".janet" ".janet.c")) 162 | (def o-src (out-path src ".janet" sjobjext)) 163 | (array/push sobjects o-src) 164 | # Buffer c-src is already declared by dynamic module 165 | (compile-c :cc opts c-src o-src true))) 166 | 167 | (archive-c opts sname ;sobjects) 168 | (when (check-release) 169 | (add-dep "build" sname)) 170 | (put declare-targets :static sname) 171 | (when impname 172 | (install-rule impname path)) 173 | (install-rule sname path)) 174 | 175 | declare-targets) 176 | 177 | (defn declare-source 178 | "Create Janet modules. This does not actually build the module(s), 179 | but registers them for packaging and installation. :source should be an 180 | array of files and directores to copy into JANET_MODPATH or JANET_PATH. 181 | :prefix can optionally be given to modify the destination path to be 182 | (string JANET_PATH prefix source)." 183 | [&keys {:source sources :prefix prefix}] 184 | (def path (string (dyn:modpath) (if prefix "/") prefix)) 185 | (if (bytes? sources) 186 | (install-rule sources path) 187 | (each s sources 188 | (install-rule s path)))) 189 | 190 | (defn declare-headers 191 | "Declare headers for a library installation. Installed headers can be used by other native 192 | libraries." 193 | [&keys {:headers headers :prefix prefix}] 194 | (def path (string (dyn:modpath) "/" (or prefix ""))) 195 | (if (bytes? headers) 196 | (install-rule headers path) 197 | (each h headers 198 | (install-rule h path)))) 199 | 200 | (defn declare-bin 201 | "Declare a generic file to be installed as an executable." 202 | [&keys {:main main}] 203 | (install-rule main (dyn:binpath))) 204 | 205 | (defn declare-executable 206 | "Declare a janet file to be the entry of a standalone executable program. The entry 207 | file is evaluated and a main function is looked for in the entry file. This function 208 | is marshalled into bytecode which is then embedded in a final executable for distribution.\n\n 209 | This executable can be installed as well to the --binpath given." 210 | [&keys {:install install :name name :entry entry :headers headers 211 | :cflags cflags :lflags lflags :deps deps :ldflags ldflags 212 | :no-compile no-compile :no-core no-core}] 213 | (def name (if (is-win-or-mingw) (string name ".exe") name)) 214 | (def dest (string (find-build-dir) name)) 215 | (create-executable @{:cflags cflags :lflags lflags :ldflags ldflags :no-compile no-compile} entry dest no-core) 216 | (if no-compile 217 | (let [cdest (string dest ".c")] 218 | (add-dep "build" cdest)) 219 | (do 220 | (add-dep "build" dest) 221 | (when headers 222 | (each h headers (add-dep dest h))) 223 | (when deps 224 | (each d deps (add-dep dest d))) 225 | (when install 226 | (install-rule dest (dyn:binpath)))))) 227 | 228 | (defn declare-binscript 229 | ``Declare a janet file to be installed as an executable script. Creates 230 | a shim on windows. If hardcode is true, will insert code into the script 231 | such that it will run correctly even when JANET_PATH is changed. if auto-shebang 232 | is truthy, will also automatically insert a correct shebang line. 233 | `` 234 | [&keys {:main main :hardcode-syspath hardcode :is-janet is-janet}] 235 | (def binpath (dyn:binpath)) 236 | (def auto-shebang (and is-janet (dyn:auto-shebang))) 237 | (if (or auto-shebang hardcode) 238 | (let [syspath (dyn:modpath)] 239 | (def parts (peg/match path-splitter main)) 240 | (def name (last parts)) 241 | (def path (string binpath "/" name)) 242 | (array/push (dyn :installed-files) path) 243 | (task "install" [] 244 | (def contents 245 | (with [f (file/open main :rbn)] 246 | (def first-line (:read f :line)) 247 | (def second-line (string/format "(put root-env :syspath %v)\n" syspath)) 248 | (def rest (:read f :all)) 249 | (string (if auto-shebang 250 | (string "#!" (dyn:binpath) "/janet\n")) 251 | first-line (if hardcode second-line) rest))) 252 | (def destpath (string (dyn :dest-dir "") path)) 253 | (create-dirs destpath) 254 | (print "installing " main " to " destpath) 255 | (spit destpath contents) 256 | (unless (is-win-or-mingw) (shell "chmod" "+x" destpath)))) 257 | (install-rule main binpath)) 258 | # Create a dud batch file when on windows. 259 | (when (is-win-or-mingw) 260 | (def name (last (peg/match path-splitter main))) 261 | (def fullname (string binpath "/" name)) 262 | (def bat (string "@echo off\r\ngoto #_undefined_# 2>NUL || title %COMSPEC% & janet \"" fullname "\" %*")) 263 | (def newname (string binpath "/" name ".bat")) 264 | (array/push (dyn :installed-files) newname) 265 | (task "install" [] 266 | (spit (string (dyn :dest-dir "") newname) bat)))) 267 | 268 | (defn declare-archive 269 | "Build a janet archive. This is a file that bundles together many janet 270 | scripts into a janet image. This file can the be moved to any machine with 271 | a janet vm and the required dependencies and run there." 272 | [&keys opts] 273 | (def entry (opts :entry)) 274 | (def name (opts :name)) 275 | (def iname (string (find-build-dir) name ".jimage")) 276 | (rule iname (or (opts :deps) []) 277 | (create-dirs iname) 278 | (spit iname (make-image (require entry)))) 279 | (def path (dyn:modpath)) 280 | (add-dep "build" iname) 281 | (install-rule iname path)) 282 | 283 | (defn declare-manpage 284 | "Mark a manpage for installation" 285 | [page] 286 | (when-let [mp (dyn :manpath)] 287 | (install-rule page mp))) 288 | 289 | (defn run-tests 290 | "Run tests on a project in the current directory. The tests will 291 | be run in the environment dictated by (dyn :modpath)." 292 | [&opt root-directory] 293 | (var errors-found 0) 294 | (defn dodir 295 | [dir] 296 | (each sub (sort (os/dir dir)) 297 | (def ndir (string dir "/" sub)) 298 | (case (os/stat ndir :mode) 299 | :file (when (string/has-suffix? ".janet" ndir) 300 | (print "running " ndir " ...") 301 | (flush) 302 | (def result (run-script ndir)) 303 | (when (not= 0 result) 304 | (++ errors-found) 305 | (eprinf (color :red "non-zero exit code in %s: ") ndir) 306 | (eprintf "%d" result))) 307 | :directory (dodir ndir)))) 308 | (dodir (or root-directory "test")) 309 | (if (zero? errors-found) 310 | (print (color :green "✓ All tests passed.")) 311 | (do 312 | (prin (color :red "✘ Failing test scripts: ")) 313 | (printf "%d" errors-found) 314 | (os/exit 1))) 315 | (flush)) 316 | 317 | (defn declare-project 318 | "Define your project metadata. This should 319 | be the first declaration in a project.janet file. 320 | Also sets up basic task targets like clean, build, test, etc." 321 | [&keys meta] 322 | (setdyn :project (struct/to-table meta)) 323 | 324 | (def installed-files @[]) 325 | (def manifests (find-manifest-dir)) 326 | (def manifest (find-manifest (meta :name))) 327 | (setdyn :manifest manifest) 328 | (setdyn :manifest-dir manifests) 329 | (setdyn :installed-files installed-files) 330 | 331 | (task "build" []) 332 | 333 | (unless (check-release) 334 | (task "install" [] 335 | (print "The install target is only enabled for release builds.") 336 | (os/exit 1))) 337 | 338 | (when (check-release) 339 | 340 | (task "manifest" [manifest]) 341 | (rule manifest ["uninstall"] 342 | (print "generating " manifest "...") 343 | (flush) 344 | (os/mkdir manifests) 345 | (def has-git (os/stat ".git" :mode)) 346 | (def bundle-type (dyn :bundle-type (if has-git :git :local))) 347 | (def man 348 | @{:dependencies (array/slice (get meta :dependencies [])) 349 | :version (get meta :version "0.0.0") 350 | :paths installed-files 351 | :type bundle-type}) 352 | (case bundle-type 353 | :git 354 | (do 355 | (if-let [shallow (dyn :shallow)] 356 | (put man :shallow shallow)) 357 | (protect 358 | (if-let [x (exec-slurp (dyn:gitpath) "remote" "get-url" "origin")] 359 | (put man :url (if-not (empty? x) x)))) 360 | (protect 361 | (if-let [x (exec-slurp (dyn:gitpath) "rev-parse" "HEAD")] 362 | (put man :tag (if-not (empty? x) x))))) 363 | :tar 364 | (do 365 | (put man :url (slurp ".bundle-tar-url"))) 366 | :local nil 367 | (errorf "unknown bundle type %v" bundle-type)) 368 | (spit manifest (string/format "%j\n" (table/to-struct man)))) 369 | 370 | (task "install" ["uninstall" "build" manifest] 371 | (when (dyn :test) 372 | (run-tests)) 373 | (print "Installed as '" (meta :name) "'.") 374 | (flush)) 375 | 376 | (task "uninstall" [] 377 | (uninstall (meta :name)))) 378 | 379 | (task "clean" [] 380 | # cut off trailing path separator (needed in msys2) 381 | (def bd (string/slice (find-build-dir) 0 -2)) 382 | (when (os/stat bd :mode) 383 | (rm bd) 384 | (print "Deleted build directory " bd) 385 | (flush))) 386 | 387 | (task "test" ["build"] 388 | (run-tests))) 389 | -------------------------------------------------------------------------------- /jpm/default-config.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### default-config.janet 3 | ### 4 | ### This will be replaced during installation. 5 | 6 | (def config @{}) 7 | -------------------------------------------------------------------------------- /jpm/init.janet: -------------------------------------------------------------------------------- 1 | (def version "0.0.1") 2 | 3 | (import ./cc :export true) 4 | (import ./cgen :export true) 5 | (import ./commands :export true) 6 | (import ./config :export true) 7 | (import ./dagbuild :export true) 8 | (import ./default-config :export true) 9 | (import ./pm :export true) 10 | (import ./rules :export true) 11 | (import ./shutil :export true) 12 | (import ./make-config :export true) 13 | (import ./scaffold :export true) 14 | 15 | # (import ./cli :export true) - we don't need cli/ when using programmatically 16 | -------------------------------------------------------------------------------- /jpm/jpm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env janet 2 | (import jpm/cli) 3 | # Reset the syspath after overriding 4 | (put root-env :syspath (os/getenv "JANET_PATH" (dyn :syspath))) 5 | (defn main [& argv] 6 | (cli/main ;argv)) 7 | -------------------------------------------------------------------------------- /jpm/make-config.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### Generation of jpm config files based on autodetection. 3 | ### 4 | 5 | (import ./shutil) 6 | 7 | (defn generate-config 8 | "Make a pretty good configuration file for the current target. Returns a buffer with config source contents. 9 | If `destdir` is given, will generate the folders needed to create a jpm tree." 10 | [&opt destdir silent as-data] 11 | 12 | (def hostos (os/which)) 13 | (def iswin (= :windows hostos)) 14 | (def ismingw (= :mingw hostos)) 15 | (def win-prefix (os/getenv "JANET_WINDOWS_PREFIX")) 16 | 17 | # Msys2 can do some strange things to paths. Using /usr/local directly may _appear_ to work, 18 | # but there is some functionality to rewrite paths like /usr/local/bin/jpm to C:\\msys64\\usr\\local\\bin\\jpm 19 | # in some places, where in others it will be converted to D:\\usr\\local\\bin\\jpm 20 | (def prefix-guess 21 | (let [de (dyn :executable) 22 | suffix-win "\\bin\\janet.exe" 23 | suffix-posix "/bin/janet"] 24 | (cond 25 | (string/has-suffix? suffix-win de) (string/replace-all "\\" "/" (string/slice de 0 (- -1 (length suffix-win)))) 26 | (string/has-suffix? suffix-posix de) (string/slice de 0 (- -1 (length suffix-posix))) 27 | "/usr/local"))) 28 | 29 | (def prefix (dyn :prefix (os/getenv "JANET_PREFIX" (os/getenv "PREFIX" prefix-guess)))) 30 | 31 | # Inherit from dyns and env variables 32 | (def pkglist (dyn :pkglist (os/getenv "JANET_PKGLIST" "https://github.com/janet-lang/pkgs.git"))) 33 | (def manpath (dyn :manpath (os/getenv "JANET_MANPATH" (if win-prefix 34 | (string win-prefix "/docs") 35 | (string prefix "/share/man/man1"))))) 36 | (def headerpath (dyn :headerpath (os/getenv "JANET_HEADERPATH" (if win-prefix 37 | (string win-prefix "/C") 38 | (string prefix "/include/janet"))))) 39 | (def binpath (dyn :binpath (os/getenv "JANET_BINPATH" (if win-prefix 40 | (string win-prefix "/bin") 41 | (string prefix "/bin"))))) 42 | (def libpath (dyn :libpath (os/getenv "JANET_LIBPATH" (if win-prefix 43 | (string win-prefix "/C") 44 | (string prefix "/lib"))))) 45 | (def fix-modpath (dyn :fix-modpath (os/getenv "JANET_STRICT_MODPATH"))) 46 | (def modpath (dyn :modpath (os/getenv "JANET_MODPATH" (if fix-modpath 47 | (if win-prefix 48 | (string win-prefix "/Library") 49 | (string prefix "/lib/janet")))))) 50 | 51 | # Generate directories 52 | (when destdir 53 | (let [mp (or modpath (dyn :syspath))] 54 | (shutil/create-dirs (string destdir mp "/.manifests")) 55 | (when manpath (shutil/create-dirs (string destdir manpath))) 56 | (when binpath (shutil/create-dirs (string destdir binpath))) 57 | (when libpath (shutil/create-dirs (string destdir libpath))) 58 | (when headerpath (shutil/create-dirs (string destdir headerpath))))) 59 | 60 | (unless silent 61 | (when destdir (print "destdir: " destdir)) 62 | (print "Using install prefix: " (if win-prefix win-prefix prefix)) 63 | (print "binpath: " binpath) 64 | (print "libpath: " libpath) 65 | (print "manpath: " manpath) 66 | (print "headerpath: " headerpath) 67 | (print "modpath: " (or modpath "(default to JANET_PATH at runtime)")) 68 | (print "Setting package listing: " pkglist)) 69 | 70 | # Write the config to a temporary file if not provided 71 | (def config 72 | @{:ar (if iswin "lib.exe" "ar") 73 | :auto-shebang true 74 | :binpath binpath 75 | :c++ (if iswin "cl.exe" "c++") 76 | :c++-link (if iswin "link.exe" "c++") 77 | :cc (if iswin "cl.exe" "cc") 78 | :cc-link (if iswin "link.exe" "cc") 79 | :cflags (if iswin @["/nologo" "/MD"] @["-std=c99"]) 80 | :cppflags (if iswin @["/nologo" "/MD" "/EHsc"] @["-std=c++11"]) 81 | :cflags-verbose @[] 82 | :curlpath "curl" 83 | :dynamic-cflags (case hostos 84 | :windows @["/LD"] 85 | @["-fPIC"]) 86 | :dynamic-lflags (case hostos 87 | :windows @["/DLL"] 88 | :macos @["-shared" "-undefined" "dynamic_lookup" "-lpthread"] 89 | :mingw @["-shared"] 90 | @["-shared" "-lpthread"]) 91 | :gitpath "git" 92 | :headerpath headerpath 93 | :is-msvc iswin 94 | :janet "janet" 95 | :janet-cflags @[] 96 | :janet-lflags (case hostos 97 | :linux @["-lm" "-ldl" "-lrt" "-pthread" "-rdynamic"] 98 | :macos @["-lm" "-ldl" "-pthread" "-Wl,-export_dynamic"] 99 | :mingw @["-lws2_32" "-lwsock32" "-lpsapi"] 100 | :windows @[] 101 | @["-lm" "-pthread"]) 102 | :janet-importlib (case hostos 103 | :windows (string headerpath "\\janet.lib") 104 | :mingw (string libpath "/janet.lib")) 105 | :ldflags @[] 106 | :lflags (case hostos 107 | :windows @["/nologo"] 108 | @[]) 109 | :libpath libpath 110 | :manpath manpath 111 | :modext (if (shutil/is-win-or-mingw) ".dll" ".so") 112 | :modpath modpath 113 | :nocolor false 114 | :pkglist pkglist 115 | :silent false 116 | :importlibext (if (shutil/is-win-or-mingw) ".lib" nil) 117 | :statext (if (shutil/is-win-or-mingw) ".static.lib" ".a") 118 | :tarpath "tar" 119 | :test false 120 | :use-batch-shell iswin 121 | :verbose false}) 122 | 123 | (if as-data 124 | config 125 | (do 126 | # Sanity check for recursive data 127 | (def buf @"") 128 | (buffer/format buf "%j" config) 129 | (buffer/clear buf) 130 | (def output (buffer/format buf "# Autogenerated by generate-config in jpm/make-config.janet\n(def config %.99m)" config)) 131 | output))) 132 | 133 | (defn auto 134 | "Get an autodetected config." 135 | [] 136 | (generate-config nil true true)) 137 | -------------------------------------------------------------------------------- /jpm/pm.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### Package management functionality 3 | ### 4 | 5 | (use ./config) 6 | (use ./shutil) 7 | (use ./rules) 8 | 9 | (defn- proto-flatten 10 | [into x] 11 | (when x 12 | (proto-flatten into (table/getproto x)) 13 | (merge-into into x)) 14 | into) 15 | 16 | (def- mod-rules (require "./rules")) 17 | (def- mod-shutil (require "./shutil")) 18 | (def- mod-cc (require "./cc")) 19 | (def- mod-cgen (require "./cgen")) 20 | (def- mod-declare (require "./declare")) 21 | (def- mod-make-config (require "./make-config")) 22 | (def- mod-pm (curenv)) 23 | 24 | (defn make-jpm-env 25 | "Create an environment that is preloaded with jpm symbols." 26 | [&opt base-env] 27 | (def envs-to-add 28 | [mod-declare 29 | mod-shutil 30 | mod-rules 31 | mod-cc 32 | mod-cgen 33 | mod-pm 34 | mod-make-config]) 35 | (def env (make-env)) 36 | (loop [e :in envs-to-add 37 | k :keys e :when (symbol? k) 38 | :let [x (get e k)]] 39 | (unless (get x :private) 40 | (put env k x))) 41 | (def currenv (proto-flatten @{} (curenv))) 42 | (loop [k :keys currenv :when (keyword? k)] 43 | (put env k (currenv k))) 44 | # For compatibility reasons 45 | (when base-env 46 | (merge-into env base-env)) 47 | (put env 'default-cflags @{:value (dyn:cflags)}) 48 | (put env 'default-lflags @{:value (dyn:lflags)}) 49 | (put env 'default-ldflags @{:value (dyn:ldflags)}) 50 | (put env 'default-cppflags @{:value (dyn:cppflags)}) 51 | (put env :syspath (dyn:modpath)) 52 | env) 53 | 54 | (defn require-jpm 55 | "Require a jpm file project file. This is different from a normal require 56 | in that code is loaded in the jpm environment." 57 | [path &opt base-env] 58 | (unless (os/stat path :mode) 59 | (error (string "cannot open " path))) 60 | (def env (make-jpm-env base-env)) 61 | (dofile path :env env :exit true) 62 | env) 63 | 64 | (defn load-project-meta 65 | "Load the metadata from a project.janet file without doing a full evaluation 66 | of the project.janet file. Returns a struct with the project metadata. Raises 67 | an error if no metadata found." 68 | [&opt path] 69 | (default path "./project.janet") 70 | (def src (slurp path)) 71 | (def p (parser/new)) 72 | (parser/consume p src) 73 | (parser/eof p) 74 | (var ret nil) 75 | (while (parser/has-more p) 76 | (if ret (break)) 77 | (def item (parser/produce p)) 78 | (match item 79 | ['declare-project & rest] (set ret (struct ;rest)))) 80 | (unless ret 81 | (errorf "no metadata found in %s" path)) 82 | ret) 83 | 84 | (defn import-rules 85 | "Import another file that defines more rules. This ruleset 86 | is merged into the current ruleset." 87 | [path &opt base-env] 88 | (def env (require-jpm path base-env)) 89 | (when-let [rules (get env :rules)] (merge-into (getrules) rules)) 90 | (when-let [project (get env :project)] 91 | (setdyn :project (merge-into (dyn :project @{}) project))) 92 | env) 93 | 94 | (defn git 95 | "Make a call to git." 96 | [& args] 97 | (shell (dyn:gitpath) ;args)) 98 | 99 | (defn tar 100 | "Make a call to tar." 101 | [& args] 102 | (shell (dyn:tarpath) ;args)) 103 | 104 | (defn curl 105 | "Make a call to curl" 106 | [& args] 107 | (shell (dyn:curlpath) ;args)) 108 | 109 | (var- bundle-install-recursive nil) 110 | 111 | (defn- resolve-bundle-name 112 | "Convert short bundle names to full tables." 113 | [bname] 114 | (if-not (string/find ":" bname) 115 | (let [pkgs (try 116 | (require "pkgs") 117 | ([err] 118 | (bundle-install-recursive (dyn:pkglist)) 119 | (require "pkgs"))) 120 | url (get-in pkgs ['packages :value (symbol bname)])] 121 | (unless url 122 | (error (string "bundle " bname " not found."))) 123 | url) 124 | bname)) 125 | 126 | (defn resolve-bundle 127 | "Convert any bundle string/table to the normalized table form." 128 | [bundle] 129 | (var repo nil) 130 | (var tag nil) 131 | (var btype :git) 132 | (var shallow false) 133 | (if (dictionary? bundle) 134 | (do 135 | (set repo (or (get bundle :url) (get bundle :repo))) 136 | (set tag (or (get bundle :tag) (get bundle :sha) (get bundle :commit) (get bundle :ref))) 137 | (set btype (get bundle :type :git)) 138 | (set shallow (get bundle :shallow false))) 139 | (let [parts (string/split "::" bundle)] 140 | (case (length parts) 141 | 1 (set repo (get parts 0)) 142 | 2 (do (set repo (get parts 1)) (set btype (keyword (get parts 0)))) 143 | 3 (do 144 | (set btype (keyword (get parts 0))) 145 | (set repo (get parts 1)) 146 | (set tag (get parts 2))) 147 | (errorf "unable to parse bundle string %v" bundle)))) 148 | {:url (resolve-bundle-name repo) :tag tag :type btype :shallow shallow}) 149 | 150 | (defn update-git-bundle 151 | "Fetch latest tag version from remote repository" 152 | [bundle-dir tag shallow] 153 | (if shallow 154 | (git "-C" bundle-dir "fetch" "--depth" "1" "origin" (or tag "HEAD")) 155 | (do 156 | # Tag can be a hash, e.g. in lockfile. Some Git servers don't allow 157 | # fetching arbitrary objects by hash. First fetch ensures, that we have 158 | # all objects locally. 159 | (git "-C" bundle-dir "fetch" "--tags" "origin") 160 | (git "-C" bundle-dir "fetch" "origin" (or tag "HEAD")))) 161 | (git "-C" bundle-dir "reset" "--hard" "FETCH_HEAD")) 162 | 163 | (defn download-git-bundle 164 | "Download a git bundle from a remote respository" 165 | [bundle-dir url tag shallow] 166 | (var fresh false) 167 | (if (dyn :offline) 168 | (if (not= :directory (os/stat bundle-dir :mode)) 169 | (error (string "did not find cached repository for dependency " url)) 170 | (set fresh true)) 171 | (when (os/mkdir bundle-dir) 172 | (set fresh true) 173 | (git "-c" "init.defaultBranch=master" "-C" bundle-dir "init") 174 | (git "-C" bundle-dir "remote" "add" "origin" url) 175 | (update-git-bundle bundle-dir tag shallow))) 176 | (unless (or (dyn :offline) fresh) 177 | (update-git-bundle bundle-dir tag shallow)) 178 | (unless (dyn :offline) 179 | (git "-C" bundle-dir "submodule" "update" "--init" "--recursive"))) 180 | 181 | (defn download-tar-bundle 182 | "Download a dependency from a tape archive. The archive should have exactly one 183 | top level directory that contains the contents of the project." 184 | [bundle-dir url &opt force-gz] 185 | (def has-gz (string/has-suffix? "gz" url)) 186 | (def is-remote (string/find ":" url)) 187 | (def dest-archive (if is-remote (string bundle-dir "/bundle-archive." (if has-gz "tar.gz" "tar")) url)) 188 | (os/mkdir bundle-dir) 189 | (when is-remote 190 | (curl "-sL" url "--output" dest-archive)) 191 | (spit (string bundle-dir "/.bundle-tar-url") url) 192 | (def tar-flags (if has-gz "-xzf" "-xf")) 193 | (tar tar-flags dest-archive "--strip-components=1" "-C" bundle-dir)) 194 | 195 | (defn download-bundle 196 | "Download the package source (using git) to the local cache. Return the 197 | path to the downloaded or cached soure code." 198 | [url bundle-type &opt tag shallow] 199 | (def cache (find-cache)) 200 | (os/mkdir cache) 201 | (def id (filepath-replace (string bundle-type "_" tag "_" url))) 202 | (def bundle-dir (string cache "/" id)) 203 | (case bundle-type 204 | :git (download-git-bundle bundle-dir url tag shallow) 205 | :tar (download-tar-bundle bundle-dir url) 206 | (errorf "unknown bundle type %v" bundle-type)) 207 | bundle-dir) 208 | 209 | (var- installed-bundle-index nil) 210 | (defn is-bundle-installed 211 | "Determines if a bundle has been installed or not" 212 | [bundle] 213 | # initialize bundle index 214 | (unless installed-bundle-index 215 | (set installed-bundle-index @{}) 216 | (os/mkdir (find-manifest-dir)) 217 | (each manifest (os/dir (find-manifest-dir)) 218 | (def bundle-data (parse (slurp (string (find-manifest-dir) "/" manifest)))) 219 | (def {:url u :repo r :tag s :type t :shallow a} bundle-data) 220 | (put installed-bundle-index (or u r) {:tag s 221 | :type t 222 | :shallow (not (nil? a))}))) 223 | (when-let [installed-bundle (get installed-bundle-index (bundle :url))] 224 | (def {:type bt :tag bs} bundle) 225 | (def {:type it :tag is} installed-bundle) 226 | (and 227 | (or (not bt) (= bt it)) 228 | (or (not bs) (= bs is))))) 229 | 230 | (defn bundle-install 231 | "Install a bundle from a git repository." 232 | [bundle &opt no-deps force-update] 233 | (def bundle (resolve-bundle bundle)) 234 | (when (or (not (is-bundle-installed bundle)) force-update) 235 | (def {:url url 236 | :tag tag 237 | :type bundle-type 238 | :shallow shallow} 239 | bundle) 240 | (def bdir (download-bundle url bundle-type tag shallow)) 241 | (def olddir (os/cwd)) 242 | (defer (os/cd olddir) 243 | (os/cd bdir) 244 | (with-dyns [:rules @{} 245 | :bundle-type (or bundle-type :git) 246 | :shallow shallow 247 | :buildpath "build/" # reset build path to default 248 | :modpath (abspath (dyn:modpath)) 249 | :workers (dyn :workers) 250 | :headerpath (abspath (dyn:headerpath)) 251 | :libpath (abspath (dyn:libpath)) 252 | :binpath (abspath (dyn:binpath))] 253 | (def dep-env (require-jpm "./project.janet" @{:jpm-no-deps true})) 254 | (unless no-deps 255 | (def meta (dep-env :project)) 256 | (if-let [deps (meta :dependencies)] 257 | (each dep deps 258 | (bundle-install dep)))) 259 | (each r ["build" "install"] 260 | (build-rules (get dep-env :rules {}) [r])) 261 | (put installed-bundle-index url bundle))))) 262 | 263 | (set bundle-install-recursive bundle-install) 264 | 265 | (defn make-lockfile 266 | [&opt filename] 267 | (default filename "lockfile.jdn") 268 | (def cwd (os/cwd)) 269 | (def packages @[]) 270 | # Read installed modules from manifests 271 | (def mdir (find-manifest-dir)) 272 | (each man (os/dir mdir) 273 | (def package (parse (slurp (string mdir "/" man)))) 274 | (if (and (dictionary? package) (or (package :url) (package :repo))) 275 | (array/push packages package) 276 | (print "Cannot add local or malformed package " mdir "/" man " to lockfile, skipping..."))) 277 | 278 | # Scramble to simulate runtime randomness (when trying to repro, order can 279 | # be remarkable stable) - see janet-lang/janet issue #1082 280 | # (def rand-thing (string (os/cryptorand 16))) 281 | # (sort-by |(hash [rand-thing (get $ :url)]) packages) 282 | 283 | # Sort initially by package url to make stable 284 | (sort-by |[(get $ :url) (get $ :repo)] packages) 285 | 286 | # Put in correct order, such that a package is preceded by all of its dependencies 287 | (def ordered-packages @[]) 288 | (def resolved @{}) 289 | (while (< (length ordered-packages) (length packages)) 290 | (print "step") 291 | (var made-progress false) 292 | (each p packages 293 | (def {:url u :repo r :tag s :dependencies d :type t :shallow a} p) 294 | (def key (in (resolve-bundle p) :url)) 295 | (def dep-bundles (map |(in (resolve-bundle $) :url) d)) 296 | (unless (resolved key) 297 | (when (all resolved dep-bundles) 298 | (print "item: " (or u r)) 299 | (array/push ordered-packages {:url (or u r) :tag s :type t :shallow a}) 300 | (set made-progress true) 301 | (put resolved key true)))) 302 | (unless made-progress 303 | (error (string/format "could not resolve package order for: %j" 304 | (filter (complement resolved) (map |(or ($ :url) ($ :repo)) packages)))))) 305 | # Write to file, manual format for better diffs. 306 | (with [f (file/open filename :wn)] 307 | (with-dyns [:out f] 308 | (prin "@[") 309 | (eachk i ordered-packages 310 | (unless (zero? i) 311 | (prin "\n ")) 312 | (prinf "%j" (ordered-packages i))) 313 | (print "]"))) 314 | (print "created " filename)) 315 | 316 | (defn load-lockfile 317 | "Load packages from a lockfile." 318 | [&opt filename] 319 | (default filename "lockfile.jdn") 320 | (def lockarray (parse (slurp filename))) 321 | (each bundle lockarray 322 | (bundle-install bundle true))) 323 | 324 | (defmacro post-deps 325 | "Run code at the top level if jpm dependencies are installed. Build 326 | code that imports dependencies should be wrapped with this macro, as project.janet 327 | needs to be able to run successfully even without dependencies installed." 328 | [& body] 329 | (unless (dyn :jpm-no-deps) 330 | ~',(reduce |(eval $1) nil body))) 331 | 332 | (defn do-rule 333 | "Evaluate a given rule in a one-off manner." 334 | [target] 335 | (build-rules (dyn :rules) [target] (dyn :workers))) 336 | 337 | (defn update-installed 338 | "Update all previously installed packages to their latest versions." 339 | [] 340 | (def to-update (os/dir (find-manifest-dir))) 341 | (var updated-count 0) 342 | (each p to-update 343 | (def bundle-data (parse (slurp (string (find-manifest-dir) "/" p)))) 344 | (def new-bundle (merge-into @{} bundle-data)) 345 | (put new-bundle :tag nil) 346 | (try 347 | (do 348 | (bundle-install new-bundle true true) 349 | (++ updated-count)) 350 | ([err f] 351 | (debug/stacktrace f err (string "unable to update dependency " p ": "))))) 352 | (print "updated " updated-count " of " (length to-update) " installed packages") 353 | (unless (= updated-count (length to-update)) 354 | (error "could not update all installed packages"))) 355 | 356 | (defn out-of-tree-config 357 | "Create an out of tree build configuration. This lets a user have a debug or release build, as well 358 | as other configuration on a one time basis. This works by creating a new directory with 359 | a project.janet that loads in the original project.janet file with some settings changed." 360 | [path &opt options] 361 | (def current (abspath (os/cwd))) 362 | (def options (merge-into @{} options)) 363 | (def new-build-path (string path "/build/")) 364 | (put options :buildpath new-build-path) 365 | (def dest (string path "/project.janet")) 366 | (def odest (string path "/options.janet")) 367 | (print "creating out of tree build at " (abspath path)) 368 | (create-dirs dest) 369 | (spit odest 370 | (string/join 371 | (map |(string/format "(setdyn %v %j)" ($ 0) ($ 1)) 372 | (sorted (pairs options))) 373 | "\n")) 374 | (spit dest 375 | (string/format 376 | ``` 377 | (os/cd %v) 378 | (import-rules "./project.janet") 379 | ``` 380 | current))) 381 | -------------------------------------------------------------------------------- /jpm/rules.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### Rule implementation 3 | ### 4 | ### Also contains wrappers to more easily define rules in an 5 | ### incremental manner. 6 | ### 7 | 8 | (import ./dagbuild) 9 | (import ./shutil) 10 | 11 | (defn- executor 12 | "How to execute a rule at runtime - 13 | extract the recipe thunk(s) and call them." 14 | [rule] 15 | (when-let [r (get rule :recipe)] 16 | (def no-print-errors (get rule :no-print-errors)) 17 | (try 18 | (do 19 | (if (indexed? r) 20 | (each rr r (rr)) 21 | (r)) 22 | :built) 23 | # On errors, ensure that none of the output file for this rule 24 | # are kept. 25 | ([err fib] 26 | (unless no-print-errors 27 | (if (dyn :verbose) 28 | (debug/stacktrace fib err "error: ") 29 | (eprint "error: " err))) 30 | (each o (get rule :outputs []) 31 | (protect (shutil/rm o))) 32 | :error)))) 33 | 34 | (defn- target-not-found 35 | "Creates an error message." 36 | [target] 37 | (errorf "target %v does not exist and no rule exists to build it" target)) 38 | 39 | (defn- target-already-defined 40 | "Error when an output already has a rule defined to create it." 41 | [target] 42 | (errorf "target %v has multiple rules" target)) 43 | 44 | (defn- utd 45 | "Check if a target is up to date. 46 | Inputs are guaranteed to already be in the utd-cache." 47 | [target all-targets utd-cache] 48 | (def rule (get all-targets target)) 49 | (if (= target (get rule :task)) (break false)) 50 | (def mtime (os/stat target :modified)) 51 | (if-not rule (break (or mtime (target-not-found target)))) 52 | (if (not mtime) (break false)) 53 | (var ret true) 54 | (each i (get rule :inputs []) 55 | (if-not (get utd-cache i) (break (set ret false))) 56 | (def s (os/stat i :modified)) 57 | (when (or (not s) (< mtime s)) 58 | (set ret false) 59 | (break))) 60 | ret) 61 | 62 | (defn build-rules 63 | "Given a graph of all rules, extract a work graph that will build out-of-date 64 | files." 65 | [rules targets &opt n-workers] 66 | (def dag @{}) 67 | (def utd-cache @{}) 68 | (def all-targets @{}) 69 | (def seen @{}) 70 | (each rule (distinct rules) 71 | (when-let [p (get rule :task)] 72 | (when (get all-targets p) (target-already-defined p)) 73 | (put all-targets p rule)) 74 | (each o (get rule :outputs []) 75 | (when (get all-targets o) (target-already-defined o)) 76 | (put all-targets o rule))) 77 | 78 | (defn utd1 79 | [target] 80 | (def u (get utd-cache target)) 81 | (if (not= nil u) 82 | u 83 | (set (utd-cache target) (utd target all-targets utd-cache)))) 84 | 85 | (defn visit [target] 86 | (if (in seen target) (break)) 87 | (put seen target true) 88 | (def rule (get all-targets target)) 89 | (def inputs (get rule :inputs [])) 90 | (each i inputs 91 | (visit i)) 92 | (def u (utd1 target)) 93 | (unless u 94 | (def deps (set (dag rule) (get dag rule @[]))) 95 | (each i inputs 96 | (unless (utd1 i) 97 | (if-let [r (get all-targets i)] 98 | (array/push deps r)))))) 99 | 100 | (each t targets (visit t)) 101 | (dagbuild/pdag executor dag n-workers)) 102 | 103 | # 104 | # Convenience wrappers for defining a rule graph. 105 | # Must be mostly compatible with old jpm interface. 106 | # Main differences are multiple outputs for a rule are allowed, 107 | # and a rule cannot have both phony and non-phony thunks. 108 | # 109 | 110 | (defn getrules [] 111 | (if-let [targets (dyn :rules)] targets (setdyn :rules @{}))) 112 | 113 | (defn- gettarget [target] 114 | (def item ((getrules) target)) 115 | (unless item (error (string "no rule for target '" target "'"))) 116 | item) 117 | 118 | (defn- target-append 119 | [target key v] 120 | (def item (gettarget target)) 121 | (def vals (get item key)) 122 | (unless (find |(= v $) vals) 123 | (array/push vals v)) 124 | item) 125 | 126 | (defn add-input 127 | "Add a dependency to an existing rule. Useful for extending phony 128 | rules or extending the dependency graph of existing rules." 129 | [target input] 130 | (target-append target :inputs input)) 131 | 132 | (defn add-dep 133 | "Alias for `add-input`" 134 | [target dep] 135 | (target-append target :inputs dep)) 136 | 137 | (defn add-output 138 | "Add an output file to an existing rule. Rules can contain multiple 139 | outputs, but are still referred to by a main target name." 140 | [target output] 141 | (target-append target :outputs output)) 142 | 143 | (defn add-thunk 144 | "Append a thunk to a target's recipe." 145 | [target thunk] 146 | (target-append target :recipe thunk)) 147 | 148 | (defn- rule-impl 149 | [target deps thunk &opt phony] 150 | (def all-targets (if (indexed? target) target [target])) 151 | (def target (if (indexed? target) (first target) target)) 152 | (def targets (getrules)) 153 | (unless (get targets target) 154 | (def new-rule 155 | @{:task (if phony target) 156 | :inputs @[] 157 | :outputs @[] 158 | :recipe @[]}) 159 | (put targets target new-rule)) 160 | (each d deps (add-input target d)) 161 | (unless phony 162 | (each t all-targets (add-output target t))) 163 | (add-thunk target thunk)) 164 | 165 | (defmacro rule 166 | "Add a rule to the rule graph." 167 | [target deps & body] 168 | ~(,rule-impl ,target ,deps (fn [] nil ,;body))) 169 | 170 | (defmacro task 171 | "Add a task rule to the rule graph. A task rule will always run if invoked 172 | (it is always considered out of date)." 173 | [target deps & body] 174 | ~(,rule-impl ,target ,deps (fn [] nil ,;body) true)) 175 | 176 | (defmacro phony 177 | "Alias for `task`." 178 | [target deps & body] 179 | ~(,rule-impl ,target ,deps (fn [] nil ,;body) true)) 180 | 181 | (defmacro sh-rule 182 | "Add a rule that invokes a shell command, and fails if the command returns non-zero." 183 | [target deps & body] 184 | ~(,rule-impl ,target ,deps (fn [] (,shutil/shell (,string ,;body))))) 185 | 186 | (defmacro sh-task 187 | "Add a task that invokes a shell command, and fails if the command returns non-zero." 188 | [target deps & body] 189 | ~(,rule-impl ,target ,deps (fn [] (,shutil/shell (,string ,;body))) true)) 190 | 191 | (defmacro sh-phony 192 | "Alias for `sh-task`." 193 | [target deps & body] 194 | ~(,rule-impl ,target ,deps (fn [] (,shutil/shell (,string ,;body))) true)) 195 | 196 | (defmacro add-body 197 | "Add recipe code to an existing rule. This makes existing rules do more but 198 | does not modify the dependency graph." 199 | [target & body] 200 | ~(,add-thunk ,target (fn [] ,;body))) 201 | -------------------------------------------------------------------------------- /jpm/scaffold.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### Project scaffolding 3 | ### 4 | ### Generate new projects quickly. 5 | ### 6 | 7 | (def- template-peg 8 | "Extract string pieces to generate a templating function" 9 | (peg/compile 10 | ~{:sub (group 11 | (+ (* "${" '(to "}") "}") 12 | (* "$" '(some (range "az" "AZ" "09" "__" "--"))))) 13 | :main (any (* '(to (+ "$$" -1 :sub)) (+ '"$$" :sub 0)))})) 14 | 15 | (defn- make-template 16 | "Make a simple string template as defined by Python PEP292 (shell-like $ substitution). 17 | Also allows dashes in indentifiers." 18 | [source] 19 | (def frags (peg/match template-peg source)) 20 | (def partitions (partition-by type frags)) 21 | (def string-args @[]) 22 | (each chunk partitions 23 | (case (type (get chunk 0)) 24 | :string (array/push string-args (string ;chunk)) 25 | :array (each sym chunk 26 | (array/push string-args ~(,get opts ,(keyword (first sym))))))) 27 | ~(fn [opts] (,string ,;string-args))) 28 | 29 | (defmacro- deftemplate 30 | "Define a template inline" 31 | [template-name body] 32 | ~(def ,template-name :private ,(make-template body))) 33 | 34 | (defn- opt-ask 35 | "Ask user for input" 36 | [key input-options] 37 | (def dflt (get input-options key)) 38 | (if (nil? dflt) 39 | (string/trim (getline (string key "? "))) 40 | dflt)) 41 | 42 | (deftemplate project-template 43 | ```` 44 | (declare-project 45 | :name "$name" 46 | :description ```$description ``` 47 | :version "0.0.0") 48 | 49 | (declare-source 50 | :prefix "$name" 51 | :source ["$name/init.janet"]) 52 | ````) 53 | 54 | (deftemplate native-project-template 55 | ```` 56 | (declare-project 57 | :name "$name" 58 | :description ```$description ``` 59 | :version "0.0.0") 60 | 61 | (declare-source 62 | :prefix "$name" 63 | :source ["$name/init.janet"]) 64 | 65 | (declare-native 66 | :name "${name}-native" 67 | :source @["c/module.c"]) 68 | ````) 69 | 70 | (deftemplate module-c-template 71 | ``` 72 | #include 73 | 74 | /***************/ 75 | /* C Functions */ 76 | /***************/ 77 | 78 | JANET_FN(cfun_hello_native, 79 | "($name/hello-native)", 80 | "Evaluate to \"Hello!\". but implemented in C.") { 81 | janet_fixarity(argc, 0); 82 | (void) argv; 83 | return janet_cstringv("Hello!"); 84 | } 85 | 86 | /****************/ 87 | /* Module Entry */ 88 | /****************/ 89 | 90 | JANET_MODULE_ENTRY(JanetTable *env) { 91 | JanetRegExt cfuns[] = { 92 | JANET_REG("hello-native", cfun_hello_native), 93 | JANET_REG_END 94 | }; 95 | janet_cfuns_ext(env, "$name", cfuns); 96 | } 97 | ```) 98 | 99 | (deftemplate exe-project-template 100 | ```` 101 | (declare-project 102 | :name "$name" 103 | :description ```$description ``` 104 | :version "0.0.0") 105 | 106 | (declare-executable 107 | :name "$name" 108 | :entry "$name/init.janet") 109 | ````) 110 | 111 | (deftemplate readme-template 112 | ``` 113 | # ${name} 114 | 115 | Add project description here. 116 | ```) 117 | 118 | (deftemplate changelog-template 119 | ``` 120 | # Changelog 121 | All notable changes to this project will be documented in this file. 122 | Format for entries is - release date. 123 | 124 | ## 0.0.0 - $date 125 | - Created this project. 126 | ```) 127 | 128 | (deftemplate license-template 129 | ``` 130 | Copyright (c) $year $author and contributors 131 | 132 | Permission is hereby granted, free of charge, to any person obtaining a copy of 133 | this software and associated documentation files (the "Software"), to deal in 134 | the Software without restriction, including without limitation the rights to 135 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies 136 | of the Software, and to permit persons to whom the Software is furnished to do 137 | so, subject to the following conditions: 138 | 139 | The above copyright notice and this permission notice shall be included in all 140 | copies or substantial portions of the Software. 141 | 142 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 143 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 144 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 145 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 146 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 147 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 148 | SOFTWARE. 149 | ```) 150 | 151 | (deftemplate init-template 152 | ``` 153 | (defn hello 154 | `Evaluates to "Hello!"` 155 | [] 156 | "Hello!") 157 | 158 | (defn main 159 | [& args] 160 | (print (hello))) 161 | ```) 162 | 163 | (deftemplate test-template 164 | ``` 165 | (use ../$name/init) 166 | 167 | (assert (= (hello) "Hello!")) 168 | ```) 169 | 170 | (deftemplate native-test-template 171 | ``` 172 | (use ${name}-native) 173 | 174 | (assert (= (hello-native) "Hello!")) 175 | ```) 176 | 177 | (defn- format-date 178 | [] 179 | (def x (os/date)) 180 | (string/format "%d-%.2d-%.2d" (x :year) (inc (x :month)) (inc (x :month-day)))) 181 | 182 | (defn scaffold-project 183 | "Generate a standardized project scaffold." 184 | [name &opt options] 185 | (default options {}) 186 | (def year (get (os/date) :year)) 187 | (def author (opt-ask :author options)) 188 | (def description (opt-ask :description options)) 189 | (def date (format-date)) 190 | (def scaffold-native (get options :c)) 191 | (def scaffold-exe (get options :exe)) 192 | (def template-opts (merge-into @{:name name :year year :author author :date date :description description} options)) 193 | (print "creating project directory for " name) 194 | (os/mkdir name) 195 | (os/mkdir (string name "/test")) 196 | (os/mkdir (string name "/" name)) 197 | (os/mkdir (string name "/bin")) 198 | (spit (string name "/" name "/init.janet") (init-template template-opts)) 199 | (spit (string name "/test/basic.janet") (test-template template-opts)) 200 | (spit (string name "/README.md") (readme-template template-opts)) 201 | (spit (string name "/LICENSE") (license-template template-opts)) 202 | (spit (string name "/CHANGELOG.md") (changelog-template template-opts)) 203 | (cond 204 | scaffold-native 205 | (do 206 | (os/mkdir (string name "/c")) 207 | (spit (string name "/c/module.c") (module-c-template template-opts)) 208 | (spit (string name "/test/native.janet") (native-test-template template-opts)) 209 | (spit (string name "/project.janet") (native-project-template template-opts))) 210 | scaffold-exe 211 | (do 212 | (spit (string name "/project.janet") (exe-project-template template-opts))) 213 | (do 214 | (spit (string name "/project.janet") (project-template template-opts))))) 215 | -------------------------------------------------------------------------------- /jpm/shutil.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### Utilties for running shell-like commands 3 | ### 4 | 5 | (use ./config) 6 | 7 | (def colors 8 | {:green "\e[32m" 9 | :red "\e[31m"}) 10 | 11 | (defn color 12 | "Color text with ascii escape sequences if (os/isatty)" 13 | [input-color text] 14 | (if (os/isatty) 15 | (string (get colors input-color "\e[0m") text "\e[0m") 16 | text)) 17 | 18 | (defn is-win 19 | "Check if we should assume a DOS-like shell or default 20 | to posix shell." 21 | [] 22 | (dyn :use-batch-shell)) 23 | 24 | (defn is-mingw 25 | "Check if built with mingw" 26 | [] 27 | (= (os/which) :mingw)) 28 | 29 | (defn is-win-or-mingw 30 | "Check if built with mingw" 31 | [] 32 | (def os (os/which)) 33 | (or (= os :mingw) (= os :windows))) 34 | 35 | (defn find-build-dir 36 | "Gets the build directory to output files to." 37 | [] 38 | (let [x (dyn:buildpath "build/")] 39 | (if (string/has-suffix? "/" x) 40 | x 41 | (string x "/")))) 42 | 43 | (defn find-manifest-dir 44 | "Get the path to the directory containing manifests for installed 45 | packages." 46 | [] 47 | (string (dyn :dest-dir "") (dyn:modpath) "/.manifests")) 48 | 49 | (defn find-manifest 50 | "Get the full path of a manifest file given a package name." 51 | [name] 52 | (string (find-manifest-dir) "/" name ".jdn")) 53 | 54 | (defn find-cache 55 | "Return the path to the global cache." 56 | [] 57 | (def path (dyn:modpath)) 58 | (string (dyn :dest-dir "") path "/.cache")) 59 | 60 | (defn rm 61 | "Remove a directory and all sub directories." 62 | [path] 63 | (case (os/lstat path :mode) 64 | :directory (do 65 | (each subpath (os/dir path) 66 | (rm (string path "/" subpath))) 67 | (os/rmdir path)) 68 | nil nil # do nothing if file does not exist 69 | # Default, try to remove 70 | (os/rm path))) 71 | 72 | (defn rimraf 73 | "Hard delete directory tree" 74 | [path] 75 | (if (is-win-or-mingw) 76 | # windows get rid of read-only files 77 | (when (os/stat path :mode) 78 | (os/shell (string `rmdir /S /Q "` path `"`))) 79 | (rm path))) 80 | 81 | (defn clear-cache 82 | "Clear the global git cache." 83 | [] 84 | (def cache (find-cache)) 85 | (print "clearing cache " cache "...") 86 | (rimraf cache)) 87 | 88 | (defn clear-manifest 89 | "Clear the global installation manifest." 90 | [] 91 | (def manifest (find-manifest-dir)) 92 | (print "clearing manifests " manifest "...") 93 | (rimraf manifest)) 94 | 95 | (def path-splitter 96 | "split paths on / and \\." 97 | (peg/compile ~(any (* '(any (if-not (set `\/`) 1)) (+ (set `\/`) -1))))) 98 | 99 | (defn create-dirs 100 | "Create all directories needed for a file (mkdir -p)." 101 | [dest] 102 | (def segs (peg/match path-splitter dest)) 103 | (def i1 (if (and (is-win-or-mingw) (string/has-suffix? ":" (first segs))) 2 1)) 104 | (for i i1 (length segs) 105 | (def path (string/join (slice segs 0 i) "/")) 106 | (unless (empty? path) (os/mkdir path)))) 107 | 108 | (defn devnull 109 | [] 110 | (os/open (if (is-win-or-mingw) "NUL" "/dev/null") :rw)) 111 | 112 | (defn- patch-path 113 | "Add the bin-path to the regular path" 114 | [path] 115 | (if-let [bp (dyn:binpath)] 116 | (string bp (if (is-win-or-mingw) ";" ":") path) 117 | path)) 118 | 119 | (defn- patch-env 120 | [] 121 | (def environ (os/environ)) 122 | # Windows uses "Path" 123 | (def PATH (if (is-win) "Path" "PATH")) 124 | (def env (merge-into environ {"JANET_PATH" (dyn:modpath) 125 | PATH (patch-path (os/getenv PATH))}))) 126 | 127 | (defn shell 128 | "Do a shell command" 129 | [& args] 130 | # First argument is executable and must not contain spaces, workaround 131 | # for binaries which have spaces such as `zig cc`. 132 | # TODO - remove? 133 | (def args (tuple ;(string/split " " (args 0)) ;(map string (slice args 1)))) 134 | (when (dyn :verbose) 135 | (flush) 136 | (print ;(interpose " " args))) 137 | (def env (patch-env)) 138 | (if (dyn :silent) 139 | (with [dn (devnull)] 140 | (put env :out dn) 141 | (put env :err dn) 142 | (os/execute args :epx env)) 143 | (os/execute args :epx env))) 144 | 145 | (defn exec-slurp 146 | "Read stdout of subprocess and return it trimmed in a string." 147 | [& args] 148 | (when (dyn :verbose) 149 | (flush) 150 | (print ;(interpose " " args))) 151 | (def env (patch-env)) 152 | (put env :out :pipe) 153 | (def proc (os/spawn args :epx env)) 154 | (def out (get proc :out)) 155 | (def buf @"") 156 | (ev/gather 157 | (:read out :all buf) 158 | (:wait proc)) 159 | (string/trimr buf)) 160 | 161 | (defn drop1-shell 162 | "Variant of `shell` to play nice with cl.exe, which outputs some junk to terminal that can't be turned off." 163 | [std args] 164 | (if (dyn :silent) (break (shell ;args))) 165 | (when (dyn :verbose) 166 | (flush) 167 | (print ;(interpose " " args))) 168 | (def env (patch-env)) 169 | (put env std :pipe) 170 | (def proc (os/spawn args :ep env)) 171 | (def out (get proc std)) 172 | (def buf @"") 173 | (var index nil) 174 | (ev/gather 175 | (do 176 | (:read out :all buf) 177 | (set index (string/find "\n" buf))) 178 | (:wait proc)) 179 | (def rc (proc :return-code)) 180 | (if (and (zero? rc) index) 181 | (prin (buffer/slice buf (inc index))) 182 | (prin buf)) 183 | (unless (zero? rc) 184 | (errorf "command failed with non-zero exit code %d" rc)) 185 | 0) 186 | 187 | (defn clexe-shell [& args] (drop1-shell :out args)) 188 | 189 | (defn copy 190 | "Copy a file or directory recursively from one location to another." 191 | [src dest] 192 | (print "copying " src " to " dest "...") 193 | (if (is-win-or-mingw) 194 | (let [end (last (peg/match path-splitter src)) 195 | isdir (= (os/stat src :mode) :directory)] 196 | (shell "C:\\Windows\\System32\\xcopy.exe" 197 | (string/replace-all "/" "\\" src) 198 | (string/replace-all "/" "\\" (if isdir (string dest "\\" end) dest)) 199 | "/y" "/s" "/e" "/i")) 200 | (shell "cp" "-rf" src dest))) 201 | 202 | (defn copyfile 203 | "Copy a file one location to another." 204 | [src dest] 205 | (print "copying file " src " to " dest "...") 206 | (->> src slurp (spit dest))) 207 | 208 | (defn abspath 209 | "Create an absolute path. Does not resolve . and .. (useful for 210 | generating entries in install manifest file)." 211 | [path] 212 | (if (if (is-win-or-mingw) 213 | (peg/match '(+ "\\" (* (range "AZ" "az") (+ ":/" ":\\"))) path) 214 | (string/has-prefix? "/" path)) 215 | path 216 | (string (os/cwd) "/" path))) 217 | 218 | (def- filepath-replacer 219 | "Convert url with potential bad characters into a file path element." 220 | (peg/compile ~(% (any (+ (/ '(set "<>:\"/\\|?*") "_") '1))))) 221 | 222 | (defn filepath-replace 223 | "Remove special characters from a string or path 224 | to make it into a path segment." 225 | [repo] 226 | (get (peg/match filepath-replacer repo) 0)) 227 | 228 | (defn basename 229 | "Get the filename of a path without any leading directory components." 230 | [path] 231 | (last (peg/match path-splitter path))) 232 | 233 | (defn dirname 234 | "Get the directory of a file without the filename." 235 | [path] 236 | (string/join (slice (peg/match path-splitter path) 0 -2) "/")) 237 | 238 | (defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "." x)) x)) 239 | 240 | (defn do-monkeypatch 241 | "Modify the existing environment to have the same paths as the test environment." 242 | [build-dir] 243 | (def old-builddir (dyn :build-dir)) 244 | (put root-env :build-dir build-dir) 245 | (array/insert module/paths 1 [(string build-dir ":all::native:") :native check-is-dep]) 246 | old-builddir) 247 | 248 | (defn undo-monkeypatch 249 | [old-builddir] 250 | (put root-env :build-dir old-builddir) 251 | (array/remove module/paths 1)) 252 | 253 | (defn- make-monkeypatch 254 | [build-dir] 255 | (string/format 256 | `(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "." x)) x)) 257 | (put root-env :build-dir %v) 258 | (array/insert module/paths 1 [%v :native check-is-dep])` 259 | build-dir 260 | (string build-dir ":all:" (dyn:modext)))) 261 | 262 | (defn run-patched 263 | "Run a subprocess Janet repl that has the same environment as the test environment." 264 | [& extra-args] 265 | (def bd (find-build-dir)) 266 | (def monkey-patch (make-monkeypatch bd)) 267 | (def environ (merge-into (os/environ) {"JANET_PATH" (dyn:modpath)})) 268 | (os/execute 269 | [(dyn:janet) "-e" monkey-patch ;extra-args] 270 | :ep 271 | environ)) 272 | 273 | (defn run-repl 274 | "Run a repl in the monkey patched test environment" 275 | [] 276 | (run-patched "-r")) 277 | 278 | (defn run-script 279 | "Run a local script in the monkey patched environment." 280 | [path] 281 | (run-patched "--" path)) 282 | 283 | -------------------------------------------------------------------------------- /project.janet: -------------------------------------------------------------------------------- 1 | (declare-project 2 | :name "jpm" 3 | :description "JPM is the Janet Project Manager tool." 4 | :url "https://github.com/janet-lang/jpm" 5 | :version "0.0.3") 6 | 7 | (declare-source 8 | :prefix "jpm" 9 | :source ["jpm/cc.janet" 10 | "jpm/cli.janet" 11 | "jpm/commands.janet" 12 | "jpm/config.janet" 13 | "jpm/dagbuild.janet" 14 | "jpm/declare.janet" 15 | "jpm/init.janet" 16 | "jpm/make-config.janet" 17 | "jpm/pm.janet" 18 | "jpm/rules.janet" 19 | "jpm/shutil.janet" 20 | "jpm/scaffold.janet" 21 | "jpm/cgen.janet"]) 22 | 23 | (declare-manpage "jpm.1") 24 | 25 | (declare-binscript 26 | :main "jpm/jpm" 27 | :hardcode-syspath true 28 | :is-janet true) 29 | 30 | # Install the default configuration for bootstrapping 31 | (def confpath (string (dyn :modpath) "/jpm/default-config.janet")) 32 | 33 | (if-let [bc (os/getenv "JPM_BOOTSTRAP_CONFIG")] 34 | (install-file-rule bc confpath) 35 | 36 | # Otherwise, keep the current config or generate a new one 37 | (do 38 | (if (os/stat confpath :mode) 39 | 40 | # Keep old config 41 | (do 42 | (def old (slurp confpath)) 43 | (task "install" [] 44 | (print "keeping old config at " confpath) 45 | (spit confpath old))) 46 | 47 | # Generate new config 48 | (do 49 | (task "install" [] 50 | (print "no existing config found, generating a default...") 51 | (spit confpath (generate-config)) 52 | (print "created config file at " confpath)))))) 53 | -------------------------------------------------------------------------------- /test/installtest.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### Test that the installation works correctly. 3 | ### 4 | 5 | (import /jpm/shutil) 6 | 7 | (os/cd "testinstall") 8 | (defer (os/cd "..") 9 | (os/execute [(dyn :executable) "runtest.janet"] :px)) 10 | -------------------------------------------------------------------------------- /testinstall/.gitignore: -------------------------------------------------------------------------------- 1 | /build 2 | /modpath 3 | .cache 4 | .manifests 5 | json.* 6 | jhydro.* 7 | circlet.* 8 | argparse.* 9 | sqlite3.* 10 | path.* 11 | -------------------------------------------------------------------------------- /testinstall/project.janet: -------------------------------------------------------------------------------- 1 | (declare-project 2 | :name "testmod") 3 | 4 | (def n1 5 | (declare-native 6 | :name "testmod" 7 | :source @["testmod.c"])) 8 | 9 | (def n2 10 | (declare-native 11 | :name "testmod2" 12 | :source @["testmod2.c"])) 13 | 14 | (def n3 15 | (declare-native 16 | :name "testmod3" 17 | :source @["testmod3.cpp"])) 18 | 19 | (def n4 20 | (declare-native 21 | :name "test-mod-4" 22 | :source @["testmod4.c"])) 23 | 24 | (def n5 25 | (declare-native 26 | :name "testmod5" 27 | :source @["testmod5.cc"])) 28 | 29 | (declare-executable 30 | :name "testexec" 31 | :entry "testexec.janet" 32 | :deps [(n1 :native) 33 | (n2 :native) 34 | (n3 :native) 35 | (n4 :native) 36 | (n5 :native) 37 | (n1 :static) 38 | (n2 :static) 39 | (n3 :static) 40 | (n4 :static) 41 | (n5 :static)]) 42 | -------------------------------------------------------------------------------- /testinstall/runtest.janet: -------------------------------------------------------------------------------- 1 | ### 2 | ### Test that the installation works correctly. 3 | ### 4 | 5 | (import ../jpm/cli) 6 | (import ../jpm/commands) 7 | (import ../jpm/shutil) 8 | (import ../jpm/default-config) 9 | (import ../jpm/config) 10 | (import ../jpm/make-config) 11 | 12 | 13 | (setdyn :jpm-config (make-config/generate-config nil false true)) 14 | 15 | (cli/setup ["--verbose"]) 16 | 17 | (commands/clean) 18 | (commands/build) 19 | (shutil/shell "build/testexec") 20 | (commands/quickbin "testexec.janet" (string "build/testexec2" (if (= :windows (os/which)) ".exe"))) 21 | (shutil/shell "build/testexec2") 22 | (os/mkdir "modpath") 23 | (setdyn :modpath (string (os/cwd) "/modpath")) 24 | (setdyn :test true) 25 | (commands/install "https://github.com/janet-lang/json.git") 26 | (commands/install "https://github.com/janet-lang/path.git") 27 | (commands/install "https://github.com/janet-lang/argparse.git") 28 | -------------------------------------------------------------------------------- /testinstall/test/test1.janet: -------------------------------------------------------------------------------- 1 | (import /build/testmod :as testmod) 2 | 3 | (if (not= 5 (testmod/get5)) (error "testmod/get5 failed")) 4 | -------------------------------------------------------------------------------- /testinstall/testexec.janet: -------------------------------------------------------------------------------- 1 | (use /build/testmod) 2 | (use /build/testmod2) 3 | (use /build/testmod3) 4 | (use /build/test-mod-4) 5 | (use /build/testmod5) 6 | 7 | (defn main [&] 8 | (print "Hello from executable!") 9 | (print (+ (get5) (get6) (get7) (get8) (get9)))) 10 | -------------------------------------------------------------------------------- /testinstall/testmod.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2021 Calvin Rose and contributors 3 | * 4 | * Permission is hereby granted, free of charge, to any person obtaining a copy 5 | * of this software and associated documentation files (the "Software"), to 6 | * deal in the Software without restriction, including without limitation the 7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or 8 | * sell copies of the Software, and to permit persons to whom the Software is 9 | * furnished to do so, subject to the following conditions: 10 | * 11 | * The above copyright notice and this permission notice shall be included in 12 | * all copies or substantial portions of the Software. 13 | * 14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 20 | * IN THE SOFTWARE. 21 | */ 22 | 23 | /* A very simple native module */ 24 | 25 | #include 26 | 27 | static Janet cfun_get_five(int32_t argc, Janet *argv) { 28 | (void) argv; 29 | janet_fixarity(argc, 0); 30 | return janet_wrap_number(5.0); 31 | } 32 | 33 | static const JanetReg array_cfuns[] = { 34 | {"get5", cfun_get_five, NULL}, 35 | {NULL, NULL, NULL} 36 | }; 37 | 38 | JANET_MODULE_ENTRY(JanetTable *env) { 39 | janet_cfuns(env, NULL, array_cfuns); 40 | } 41 | -------------------------------------------------------------------------------- /testinstall/testmod2.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2021 Calvin Rose and contributors 3 | * 4 | * Permission is hereby granted, free of charge, to any person obtaining a copy 5 | * of this software and associated documentation files (the "Software"), to 6 | * deal in the Software without restriction, including without limitation the 7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or 8 | * sell copies of the Software, and to permit persons to whom the Software is 9 | * furnished to do so, subject to the following conditions: 10 | * 11 | * The above copyright notice and this permission notice shall be included in 12 | * all copies or substantial portions of the Software. 13 | * 14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 20 | * IN THE SOFTWARE. 21 | */ 22 | 23 | /* A very simple native module */ 24 | 25 | #include 26 | 27 | static Janet cfun_get_six(int32_t argc, Janet *argv) { 28 | (void) argv; 29 | janet_fixarity(argc, 0); 30 | return janet_wrap_number(6.0); 31 | } 32 | 33 | static const JanetReg array_cfuns[] = { 34 | {"get6", cfun_get_six, NULL}, 35 | {NULL, NULL, NULL} 36 | }; 37 | 38 | JANET_MODULE_ENTRY(JanetTable *env) { 39 | janet_cfuns(env, NULL, array_cfuns); 40 | } 41 | -------------------------------------------------------------------------------- /testinstall/testmod3.cpp: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2021 Calvin Rose and contributors 3 | * 4 | * Permission is hereby granted, free of charge, to any person obtaining a copy 5 | * of this software and associated documentation files (the "Software"), to 6 | * deal in the Software without restriction, including without limitation the 7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or 8 | * sell copies of the Software, and to permit persons to whom the Software is 9 | * furnished to do so, subject to the following conditions: 10 | * 11 | * The above copyright notice and this permission notice shall be included in 12 | * all copies or substantial portions of the Software. 13 | * 14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 20 | * IN THE SOFTWARE. 21 | */ 22 | 23 | /* A very simple native module */ 24 | 25 | #include 26 | #include 27 | 28 | static Janet cfun_get_seven(int32_t argc, Janet *argv) { 29 | (void) argv; 30 | janet_fixarity(argc, 0); 31 | std::cout << "Hello!" << std::endl; 32 | return janet_wrap_number(7.0); 33 | } 34 | 35 | static const JanetReg array_cfuns[] = { 36 | {"get7", cfun_get_seven, NULL}, 37 | {NULL, NULL, NULL} 38 | }; 39 | 40 | JANET_MODULE_ENTRY(JanetTable *env) { 41 | janet_cfuns(env, NULL, array_cfuns); 42 | } 43 | -------------------------------------------------------------------------------- /testinstall/testmod4.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2021 Calvin Rose and contributors 3 | * 4 | * Permission is hereby granted, free of charge, to any person obtaining a copy 5 | * of this software and associated documentation files (the "Software"), to 6 | * deal in the Software without restriction, including without limitation the 7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or 8 | * sell copies of the Software, and to permit persons to whom the Software is 9 | * furnished to do so, subject to the following conditions: 10 | * 11 | * The above copyright notice and this permission notice shall be included in 12 | * all copies or substantial portions of the Software. 13 | * 14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 20 | * IN THE SOFTWARE. 21 | */ 22 | 23 | /* A very simple native module */ 24 | 25 | #include 26 | 27 | static Janet cfun_get_eight(int32_t argc, Janet *argv) { 28 | (void) argv; 29 | janet_fixarity(argc, 0); 30 | return janet_wrap_number(8.0); 31 | } 32 | 33 | static const JanetReg array_cfuns[] = { 34 | {"get8", cfun_get_eight, NULL}, 35 | {NULL, NULL, NULL} 36 | }; 37 | 38 | JANET_MODULE_ENTRY(JanetTable *env) { 39 | janet_cfuns(env, NULL, array_cfuns); 40 | } 41 | -------------------------------------------------------------------------------- /testinstall/testmod5.cc: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2021 Calvin Rose and contributors 3 | * 4 | * Permission is hereby granted, free of charge, to any person obtaining a copy 5 | * of this software and associated documentation files (the "Software"), to 6 | * deal in the Software without restriction, including without limitation the 7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or 8 | * sell copies of the Software, and to permit persons to whom the Software is 9 | * furnished to do so, subject to the following conditions: 10 | * 11 | * The above copyright notice and this permission notice shall be included in 12 | * all copies or substantial portions of the Software. 13 | * 14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 20 | * IN THE SOFTWARE. 21 | */ 22 | 23 | /* A very simple native module */ 24 | 25 | #include 26 | #include 27 | 28 | static Janet cfun_get_nine(int32_t argc, Janet *argv) { 29 | (void) argv; 30 | janet_fixarity(argc, 0); 31 | std::cout << "Hello!" << std::endl; 32 | return janet_wrap_number(9.0); 33 | } 34 | 35 | static const JanetReg array_cfuns[] = { 36 | {"get9", cfun_get_nine, NULL}, 37 | {NULL, NULL, NULL} 38 | }; 39 | 40 | JANET_MODULE_ENTRY(JanetTable *env) { 41 | janet_cfuns(env, NULL, array_cfuns); 42 | } 43 | --------------------------------------------------------------------------------