From 936a37bc76e509c9b9ddc8c71d449d4a1645b11c Mon Sep 17 00:00:00 2001 From: pho4cexa Date: Sat, 4 Feb 2023 21:40:06 -0800 Subject: [PATCH] viable first brush at breaking code into modules --- Makefile | 23 +++++++++--- foo.scm | 5 +++ main.scm | 81 +------------------------------------------ utils.scm | 102 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 126 insertions(+), 85 deletions(-) create mode 100644 foo.scm create mode 100644 utils.scm diff --git a/Makefile b/Makefile index 0e070ee..53ff6ff 100644 --- a/Makefile +++ b/Makefile @@ -1,15 +1,28 @@ DEPS = utf8 lowdown sxml-transforms clojurian symbol-utils scss srfi-1 srfi-13 srfi-14 ersatz SRC = main.scm +LOCAL_MODULES = utils DIR_INSTALL ?= /usr/local/bin DIR_BUILD = . BIN = repo2html -all: compile +default: compile -compile: - mkdir -p $(DIR_BUILD)/ - csc -O3 -static ./$(SRC) -o $(DIR_BUILD)/$(BIN) +foo: foo.scm utils.import.scm utils.o + csc -O5 -I . -static -uses utils $< -o $@ + +# Note: things break if you use -O5 here. +%.import.scm: %.scm + csc -O4 -static -c -unit $* -j $* $< + +$(DIR_BUILD)/$(BIN): $(SRC) $(DIR_BUILD) $(addsuffix .import.scm,$(LOCAL_MODULES)) + csc -I . -static -uses utils $< -o $@ -strip + +$(DIR_BUILD): + mkdir -p $@/ + +compile: $(DIR_BUILD)/$(BIN) rm ./$(DIR_BUILD)/$(BIN).link + @ls -sh $(DIR_BUILD)/$(BIN) @echo "Finished compiling a static binary in $(DIR_BUILD)/$(BIN)!" dependencies: @@ -22,7 +35,7 @@ uninstall: rm $(DIR_INSTALL)/$(PROG) clean: - rm $(DIR_BUILD)/$(BIN) + rm -f $(DIR_BUILD)/$(BIN) foo repo2html *.link *.o *.import.scm compile-on-debian-11: # builds repo2html compatible with systems running glibc-2.31 and higher. diff --git a/foo.scm b/foo.scm new file mode 100644 index 0000000..30ad229 --- /dev/null +++ b/foo.scm @@ -0,0 +1,5 @@ +#!/usr/bin/csi -s + +(import (utils)) + +(print (substring* "foo" 1 2)) diff --git a/main.scm b/main.scm index 2099ba7..5c1efc1 100755 --- a/main.scm +++ b/main.scm @@ -19,88 +19,9 @@ sxml-transforms symbol-utils ;; (unspecified-value) utf8 + utils ) -;; small utilities --------------------------------- - - -;; (bail [message [exit-status]]) -;; end the program immediately. -;; if a message is provided, print it to the screen. -;; exit-status defaults to 1. -(define (bail #!optional msg (status 1)) - (when msg (print msg)) - (exit status)) - -;; clojureish "debugging by print statement" tool since i still haven't reached -;; lisp enlightenment -(define ((inspect #!optional label #!rest args) s) - (display (list label ":" args " => " s) (current-error-port)) - (newline (current-error-port)) - s) - -;; decompose a path s into its constituent parts. returns values: -;; -;; root: "/" if it's an absolute path, "" if relative directory-elements: a list -;; of each directory from root, () if none basename: the filename with extension -;; removed like "readme" or ".bashrc" extension: the file extension with the -;; dot, like ".txt" or "" if none relative-root: the relative path from the -;; given path to the root -;; e.g foo/bar/baz.html -> ../../ -;; -;; this is intended to provide default values that make for easier reassembly -;; into filenames. -;; -;; typical use: -;; (->> source-file -;; (pathparts) -;; (define-values (root elements basename extension relative-root))) -;; -(define (pathparts s) - (define-values (dirname basename extension) - (decompose-pathname s)) - (define-values (origin root directory-elements) - (decompose-directory (or dirname ""))) - ;; discarding origin because idgaf about windows - (values (or root "") - (or directory-elements '()) - basename - (if extension (string-append "." extension) "") - (->> - (or directory-elements '()) - (map (constantly "../")) - (apply string-append)))) - -;; like (substring) but doesn't break if start and end are too big/small -(define (substring* s start end) - (substring s (max start 0) (min end (string-length s)))) - -;; merge alists a and b. values in b "win" -(define (alist-merge a b) - (lset-union (lambda (x y) (eq? (car x) (car y))) a b)) - -;; like alist-ref but works on nested alists by specifying a path (list of keys) -(define (alist-ref-in keys alist #!optional (test eqv?)) - (if (null? (cdr keys)) - (alist-ref (car keys) alist test) - (alist-ref-in (cdr keys) (alist-ref (car keys) alist test) test))) - -;; like alist-update, but works on nested alists by specifying a path (list of -;; keys) -(define (alist-update-in keys value alist #!optional (test eqv?)) - (cond - ((not alist) #f) - ((null? (cdr keys)) - (alist-update (car keys) value alist test)) - (else - (alist-update (car keys) - (alist-update-in (cdr keys) value (alist-ref (car keys) alist test) test) - alist test)))) - -(define (unless-equals s1 s2) - ;; if s1 == s2, then s1, otherwise #f - (and (equal? s1 s2) s1)) - ;; auto-apply ids to headings --------------------------------- (define (slugify inner) (-> diff --git a/utils.scm b/utils.scm new file mode 100644 index 0000000..b1d7a59 --- /dev/null +++ b/utils.scm @@ -0,0 +1,102 @@ + +;; small utilities --------------------------------- + +(module utils * + (import + scheme + (chicken base) + (chicken file) + (chicken format) + (chicken io) + (chicken pathname) + (chicken port) + (chicken process) + (chicken process-context) + (chicken string) + (clojurian syntax) + ersatz + lowdown + scss + srfi-1 ;; list utils + srfi-13 ;; string utils + srfi-14 ;; charsets + sxml-transforms + symbol-utils ;; (unspecified-value) + utf8) +;; (bail [message [exit-status]]) +;; end the program immediately. +;; if a message is provided, print it to the screen. +;; exit-status defaults to 1. +(define (bail #!optional msg (status 1)) + (when msg (print msg)) + (exit status)) + +;; clojureish "debugging by print statement" tool since i still haven't reached +;; lisp enlightenment +(define ((inspect #!optional label #!rest args) s) + (display (list label ":" args " => " s) (current-error-port)) + (newline (current-error-port)) + s) + +;; decompose a path s into its constituent parts. returns values: +;; +;; root: "/" if it's an absolute path, "" if relative directory-elements: a list +;; of each directory from root, () if none basename: the filename with extension +;; removed like "readme" or ".bashrc" extension: the file extension with the +;; dot, like ".txt" or "" if none relative-root: the relative path from the +;; given path to the root +;; e.g foo/bar/baz.html -> ../../ +;; +;; this is intended to provide default values that make for easier reassembly +;; into filenames. +;; +;; typical use: +;; (->> source-file +;; (pathparts) +;; (define-values (root elements basename extension relative-root))) +;; +(define (pathparts s) + (define-values (dirname basename extension) + (decompose-pathname s)) + (define-values (origin root directory-elements) + (decompose-directory (or dirname ""))) + ;; discarding origin because idgaf about windows + (values (or root "") + (or directory-elements '()) + basename + (if extension (string-append "." extension) "") + (->> + (or directory-elements '()) + (map (constantly "../")) + (apply string-append)))) + +;; like (substring) but doesn't break if start and end are too big/small +(define (substring* s start end) + (substring s (max start 0) (min end (string-length s)))) + +;; merge alists a and b. values in b "win" +(define (alist-merge a b) + (lset-union (lambda (x y) (eq? (car x) (car y))) a b)) + +;; like alist-ref but works on nested alists by specifying a path (list of keys) +(define (alist-ref-in keys alist #!optional (test eqv?)) + (if (null? (cdr keys)) + (alist-ref (car keys) alist test) + (alist-ref-in (cdr keys) (alist-ref (car keys) alist test) test))) + +;; like alist-update, but works on nested alists by specifying a path (list of +;; keys) +(define (alist-update-in keys value alist #!optional (test eqv?)) + (cond + ((not alist) #f) + ((null? (cdr keys)) + (alist-update (car keys) value alist test)) + (else + (alist-update (car keys) + (alist-update-in (cdr keys) value (alist-ref (car keys) alist test) test) + alist test)))) + +(define (unless-equals s1 s2) + ;; if s1 == s2, then s1, otherwise #f + (and (equal? s1 s2) s1)) +)