From 3d76d988c308de2fbcd4e35182a89c7bf6760623 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 1 Jun 2019 10:38:28 -0400 Subject: [PATCH] More work on installation and moving files around. Move all installed libraries into auxlib. Move all installed executable scripts into auxbin. --- Makefile | 6 +- {tools => auxbin}/jpm | 2 +- {tools => auxlib}/cook.janet | 90 ++++++++++------ build_win.bat | 8 +- janet-installer.nsi | 61 ++++++----- meson.build | 9 +- src/boot/boot.janet | 11 +- tools/bars.janet | 55 ---------- tools/highlight.janet | 198 ----------------------------------- 9 files changed, 116 insertions(+), 324 deletions(-) rename {tools => auxbin}/jpm (94%) rename {tools => auxlib}/cook.janet (82%) delete mode 100644 tools/bars.janet delete mode 100644 tools/highlight.janet diff --git a/Makefile b/Makefile index f25cc83a..4abe0ecc 100644 --- a/Makefile +++ b/Makefile @@ -299,10 +299,8 @@ install: $(JANET_TARGET) $(PKG_CONFIG_PATH)/janet.pc cp $(JANET_STATIC_LIBRARY) $(LIBDIR)/libjanet.a ln -sf $(SONAME) $(LIBDIR)/libjanet.so ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(LIBDIR)/$(SONAME) - cp tools/cook.janet $(JANET_PATH) - cp tools/jpm $(BINDIR)/jpm - cp tools/highlight.janet $(JANET_PATH) - cp tools/bars.janet $(JANET_PATH) + cp -rf auxlib/* $(JANET_PATH) + cp -rf auxbin/* $(BINDIR) mkdir -p $(MANPATH) cp janet.1 $(MANPATH) -ldconfig $(LIBDIR) diff --git a/tools/jpm b/auxbin/jpm similarity index 94% rename from tools/jpm rename to auxbin/jpm index 8449f9a0..b55e1cb5 100755 --- a/tools/jpm +++ b/auxbin/jpm @@ -21,7 +21,7 @@ Keys are: --headerpath : The directory containing janet headers. Defaults to $JANET_HEADERPATH or module/*headerpath* --binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH. --optimize : Optimization level for natives. Defaults to $OPTIMIZE or 2. - --compiler : C compiler to use for natives. Defaults to $CC or cc. + --compiler : C compiler to use for natives. Defaults to $COMPILER or cc. --linker : C linker to use for linking natives. Defaults to $LINKER or cc. --cflags : Extra compiler flags for native modules. Defaults to $CFLAGS if set. --lflags : Extra linker flags for native modules. Defaults to $LFLAGS if set. diff --git a/tools/cook.janet b/auxlib/cook.janet similarity index 82% rename from tools/cook.janet rename to auxlib/cook.janet index 173578f4..02671052 100644 --- a/tools/cook.janet +++ b/auxlib/cook.janet @@ -118,16 +118,30 @@ (def JANET_MODPATH (or (os/getenv "JANET_MODPATH") module/*syspath*)) (def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH") module/*headerpath*)) (def JANET_BINPATH (or (os/getenv "JANET_BINPATH") (unless is-win "/usr/local/bin"))) - + # Compilation settings -(def OPTIMIZE (or (os/getenv "OPTIMIZE") 2)) -(def CC (or (os/getenv "CC") (if is-win "cl" "cc"))) -(def LD (or (os/getenv "LINKER") (if is-win "link" CC))) -(def LDFLAGS (or (os/getenv "LFLAGS") - (if is-win " /nologo" - (string " -shared" - (if is-mac " -undefined dynamic_lookup" ""))))) -(def CFLAGS (or (os/getenv "CFLAGS") (if is-win "" " -std=c99 -Wall -Wextra -fpic"))) +(def- OPTIMIZE (or (os/getenv "OPTIMIZE") 2)) +(def- COMPILER (or (os/getenv "COMPILER") (if is-win "cl" "cc"))) +(def- LINKER (or (os/getenv "LINKER") (if is-win "link" COMPILER))) +(def- LFLAGS + (if-let [lflags (os/getenv "LFLAGS")] + (string/split " " lflags) + (if is-win ["/nologo" "/DLL"] + (if is-mac + ["-shared" "-undefined" "dynamic_lookup"] + ["-shared"])))) +(def- CFLAGS + (if-let [cflags (os/getenv "CFLAGS")] + (string/split " " cflags) + (if is-win + ["/nologo"] + ["-std=c99" "-Wall" "-Wextra" "-fpic"]))) + +# Some defaults +(def default-cflags CFLAGS) +(def default-lflags LFLAGS) +(def default-cc COMPILER) +(def default-ld LINKER) (defn- opt "Get an option, allowing overrides via dynamic bindings AND some @@ -145,9 +159,7 @@ (defn shell "Do a shell command" [& args] - (def cmd (string/join args)) - (print cmd) - (def res (os/shell cmd)) + (def res (os/execute args :p)) (unless (zero? res) (error (string "command exited with status " res)))) @@ -164,7 +176,10 @@ (defn copy "Copy a file or directory recursively from one location to another." [src dest] - (shell (if is-win "xcopy " "cp -rf ") `"` src `" "` dest (if is-win `" /y /e` `"`))) + (print "copying " src " to " dest "...") + (if is-win + (shell "xcopy" src dest "/y" "/e") + (shell "cp" "-rf" src dest))) # # C Compilation @@ -223,41 +238,39 @@ (defn- getcflags "Generate the c flags from the input options." [opts] - (string (opt opts :cflags CFLAGS) - (if is-win " /I\"" " \"-I") - (opt opts :headerpath JANET_HEADERPATH) - `"` - (if is-win " /O\"" " \"-O") - (opt opts :optimize OPTIMIZE) - `"`)) + @[;(opt opts :cflags CFLAGS) + (string (if is-win "/I" "-I") (opt opts :headerpath JANET_HEADERPATH)) + (string (if is-win "/O" "-O") (opt opts :optimize OPTIMIZE))]) (defn- compile-c "Compile a C file into an object file." [opts src dest] - (def cc (opt opts :compiler CC)) + (def cc (opt opts :compiler COMPILER)) (def cflags (getcflags opts)) (def defines (interpose " " (make-defines (opt opts :defines {})))) (rule dest [src] + (print "compiling " dest "...") (if is-win - (shell cc " " ;defines " /nologo /c " cflags " /Fo\"" dest `" "` src `"`) - (shell cc " -c '" src "' " ;defines " " cflags " -o '" dest `'`)))) + (shell cc ;defines "/c" ;cflags (string "/Fo" dest) src) + (shell cc "-c" src ;defines ;cflags "-o" dest)))) (defn- link-c "Link a number of object files together." [opts target & objects] - (def ld (opt opts :linker LD)) + (def ld (opt opts :linker LINKER)) (def cflags (getcflags opts)) - (def lflags (opt opts :lflags LDFLAGS)) - (def olist (string/join objects `" "`)) + (def lflags (opt opts :lflags LFLAGS)) (rule target objects + (print "linking " target "...") (if is-win - (shell ld " " lflags " /DLL /OUT:" target ` "` olist `" "` (opt opts :headerpath JANET_HEADERPATH) `"\\janet.lib`) - (shell ld " " cflags ` -o "` target `" "` olist `" ` lflags)))) + (shell ld ;lflags (string "/OUT:" target) ;objects (string (opt opts :headerpath JANET_HEADERPATH) `\\janet.lib`)) + (shell ld ;cflags `-o` target ;objects ;lflags)))) (defn- create-buffer-c "Inline raw byte file as a c file." [source dest name] (rule dest [source] + (print "creating embedded source " dest "...") (def f (file/open source :r)) (if (not f) (error (string "file " f " not found"))) (def out (file/open dest :w)) @@ -323,13 +336,30 @@ (each s sources (install-rule s path))) -(defn declare-binscript - "Declare a janet file to be installed as an executable script." +(defn declare-bin + "Declare a generic file to be installed as an executable." [&keys opts] (def main (opts :main)) (def binpath (opt opts :binpath JANET_BINPATH)) (install-rule main binpath)) +(defn declare-binscript + "Declare a janet file to be installed as an executable script. Creates + a shim on windows." + [&keys opts] + (def main (opts :main)) + (def binpath (opt opts :binpath JANET_BINPATH)) + (install-rule main binpath) + # Create a dud batch file when on windows. + (when is-win + (def name (last (string/split sep src))) + (def bat (string "@echo off\r\njanet %~dp0\\" name "%*")) + (def newname (string binpath sep name ".bat")) + (add-body "install" + (spit newname bat)) + (add-body "uninstall" + (os/rm newname)))) + (defn declare-archive "Build a janet archive. This is a file that bundles together many janet scripts into a janet image. This file can the be moved to any machine with diff --git a/build_win.bat b/build_win.bat index e02c4894..e0da8c51 100644 --- a/build_win.bat +++ b/build_win.bat @@ -128,13 +128,15 @@ copy build\janet.c dist\janet.c copy janet.exe dist\janet.exe copy LICENSE dist\LICENSE copy README.md dist\README.md + copy janet.lib dist\janet.lib copy janet.exp dist\janet.exp copy src\include\janet.h dist\janet.h copy src\include\janetconf.h dist\janetconf.h -copy tools\cook.janet dist\cook.janet -copy tools\highlight.janet dist\highlight.janet -copy tools\jpm dist\jpm + +copy auxlib\cook.janet dist\cook.janet + +copy auxbin\jpm dist\jpm copy tools\jpm.bat dist\jpm.bat exit /b 0 diff --git a/janet-installer.nsi b/janet-installer.nsi index 8d74988d..dc030c74 100644 --- a/janet-installer.nsi +++ b/janet-installer.nsi @@ -49,7 +49,7 @@ BrandingText "The Janet Programming Language" # Need to set a language. !insertmacro MUI_LANGUAGE "English" - + function .onInit !insertmacro MULTIUSER_INIT functionEnd @@ -58,28 +58,38 @@ section "Janet" BfWSection createDirectory "$INSTDIR\Library" createDirectory "$INSTDIR\C" createDirectory "$INSTDIR\bin" + createDirectory "$INSTDIR\docs" setOutPath "$INSTDIR" - + + # Bin files file /oname=bin\janet.exe dist\janet.exe file /oname=logo.ico assets\icon.ico - - file /oname=Library\cook.janet dist\cook.janet - + file /oname=bin\jpm.janet auxbin\jpm + file /oname=bin\jpm.bat auxbin\jpm.bat + + # Modules + file /oname=Library\cook.janet auxlib\cook.janet + + # C headers file /oname=C\janet.h dist\janet.h file /oname=C\janetconf.h dist\janetconf.h file /oname=C\janet.lib dist\janet.lib file /oname=C\janet.exp dist\janet.exp file /oname=C\janet.c dist\janet.c - - file /oname=bin\jpm.janet dist\jpm - file /oname=bin\jpm.bat dist\jpm.bat - + + # Documentation + file /oname=docs/docs.html dist/doc.html + + # Other + file README.md + file LICENSE + # Uninstaller - See function un.onInit and section "uninstall" for configuration writeUninstaller "$INSTDIR\uninstall.exe" - + # Start Menu createShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\bin\janet.exe" "" "$INSTDIR\logo.ico" - + # HKLM (all users) vs HKCU (current user) WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_PATH "$INSTDIR\Library" WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_HEADERPATH "$INSTDIR\C" @@ -90,11 +100,11 @@ section "Janet" BfWSection WriteRegExpandStr HKCU "Environment" JANET_BINPATH "$INSTDIR\bin" SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000 - + # Update path ${EnvVarUpdate} $0 "PATH" "A" "HKCU" "$INSTDIR\bin" ; Append - ${EnvVarUpdate} $0 "PATH" "A" "HKLM" "$INSTDIR\bin" ; Append - + ${EnvVarUpdate} $0 "PATH" "A" "HKLM" "$INSTDIR\bin" ; Append + # Registry information for add/remove programs WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "DisplayName" "Janet" WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "UninstallString" "$INSTDIR\uninstall.exe" @@ -114,24 +124,27 @@ section "Janet" BfWSection # Set the INSTALLSIZE constant (!defined at the top of this script) so Add/Remove Programs can accurately report the size WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "EstimatedSize" 1000 sectionEnd - + # Uninstaller - + function un.onInit !insertmacro MULTIUSER_UNINIT functionEnd - + section "uninstall" - + # Remove Start Menu launcher delete "$SMPROGRAMS\Janet.lnk" - + # Remove files delete "$INSTDIR\logo.ico" + delete "$INSTDIR\README.md" + delete "$INSTDIR\LICENSE" rmdir /r "$INSTDIR\Library" rmdir /r "$INSTDIR\bin" rmdir /r "$INSTDIR\C" - + rmdir /r "$INSTDIR\docs" + # Remove env vars DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_PATH @@ -144,14 +157,14 @@ section "uninstall" # Unset PATH ${un.EnvVarUpdate} $0 "PATH" "R" "HKCU" "$INSTDIR\bin" ; Remove - ${un.EnvVarUpdate} $0 "PATH" "R" "HKLM" "$INSTDIR\bin" ; Remove - + ${un.EnvVarUpdate} $0 "PATH" "R" "HKLM" "$INSTDIR\bin" ; Remove + # make sure windows knows about the change SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000 - + # Always delete uninstaller as the last action delete "$INSTDIR\uninstall.exe" - + # Remove uninstaller information from the registry DeleteRegKey HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" sectionEnd diff --git a/meson.build b/meson.build index e1712718..753f6a81 100644 --- a/meson.build +++ b/meson.build @@ -130,7 +130,6 @@ janet_mainclient = executable('janet', core_src, core_image, init_gen, mainclien include_directories : incdir, dependencies : [m_dep, dl_dep], install : true) -janet_jpm = install_data('tools/jpm', install_dir : 'bin') # Documentation docs = custom_target('docs', @@ -173,8 +172,10 @@ run_target('repl', command : [janet_mainclient]) install_man('janet.1') install_headers('src/include/janet.h', 'src/include/janetconf.h', subdir: 'janet') janet_libs = [ - 'tools/bars.janet', - 'tools/cook.janet', - 'tools/highlight.janet' + 'auxlib/cook.janet' +] +janet_binscripts = [ + 'auxbin/jpm' ] install_data(sources : janet_libs, install_dir : janet_path) +install_data(sources : janet_binscripts, install_dir : 'bin') diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 862ec690..bfb5744b 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -1088,6 +1088,12 @@ [f & args] (file/write stdout (buffer/format @"" f ;args))) +(defn pp + "Pretty print to stdout." + [x] + (print (buffer/format @"" (dyn :pretty-format "%p") x))) + + ### ### ### Pattern Matching @@ -1406,11 +1412,6 @@ (set current (macex1 current))) current) -(defn pp - "Pretty print to stdout." - [x] - (print (buffer/format @"" (dyn :pretty-format "%p") x))) - ### ### ### Evaluation and Compilation diff --git a/tools/bars.janet b/tools/bars.janet deleted file mode 100644 index c0e4d3fd..00000000 --- a/tools/bars.janet +++ /dev/null @@ -1,55 +0,0 @@ -# A flexible templater for janet. Compiles -# templates to janet functions that produce buffers. - -(defn template - "Compile a template string into a function" - [source] - - # State for compilation machine - (def p (parser/new)) - (def forms @[]) - - (defn parse-chunk - "Parse a string and push produced values to forms." - [chunk] - (parser/consume p chunk) - (while (parser/has-more p) - (array/push forms (parser/produce p))) - (if (= :error (parser/status p)) - (error (parser/error p)))) - - (defn code-chunk - "Parse all the forms in str and return them - in a tuple prefixed with 'do." - [str] - (parse-chunk str) - true) - - (defn string-chunk - "Insert string chunk into parser" - [str] - (parser/insert p str) - (parse-chunk "") - true) - - # Run peg - (def grammar - ~{:code-chunk (* "{%" (drop (cmt '(any (if-not "%}" 1)) ,code-chunk)) "%}") - :main-chunk (drop (cmt '(any (if-not "{%" 1)) ,string-chunk)) - :main (any (+ :code-chunk :main-chunk (error "")))}) - (def parts (peg/match grammar source)) - - # Check errors in template and parser - (unless parts (error "invalid template syntax")) - (parse-chunk "\n") - (case (parser/status p) - :pending (error (string "unfinished parser state " (parser/state p))) - :error (error (parser/error p))) - - # Make ast from forms - (def ast ~(fn [&opt params] (default params @{}) (,buffer ,;forms))) - - (def ctor (compile ast (fiber/getenv (fiber/current)) source)) - (if-not (function? ctor) - (error (string "could not compile template"))) - (ctor)) diff --git a/tools/highlight.janet b/tools/highlight.janet deleted file mode 100644 index 95380da9..00000000 --- a/tools/highlight.janet +++ /dev/null @@ -1,198 +0,0 @@ -# Copyright (C) Calvin Rose 2019 -# -# Takes in a janet string and colorizes for multiple -# output formats. - -# Constants for checking if symbols should be -# highlighted. -(def- core-env (table/getproto *env*)) -(def- specials {'fn true - 'var true - 'do true - 'while true - 'def true - 'splice true - 'set true - 'break true - 'unquote true - 'quasiquote true - 'quote true - 'if true}) - -(defn check-number [text] (and (scan-number text) text)) - -(defn- make-grammar - "Creates the grammar based on the paint function, which - colorizes fragments of text." - [paint] - - (defn <-c - "Peg rule for capturing and coloring a rule." - [color what] - ~(/ (<- ,what) ,(partial paint color))) - - (defn color-symbol - "Color a symbol only if it is a core library binding or special." - [text] - (def sym (symbol text)) - (def should-color (or (specials sym) (core-env sym))) - (paint (if should-color :coresym :symbol) text)) - - ~{:ws (set " \t\r\f\n\v\0") - :readermac (set "';~,") - :symchars (+ (range "09" "AZ" "az" "\x80\xFF") (set "!$%&*+-./:@^_|")) - :token (some :symchars) - :hex (range "09" "af" "AF") - :escape (* "\\" (+ (set "ntrvzf0\"\\e") - (* "x" :hex :hex) - (error (constant "bad hex escape")))) - - :comment ,(<-c :comment ~(* "#" (any (if-not (+ "\n" -1) 1)))) - - :symbol (/ ':token ,color-symbol) - :keyword ,(<-c :keyword ~(* ":" (any :symchars))) - :constant ,(<-c :constant ~(+ "true" "false" "nil")) - :bytes (* "\"" (any (+ :escape (if-not "\"" 1))) "\"") - :string ,(<-c :string :bytes) - :buffer ,(<-c :string ~(* "@" :bytes)) - :long-bytes {:delim (some "`") - :open (capture :delim :n) - :close (cmt (* (not (> -1 "`")) (-> :n) ':delim) ,=) - :main (drop (* :open (any (if-not :close 1)) :close))} - :long-string ,(<-c :string :long-bytes) - :long-buffer ,(<-c :string ~(* "@" :long-bytes)) - :number (/ (cmt ':token ,check-number) ,(partial paint :number)) - - :raw-value (+ :comment :constant :number :keyword - :string :buffer :long-string :long-buffer - :parray :barray :ptuple :btuple :struct :dict :symbol) - - :value (* (? '(some (+ :ws :readermac))) :raw-value '(any :ws)) - :root (any :value) - :root2 (any (* :value :value)) - :ptuple (* '"(" :root (+ '")" (error ""))) - :btuple (* '"[" :root (+ '"]" (error ""))) - :struct (* '"{" :root2 (+ '"}" (error ""))) - :parray (* '"@" :ptuple) - :barray (* '"@" :btuple) - :dict (* '"@" :struct) - - :main (+ (% :root) (error ""))}) - -# Terminal syntax highlighting - -(def- terminal-colors - {:number 32 - :keyword 33 - :string 35 - :coresym 31 - :constant 34 - :comment 36}) - -(defn- terminal-paint - "Paint colors for ansi terminals" - [what str] - (def code (get terminal-colors what)) - (if code (string "\e[" code "m" str "\e[0m") str)) - -# HTML syntax highlighting - -(def- html-colors - {:number "j-number" - :keyword "j-keyword" - :string "j-string" - :coresym "j-coresym" - :constant "j-constant" - :comment "j-comment" - :line "j-line"}) - -(def- escapes - {38 "&" - 60 "<" - 62 ">" - 34 """ - 39 "'" - 47 "/"}) - -(def html-style - "Style tag to add to a page to highlight janet code" -``` - -```) - -(defn html-escape - "Escape special characters for HTML encoding." - [str] - (def buf @"") - (loop [byte :in str] - (if-let [rep (get escapes byte)] - (buffer/push-string buf rep) - (buffer/push-byte buf byte))) - buf) - -(defn- html-paint - "Paint colors for HTML" - [what str] - (def color (get html-colors what)) - (def escaped (html-escape str)) - (if color - (string "" escaped "") - escaped)) - -# Create Pegs - -(def- terminal-grammar (peg/compile (make-grammar terminal-paint))) -(def- html-grammar (peg/compile (make-grammar html-paint))) - -# API - -(defn ansi - "Highlight janet source code ANSI Termianl escape colors." - [source] - (0 (peg/match terminal-grammar source))) - -(defn html - "Highlight janet source code and output HTML." - [source] - (string "
"
-          (0 (peg/match html-grammar source))
-          "
")) - -(defn html-file - "Highlight a janet file and print out a highlighted HTML version - of the file. Must provide a default title when creating the file." - [in-path out-path title &] - (default title in-path) - (def f (file/open in-path :r)) - (def source (file/read f :all)) - (file/close f) - (def markup (0 (peg/match html-grammar source))) - (def out (file/open out-path :w)) - (file/write out - "" - html-style - "" - title - "" - "
"
-              markup
-              "
") - (file/close out)) - -(defn ansi-file - "Highlight a janet file and print the highlighted output to stdout." - [in-path] - (def f (file/open in-path :r)) - (def source (file/read f :all)) - (file/close f) - (def markup (0 (peg/match terminal-grammar source))) - (print markup))