From c879e3f7e0c88056db8972cc11fa28e6c7a1b964 Mon Sep 17 00:00:00 2001 From: Kai Klingenberg Date: Wed, 19 Feb 2020 13:32:52 -0300 Subject: [PATCH] Initial commit --- .gitignore | 2 + LICENSE | 28 +++++++++++ README.md | 13 +++++ chicken-assemble.scm | 110 +++++++++++++++++++++++++++++++++++++++++++ dockerfiles/alpine | 22 +++++++++ dockerfiles/debian | 22 +++++++++ 6 files changed, 197 insertions(+) create mode 100644 .gitignore create mode 100644 LICENSE create mode 100644 README.md create mode 100644 chicken-assemble.scm create mode 100644 dockerfiles/alpine create mode 100644 dockerfiles/debian diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..7ed1fe2 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +# emacs +*~ diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..41118a9 --- /dev/null +++ b/LICENSE @@ -0,0 +1,28 @@ +Copyright 2020 Kai Klingenberg + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright +notice, this list of conditions and the following disclaimer in the +documentation and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its +contributors may be used to endorse or promote products derived from +this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..fa651db --- /dev/null +++ b/README.md @@ -0,0 +1,13 @@ +# chicken-scheme dockerfiles + +Dockerfiles useful for [chicken scheme](https://www.call-cc.org/) +development. An optional custom `chicken-assemble` script is also +provided, used to build projects in an opinionated, structured way. + +## How to use these images + +TODO write decent examples + +## `chicken-assemble`-based projects + +TODO explain chicken-assemble and the enforced project structure diff --git a/chicken-assemble.scm b/chicken-assemble.scm new file mode 100644 index 0000000..93fbe1b --- /dev/null +++ b/chicken-assemble.scm @@ -0,0 +1,110 @@ +#!/usr/local/bin/csi -script + +(import (chicken format) + (chicken io) + (chicken process-context) + (chicken sort) + (chicken string) + (clojurian syntax) + records + srfi-1 + srfi-69) + +;; Parse command line arguments: [src-dir [core-module]] +;; src-dir is the root directory for the project +;; core-module is the file name of the 'main' module, whithout +;; extension +(define-values (base-dir base-package) + (let ((args (command-line-arguments))) + (cond ((null? args) (values "src" 'core)) + ((null? (cdr args)) (values (car args) 'core)) + (else (values (car args) (string->symbol (cadr args))))))) + +;; Translate a local package reference to a file path +(define (path package) + (-> (symbol->string package) + (string-split ".") + (->> (cons base-dir)) + (string-intersperse "/") + (conc ".scm"))) + +;; Define a struct for each module-file. The brethren are other local +;; package references found within the body of a module-file. +(define node-type (make-record-type 'node '(package brethren body))) +(define make-node (record-constructor node-type '(package brethren body))) +(define node-package (record-accessor node-type 'package)) +(define node-brethren (record-accessor node-type 'brethren)) +(define node-body (record-accessor node-type 'body)) + +;; Collect brethren given a body of s-expressions. Brethren are +;; imported 'local' modules. +(define (find-brethren body) + (->> body + (filter (lambda (form) + (eqv? (car form) 'import))) + (map cdr) + (concatenate) + (filter list?) + (filter (lambda (form) + (eqv? (car form) 'local))) + (map cadr))) + +;; Collect a piece of the modules graph given a source file. +(define (collect-from source graph) + (let* ((body (with-input-from-file (path source) read-list)) + (brethren (find-brethren body))) + (hash-table-set! graph source (make-node source brethren body)) + (->> brethren + (remove (lambda (package) + (hash-table-exists? graph package))) + (for-each (lambda (package) + (collect-from package graph)))) + graph)) + +;; The 'whole' graph, as required from the core-module. +(define graph (collect-from base-package (make-hash-table))) + +;; Toposort said graph to define modules in logical order. This fails +;; on circular dependencies. +(define sorted-graph + (-> (hash-table-values graph) + (->> (map (lambda (node) + (cons (node-package node) + (node-brethren node))))) + (topological-sort eqv?) + reverse)) + +;; Replace an unofficial local import into a real chicken import, +;; using the module name as a prefix (plus a forward slash). +(define (replace-local-imports body) + (define (rewrite-local-import form) + (let* ((package (cadr form)) + (alias (if (>= (length form) 3) + (caddr form) + package))) + (list 'prefix package (string->symbol (conc (symbol->string alias) "/"))))) + + (map (lambda (form) + (if (eqv? (car form) 'import) + (map (lambda (import-form) + (if (and (list? import-form) + (eqv? (car import-form) 'local)) + (rewrite-local-import import-form) + import-form)) + form) + form)) + body)) + +;; Build the assembled, single-file multi-module program. +(for-each (lambda (package) + (let ((node (hash-table-ref graph package))) + (write (append (list 'module package '*) + (replace-local-imports (node-body node)))) + (print))) + sorted-graph) +(write (list 'import + '(chicken process-context) + (list 'prefix base-package 'core/))) +(print) +(write '(apply core/-main (command-line-arguments))) +(print) diff --git a/dockerfiles/alpine b/dockerfiles/alpine new file mode 100644 index 0000000..69f7caf --- /dev/null +++ b/dockerfiles/alpine @@ -0,0 +1,22 @@ +FROM alpine:3.11 + +ENV CHICKEN_VERSION 5.1.0 +ENV PLATFORM linux + +RUN apk update && \ + apk --no-cache --update add build-base && \ + wget -qO- https://code.call-cc.org/releases/$CHICKEN_VERSION/chicken-$CHICKEN_VERSION.tar.gz | tar xzv && \ + cd /chicken-$CHICKEN_VERSION && \ + make PLATFORM=$PLATFORM && \ + make PLATFORM=$PLATFORM install && \ + make PLATFORM=$PLATFORM check && \ + cd / && \ + rm -rf /chicken-$CHICKEN_VERSION + +# install project assembly tool +COPY chicken-assemble.scm /usr/bin/chicken-assemble +RUN chicken-install clojurian:3 \ + records \ + srfi-1 \ + srfi-69 && \ + chmod a+x /usr/bin/chicken-assemble diff --git a/dockerfiles/debian b/dockerfiles/debian new file mode 100644 index 0000000..022ab7b --- /dev/null +++ b/dockerfiles/debian @@ -0,0 +1,22 @@ +FROM debian:buster + +ENV CHICKEN_VERSION 5.1.0 +ENV PLATFORM linux + +RUN apt-get update && \ + apt-get install -y wget build-essential && \ + wget -qO- https://code.call-cc.org/releases/${CHICKEN_VERSION}/chicken-${CHICKEN_VERSION}.tar.gz | tar xzv && \ + cd /chicken-${CHICKEN_VERSION} && \ + make PLATFORM=${PLATFORM} && \ + make PLATFORM=${PLATFORM} install && \ + make PLATFORM=${PLATFORM} check && \ + cd / && \ + rm -rf /chicken-${CHICKEN_VERSION} + +# install project assembly tool +COPY chicken-assemble.scm /usr/bin/chicken-assemble +RUN chicken-install clojurian:3 \ + records \ + srfi-1 \ + srfi-69 && \ + chmod a+x /usr/bin/chicken-assemble