From d784de2d8033f633bbdfeab2a4ee03559f6068b4 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sun, 20 Apr 2025 07:12:27 +0300 Subject: [PATCH] Cleanup --- Dockerfile | 13 - Makefile | 50 +-- README.md | 6 + build.scm | 59 ---- include/libtest.h | 17 - manifest.scm | 15 - retropikzel/pffi/Makefile | 42 --- snow/arvyy/mustache-impl.scm | 106 ------- snow/arvyy/mustache-test.sld | 73 ----- snow/arvyy/mustache-test/comments.scm | 56 ---- snow/arvyy/mustache-test/delimiters.scm | 75 ----- .../mustache-test/implementation-specific.scm | 71 ----- snow/arvyy/mustache-test/interpolation.scm | 199 ------------ snow/arvyy/mustache-test/inverted.scm | 147 --------- snow/arvyy/mustache-test/partials.scm | 46 --- snow/arvyy/mustache-test/sections.scm | 84 ----- snow/arvyy/mustache.sld | 27 -- snow/arvyy/mustache/collection.sld | 64 ---- snow/arvyy/mustache/executor-impl.scm | 94 ------ snow/arvyy/mustache/executor.sld | 6 - snow/arvyy/mustache/lookup.sld | 27 -- snow/arvyy/mustache/parser-impl.scm | 296 ------------------ snow/arvyy/mustache/parser.sld | 14 - snow/arvyy/mustache/tokenizer-impl.scm | 237 -------------- snow/arvyy/mustache/tokenizer.sld | 15 - src/libtest.c | 283 ----------------- templates/Jenkinsfile | 53 ---- 27 files changed, 10 insertions(+), 2165 deletions(-) delete mode 100644 Dockerfile delete mode 100644 build.scm delete mode 100644 include/libtest.h delete mode 100644 manifest.scm delete mode 100644 snow/arvyy/mustache-impl.scm delete mode 100644 snow/arvyy/mustache-test.sld delete mode 100644 snow/arvyy/mustache-test/comments.scm delete mode 100644 snow/arvyy/mustache-test/delimiters.scm delete mode 100644 snow/arvyy/mustache-test/implementation-specific.scm delete mode 100644 snow/arvyy/mustache-test/interpolation.scm delete mode 100644 snow/arvyy/mustache-test/inverted.scm delete mode 100644 snow/arvyy/mustache-test/partials.scm delete mode 100644 snow/arvyy/mustache-test/sections.scm delete mode 100644 snow/arvyy/mustache.sld delete mode 100644 snow/arvyy/mustache/collection.sld delete mode 100644 snow/arvyy/mustache/executor-impl.scm delete mode 100644 snow/arvyy/mustache/executor.sld delete mode 100644 snow/arvyy/mustache/lookup.sld delete mode 100644 snow/arvyy/mustache/parser-impl.scm delete mode 100644 snow/arvyy/mustache/parser.sld delete mode 100644 snow/arvyy/mustache/tokenizer-impl.scm delete mode 100644 snow/arvyy/mustache/tokenizer.sld delete mode 100644 src/libtest.c delete mode 100644 templates/Jenkinsfile diff --git a/Dockerfile b/Dockerfile deleted file mode 100644 index 624080b..0000000 --- a/Dockerfile +++ /dev/null @@ -1,13 +0,0 @@ -ARG COMPILE_R7RS=chibi -FROM debian:bookworm AS build -RUN apt-get update && apt-get install -y build-essential wget make cmake libgc-dev zlib1g-dev libffi-dev libssl-dev -RUN wget https://bitbucket.org/ktakashi/sagittarius-scheme/downloads/sagittarius-0.9.12.tar.gz && tar -xf sagittarius-0.9.12.tar.gz -RUN cd sagittarius-0.9.12 && mkdir build && cd build && cmake -DCMAKE_INSTALL_PREFIX=/usr/local-other .. && make && make install - -FROM schemers/${COMPILE_R7RS} -RUN apt-get update && apt-get install -y \ - git make libffi8 libgc1 libssl3 libuv1 build-essential libffi-dev -COPY --from=build /usr/local-other/ /usr/local-other/ -ENV PATH=${PATH}:/usr/local-other/bin -RUN git clone https://gitea.scheme.org/Retropikzel/compile-r7rs.git --depth=1 -RUN cd compile-r7rs && make && make install diff --git a/Makefile b/Makefile index c10e4d9..13827fb 100644 --- a/Makefile +++ b/Makefile @@ -19,61 +19,19 @@ documentation: chibi: make -C retropikzel/pffi chibi -chicken: - make -C retropikzel/pffi chicken - -cyclone: - make -C retropikzel/pffi cyclone - -gambit: - make -C retropikzel/pffi gambit - gauche: make -C retropikzel/pffi gauche -gerbil: - make -C retropikzel/pffi gerbil - -guile: - make -C retropikzel/pffi guile - -kawa: - make -C retropikzel/pffi kawa - -larceny: - make -C retropikzel/pffi larceny - -mosh: - make -C retropikzel/pffi mosh - -racket: - make -C retropikzel/pffi racket - -sagittarius: - make -C retropikzel/pffi sagittarius - -skint: - make -C retropikzel/pffi skint - -stklos: - make -C retropikzel/pffi stklos - -tr7: - make -C retropikzel/pffi tr7 - -ypsilon: - make -C retropikzel/pffi tr7 - test-compile-r7rs: tmp/test/libtest.o tmp/test/libtest.so make ${COMPILE_R7RS} cp -r retropikzel tmp/test/ cp tests/compliance.scm tmp/test/ - cp include/libtest.h tmp/test/ + cp tests/c-include/libtest.h tmp/test/ cd tmp/test && COMPILE_R7RS_CHICKEN="-L -ltest -I. -L." compile-r7rs -I . -o compliance compliance.scm cd tmp/test && LD_LIBRARY_PATH=. ./compliance test-compile-r7rs-docker: - docker build --build-arg COMPILE_R7RS=${COMPILE_R7RS} --tag=r7rs-pffi-test-${COMPILE_R7RS} . + docker build --build-arg COMPILE_R7RS=${COMPILE_R7RS} --tag=r7rs-pffi-test-${COMPILE_R7RS} -f dockerfiles/test . docker run -v "${PWD}":/workdir -w /workdir -t r7rs-pffi-test-${COMPILE_R7RS} sh -c "make COMPILE_R7RS=${COMPILE_R7RS} test-compile-r7rs" #chicken-objects: @@ -101,11 +59,11 @@ test-compile-r7rs-docker: tmp/test/libtest.o: src/libtest.c mkdir -p tmp/test - ${CC} -o tmp/test/libtest.o -fPIC -c src/libtest.c -I./include + ${CC} -o tmp/test/libtest.o -fPIC -c tests/c-src/libtest.c -I./include tmp/test/libtest.so: src/libtest.c mkdir -p tmp/test - ${CC} -o tmp/test/libtest.so -shared -fPIC src/libtest.c -I./include + ${CC} -o tmp/test/libtest.so -shared -fPIC tests/c-src/libtest.c -I./include tmp/test/libtest.a: tmp/test/libtest.o src/libtest.c ar rcs tmp/test/libtest.a tmp/test/libtest.o diff --git a/README.md b/README.md index 4739cb8..4f29688 100644 --- a/README.md +++ b/README.md @@ -268,6 +268,12 @@ in it: cd snow/retropikzel/pffi make +If make says: + + make: *** No rule to make target 'SCHEME'. Stop. + +then implementation does not need anything to be built. + #### Windows diff --git a/build.scm b/build.scm deleted file mode 100644 index d60cda1..0000000 --- a/build.scm +++ /dev/null @@ -1,59 +0,0 @@ -(import (scheme base) - (scheme write) - (scheme file) - (scheme process-context) - (arvyy mustache)) - -(define slurp-loop - (lambda (line result) - (if (eof-object? line) - result - (slurp-loop (read-line) (string-append result line (string #\newline)))))) - -(define slurp - (lambda (path) - (with-input-from-file - path - (lambda () - (slurp-loop (read-line) ""))))) - -(define script-implementations - (vector "chibi" - "chicken" - ;"cyclone" - ;"gambit" - ;"gauche" - ;"gauche-wine" - ;"gerbil" - "guile" - "kawa" - ;"meevax" - "mosh" - "racket" - ;"racket-wine" - "sagittarius" - ;"sagittarius-wine" - "stklos" - ;"skint" - ;"tr7i" - "ypsilon")) - - (define compiler-implementations - (vector "chicken" - "cyclone" - "gambit" - ;"gauche" - ;"gerbil" - "kawa" - "racket" - ;"racket-wine" - )) - -;; Jenkinsfile -(call-with-output-file - "Jenkinsfile" - (lambda (out) - (execute (compile (slurp "templates/Jenkinsfile")) - (list (cons 'script-implementations script-implementations) - (cons 'compiler-implementations compiler-implementations)) - out))) diff --git a/include/libtest.h b/include/libtest.h deleted file mode 100644 index 3a42d3b..0000000 --- a/include/libtest.h +++ /dev/null @@ -1,17 +0,0 @@ -void print_string_pointer(char* p); -void print_offsets(); -void check_offset(int member_index, int offset); -struct test* init_struct(struct test* test); -struct color { - int8_t r; - int8_t g; - int8_t b; - int8_t a; -}; -int color_check(struct color* test); -int color_check_by_value(struct color color); -int test_check(struct test* test); -int test_check_by_value(struct test test); -struct test* test_new(); -void takes_no_args(); -int takes_no_args_returns_int(); diff --git a/manifest.scm b/manifest.scm deleted file mode 100644 index 2e47cf7..0000000 --- a/manifest.scm +++ /dev/null @@ -1,15 +0,0 @@ -;; What follows is a "manifest" equivalent to the command line you gave. -;; You can store it in a file that you may then pass to any 'guix' command -;; that accepts a '--manifest' (or '-m') option. - -(specifications->manifest (list "gcc-toolchain" - "libffi" - "chibi-scheme" - "chicken" - "guile-next" - "gambit-c" - "gerbil" - "racket" - "mosh" - "stklos" - "openjdk")) diff --git a/retropikzel/pffi/Makefile b/retropikzel/pffi/Makefile index c9f6bde..f1430c2 100644 --- a/retropikzel/pffi/Makefile +++ b/retropikzel/pffi/Makefile @@ -4,15 +4,6 @@ chibi: chibi-src/pffi.stub chibi-ffi chibi-src/pffi.stub ${CC} -g3 -o chibi-pffi.so chibi-src/pffi.c -fPIC -lffi -shared -chicken: - @echo "Nothing to build for Chicken" - -cyclone: - @echo "Nothing to build for Cyclone" - -gambit: - @echo "Nothing to build for Gambit" - gauche: gauche-src/gauche-pffi.c gauche-src/gauchelib.scm gauche-package compile \ --srcdir=gauche-src \ @@ -20,36 +11,3 @@ gauche: gauche-src/gauche-pffi.c gauche-src/gauchelib.scm --cflags="-I./include" \ --libs=-lffi \ gauche-pffi gauche-pffi.c gauchelib.scm - -gerbil: - @echo "Nothing to build for Gerbil" - -guile: - @echo "Nothing to build for Guile" - -kawa: - @echo "Nothing to build for Kawa" - -larceny: - @echo "Nothing to build for Larceny" - -mosh: - @echo "Nothing to build for Mosh" - -racket: - @echo "Nothing to build for Racket" - -sagittarius: - @echo "Nothing to build for Sagittarius" - -skint: - @echo "Nothing to build for Skint" - -stklos: - @echo "Nothing to build for Stklos" - -tr7: - @echo "Nothing to build for tr7" - -ypsilon: - @echo "Nothing to build for Ypsilon" diff --git a/snow/arvyy/mustache-impl.scm b/snow/arvyy/mustache-impl.scm deleted file mode 100644 index fc2156a..0000000 --- a/snow/arvyy/mustache-impl.scm +++ /dev/null @@ -1,106 +0,0 @@ -(define (default-writer obj out) - (when obj - (display obj out))) - -(define default-lookup - (compose-lookups - alist-lookup)) - -(define default-collection - (compose-collections - vector-collection - stream-collection)) - -(define (port->string port) - (define str - (let loop ((chunks '()) - (chunk (read-string 2000 port))) - (if (eof-object? chunk) - (apply string-append (reverse chunks)) - (loop (cons chunk chunks) - (read-string 2000 port))))) - (close-input-port port) - str) - -(define (template-get-partials template) - (define partials - (let loop ((template template) - (parts '())) - (cond - ((null? template) parts) - (else (let ((t (car template)) - (rest (cdr template))) - (cond - ((partial? t) (loop rest - (cons (partial-name t) parts))) - ((section? t) (loop rest - (append (template-get-partials (section-content t)) - parts))) - (else (loop rest - parts)))))))) - (delete-duplicates! partials)) - -(define compile - (case-lambda - ((template) (compile/without-partials template)) - ((root partial-locator) (compile/with-partials root partial-locator)))) - -(define (compile/without-partials template) - (compile/with-partials #f (lambda (partial) - (if partial - #f - template)))) - -(define (compile/with-partials root partial-locator) - - ;; returns 2 values: missing partials (found in part) and compiled part template - (define (compile-part part resolved-partials) - (define source (partial-locator part)) - (define in (cond - ((not source) "") - ((string? source) source) - ((port? source) (port->string source)) - (else (error "Partial locator returned unrecognized type")))) - (define template (parse (read-tokens in))) - (define partials (template-get-partials template)) - (define missing-partials (lset-difference string=? partials resolved-partials)) - (values missing-partials template)) - - (let loop ((unresolved (list root)) - (resolved-map '()) - (resolved-lst '())) - (cond - ((null? unresolved) (cons root resolved-map)) - (else (let ((part (car unresolved))) - (define-values (unresolved* template) - (compile-part part resolved-lst)) - (loop (append unresolved* (cdr unresolved)) - (cons (cons part template) resolved-map) - (cons part resolved-lst))))))) - -(define current-lookup (make-parameter default-lookup)) -(define current-collection (make-parameter default-collection)) -(define current-writer (make-parameter default-writer)) - -(define execute - (case-lambda - ((compilation data) - (let ((out (open-output-string))) - (execute compilation data out) - (get-output-string out))) - ((compilation data out) - (define root (car compilation)) - (define partials (cdr compilation)) - (define template (cdr (assoc root partials))) - (define lookup (current-lookup)) - (define collection* (current-collection)) - (define writer (current-writer)) - (executor-execute template - (list data) - partials - out - lookup - (collection-pred-proc collection*) - (collection-empty?-proc collection*) - (collection-for-each-proc collection*) - writer)))) diff --git a/snow/arvyy/mustache-test.sld b/snow/arvyy/mustache-test.sld deleted file mode 100644 index 02f600e..0000000 --- a/snow/arvyy/mustache-test.sld +++ /dev/null @@ -1,73 +0,0 @@ -(define-library - (arvyy mustache-test) - - (import (scheme base) - (scheme write) - (arvyy mustache) - (srfi 41)) - - (export run-tests) - - (cond-expand - (chibi - (import (rename (except (chibi test) test-equal) - (test test-equal)))) - ((library (srfi 64)) - (import (srfi 64))) - (else (error "No testing library found"))) - - (begin - (define-syntax test-mustache - (syntax-rules () - ((_ name data template expected) - (test-equal name expected (execute (compile "foo" (lambda args template)) data))) - ((_ name data partials template expected) - (let* ((partials* (cons (cons "root" template) partials)) - (fn (lambda (n) - (cond - ((assoc n partials*) => cdr) - (else #f))))) - (test-equal name expected (execute (compile "root" fn) data))))))) - - (include "mustache-test/comments.scm" - "mustache-test/delimiters.scm" - "mustache-test/implementation-specific.scm" - "mustache-test/interpolation.scm" - "mustache-test/inverted.scm" - "mustache-test/partials.scm" - "mustache-test/sections.scm") - - (begin - - (define (run-tests) - (test-begin "mustache") - - (test-group - "comments" - (run-tests/comments)) - - (test-group - "delimiters" - (run-tests/delimiters)) - - (test-group - "interpolation" - (run-tests/interpolation)) - - (test-group - "inverted" - (run-tests/inverted)) - - (test-group - "partials" - (run-tests/partials)) - - (test-group - "sections" - (run-tests/sections)) - - (test-group - "implementation-specific" - (run-tests/implementation-specific)) - - (test-end)))) diff --git a/snow/arvyy/mustache-test/comments.scm b/snow/arvyy/mustache-test/comments.scm deleted file mode 100644 index 7eb77b8..0000000 --- a/snow/arvyy/mustache-test/comments.scm +++ /dev/null @@ -1,56 +0,0 @@ -(define (run-tests/comments) - (test-mustache "Inline" - '() - "12345{{! Comment Block! }}67890" - "1234567890") - - (test-mustache "Multiline" - '() - "12345{{!\n This is a\n multi-line comment...\n}}67890" - "1234567890") - - (test-mustache "Standalone" - '() - "Begin.\n{{! Comment Block! }}\nEnd." - "Begin.\nEnd.") - - (test-mustache "Indented Standalone" - '() - "Begin.\n {{! Comment Block! }}\nEnd." - "Begin.\nEnd.") - - (test-mustache "Standalone Line Endings" - '() - "\r\n{{! Standalone Comment }}\r\n" - "\r\n") - - (test-mustache "Standalone Without Previous Line" - '() - " {{! I'm Still Standalone }}\n!" - "!") - - (test-mustache "Standalone Without Newline" - '() - "!\n {{! I'm Still Standalone }}" - "!\n") - - (test-mustache "Multiline Standalone" - '() - "Begin.\n{{!\nSomething's going on here...\n}}\nEnd." - "Begin.\nEnd.") - - (test-mustache "Indented Multiline Standalone" - '() - "Begin.\n {{!\n Something's going on here...\n }}\nEnd." - "Begin.\nEnd.") - - (test-mustache "Indented Inline" - '() - " 12 {{! 34 }}\n" - " 12 \n") - - (test-mustache "Surrounding Whitespace" - '() - "12345 {{! Comment Block! }} 67890" - "12345 67890")) - diff --git a/snow/arvyy/mustache-test/delimiters.scm b/snow/arvyy/mustache-test/delimiters.scm deleted file mode 100644 index 455a932..0000000 --- a/snow/arvyy/mustache-test/delimiters.scm +++ /dev/null @@ -1,75 +0,0 @@ -(define (run-tests/delimiters) - - (test-mustache "Pair Behavior" - '((text . "Hey!")) - "{{=<% %>=}}(<%text%>)" - "(Hey!)") - - (test-mustache "Special Characters" - '((text . "It worked!")) - "({{=[ ]=}}[text])" - "(It worked!)") - - (test-mustache "Sections" - '((section . #t) - (data . "I got interpolated.")) - "[\n{{#section}}\n {{data}}\n |data|\n{{/section}}\n\n{{= | | =}}\n|#section|\n {{data}}\n |data|\n|/section|\n]\n" - "[\n I got interpolated.\n |data|\n\n {{data}}\n I got interpolated.\n]\n") - - (test-mustache "Inverted Sections" - '((section . #f) - (data . "I got interpolated.")) - "[\n{{^section}}\n {{data}}\n |data|\n{{/section}}\n\n{{= | | =}}\n|^section|\n {{data}}\n |data|\n|/section|\n]\n" - "[\n I got interpolated.\n |data|\n\n {{data}}\n I got interpolated.\n]\n") - - (test-mustache "Partial Inheritence" - '((value . "yes")) - '(("include" . ".{{value}}.")) - "[ {{>include}} ]\n{{= | | =}}\n[ |>include| ]\n" - "[ .yes. ]\n[ .yes. ]\n") - - (test-mustache "Post-Partial Behavior" - '((value . "yes")) - '(("include" . ".{{value}}. {{= | | =}} .|value|.")) - "[ {{>include}} ]\n[ .{{value}}. .|value|. ]\n" - "[ .yes. .yes. ]\n[ .yes. .|value|. ]\n") - - (test-mustache "Surrounding Whitespace" - '() - "| {{=@ @=}} |" - "| |") - - (test-mustache "Outlying Whitespace (Inline)" - '() - " | {{=@ @=}}\n" - " | \n") - - (test-mustache "Standalone Tag" - '() - "Begin.\n{{=@ @=}}\nEnd.\n" - "Begin.\nEnd.\n") - - (test-mustache "Indented Standalone Tag" - '() - "Begin.\n {{=@ @=}}\nEnd.\n" - "Begin.\nEnd.\n") - - (test-mustache "Standalone Line Endings" - '() - "|\r\n{{= @ @ =}}\r\n|" - "|\r\n|") - - (test-mustache "Standalone Without Previous Line" - '() - " {{=@ @=}}\n=" - "=") - - (test-mustache "Standalone Without Newline" - '() - "=\n {{=@ @=}}" - "=\n") - - (test-mustache "Pair with Padding" - '() - "|{{= @ @ =}}|" - "||")) diff --git a/snow/arvyy/mustache-test/implementation-specific.scm b/snow/arvyy/mustache-test/implementation-specific.scm deleted file mode 100644 index 5f11aa2..0000000 --- a/snow/arvyy/mustache-test/implementation-specific.scm +++ /dev/null @@ -1,71 +0,0 @@ -(define-record-type (foo bar) foo? (bar foo-bar)) - -(define (run-tests/implementation-specific) - (define (foo-lookup obj name found not-found) - (cond - ((not (foo? obj)) (not-found)) - ((string=? "bar" name) (found (foo-bar obj))) - (else (not-found)))) - - (define alist+foo (compose-lookups alist-lookup foo-lookup)) - - (define (write-foo obj out) - (write-string "(foo " out) - (display (foo-bar obj) out) - (write-string ")" out)) - - (define-record-type (num-lst count) num-lst? (count num-lst-count)) - (define num-lst-collection - (collection - num-lst? - (lambda (obj) (= 0 (num-lst-count obj))) - (lambda (proc obj) - (define target (num-lst-count obj)) - (let loop ((i 0)) - (when (< i target) - (begin - (proc i) - (loop (+ 1 i)))))))) - - (parameterize - ((current-writer (lambda (obj out) - (cond - ((not obj) #t) - ((foo? obj) (write-foo obj out)) - (else (display obj out)))))) - (test-mustache "Custom writer" - `((obj . ,(foo "baz"))) - "Test {{obj}}" - "Test (foo baz)")) - - (parameterize - ((current-lookup alist+foo)) - (test-mustache "Custom lookup" - `((a . ((bar . "baz1"))) - (b . ,(foo "baz2"))) - "{{a.bar}}, {{b.bar}}" - "baz1, baz2")) - - (parameterize - ((current-collection num-lst-collection)) - (test-mustache "Custom collection" - `((a . ,(num-lst 3))) - "{{#a}}{{.}};{{/a}}" - "0;1;2;")) - - (parameterize - ((current-collection list-collection) - (current-lookup foo-lookup)) - (test-mustache "List collection" - (foo '(0 1 2)) - "{{#bar}}{{.}};{{/bar}}" - "0;1;2;")) - - (parameterize - ((current-collection stream-collection) - (current-lookup foo-lookup)) - (test-mustache "Stream collection" - (foo (list->stream '(0 1 2))) - "{{#bar}}{{.}};{{/bar}}" - "0;1;2;"))) - diff --git a/snow/arvyy/mustache-test/interpolation.scm b/snow/arvyy/mustache-test/interpolation.scm deleted file mode 100644 index 4022d32..0000000 --- a/snow/arvyy/mustache-test/interpolation.scm +++ /dev/null @@ -1,199 +0,0 @@ -(define (run-tests/interpolation) - - (test-mustache "No Interpolation" - '() - "Hello from {Mustache}!" - "Hello from {Mustache}!") - - (test-mustache "Basic Interpolation" - '((subject . "world")) - "Hello, {{subject}}!" - "Hello, world!") - - (test-mustache "HTML Escaping" - '((forbidden . "& \" < >")) - "These characters should be HTML escaped: {{forbidden}}" - "These characters should be HTML escaped: & " < >") - - (test-mustache "Triple Mustache" - '((forbidden . "& \" < >")) - "These characters should not be HTML escaped: {{{forbidden}}}" - "These characters should not be HTML escaped: & \" < >") - - (test-mustache "Ampersand" - '((forbidden . "& \" < >")) - "These characters should not be HTML escaped: {{&forbidden}}" - "These characters should not be HTML escaped: & \" < >") - - (test-mustache "Basic Integer Interpolation" - '((mph . 85)) - "\"{{mph}} miles an hour!\"" - "\"85 miles an hour!\"") - - (test-mustache "Triple Mustache Integer Interpolation" - '((mph . 85)) - "\"{{{mph}}} miles an hour!\"" - "\"85 miles an hour!\"") - - (test-mustache "Ampersand Mustache Integer Interpolation" - '((mph . 85)) - "\"{{&mph}} miles an hour!\"" - "\"85 miles an hour!\"") - - (test-mustache "Basic Decimal Interpolation" - '((power . 1.210)) - "\"{{power}} jiggawatts!\"" - "\"1.21 jiggawatts!\"") - - (test-mustache "Triple Mustache Decimal Interpolation" - '((power . 1.210)) - "\"{{{power}}} jiggawatts!\"" - "\"1.21 jiggawatts!\"") - - (test-mustache "Ampersand Mustache Decimal Interpolation" - '((power . 1.210)) - "\"{{&power}} jiggawatts!\"" - "\"1.21 jiggawatts!\"") - - (test-mustache "Basic Null Interpolation" - '((cannot . #f)) - "I ({{cannot}}) be seen!" - "I () be seen!") - - (test-mustache "Triple Mustache Null Interpolation" - '((cannot . #f)) - "I ({{{cannot}}}) be seen!" - "I () be seen!") - - (test-mustache "Ampersand Null Interpolation" - '((cannot . #f)) - "I ({{&cannot}}) be seen!" - "I () be seen!") - - (test-mustache "Basic Context Miss Interpolation" - '() - "I ({{cannot}}) be seen!" - "I () be seen!") - - (test-mustache "Triple Mustache Context Miss Interpolation" - '() - "I ({{{cannot}}}) be seen!" - "I () be seen!") - - (test-mustache "Ampersand Context Miss Interpolation" - '() - "I ({{&cannot}}) be seen!" - "I () be seen!") - - (test-mustache "Dotted Names - Basic Interpolation" - '((person . ((name . "Joe")))) - "\"{{person.name}}\" == \"{{#person}}{{name}}{{/person}}\"" - "\"Joe\" == \"Joe\"") - - (test-mustache "Dotted Names - Triple Mustache Interpolation" - '((person . ((name . "Joe")))) - "\"{{{person.name}}}\" == \"{{#person}}{{{name}}}{{/person}}\"" - "\"Joe\" == \"Joe\"") - - (test-mustache "Dotted Names - Ampersand Interpolation" - '((person . ((name . "Joe")))) - "\"{{&person.name}}\" == \"{{#person}}{{&name}}{{/person}}\"" - "\"Joe\" == \"Joe\"") - - (test-mustache "Dotted Names - Arbitrary Depth" - '((a . ((b . ((c . ((d . ((e . ((name . "Phil")))))))))))) - "\"{{a.b.c.d.e.name}}\" == \"Phil\"" - "\"Phil\" == \"Phil\"") - - (test-mustache "Dotted Names - Broken Chains" - '((a . ())) - "\"{{a.b.c}}\" == \"\"" - "\"\" == \"\"") - - (test-mustache "Dotted Names - Broken Chain Resolution" - '((a . ((b . ()))) - (c . ((name . "Jim")))) - "\"{{a.b.c.name}}\" == \"\"" - "\"\" == \"\"") - - (test-mustache "Dotted Names - Initial Resolution" - '((a . ((b . ((c . ((d . ((e . ((name . "Phil"))))))))))) - (b . ((c . ((d . ((e . ((name . "Wrong")))))))))) - "\"{{#a}}{{b.c.d.e.name}}{{/a}}\" == \"Phil\"" - "\"Phil\" == \"Phil\"") - - (test-mustache "Dotted Names - Context Precedence" - '((a . ((b . ()))) - (b . ((c . "ERROR")))) - "{{#a}}{{b.c}}{{/a}}" - "") - - (test-mustache "Implicit Iterators - Basic Interpolation" - "world" - "Hello, {{.}}!" - "Hello, world!") - - (test-mustache "Implicit Iterators - HTML Escaping" - "& \" < >" - "These characters should be HTML escaped: {{.}}" - "These characters should be HTML escaped: & " < >") - - (test-mustache "Implicit Iterators - Triple Mustache" - "& \" < >" - "These characters should not be HTML escaped: {{{.}}}" - "These characters should not be HTML escaped: & \" < >") - - (test-mustache "Implicit Iterators - Ampersand" - "& \" < >" - "These characters should not be HTML escaped: {{&.}}" - "These characters should not be HTML escaped: & \" < >") - - (test-mustache "Implicit Iterators - Basic Integer Interpolation" - 85 - "\"{{.}} miles an hour!\"" - "\"85 miles an hour!\"") - - (test-mustache "Interpolation - Surrounding Whitespace" - '((string . "---")) - "| {{string}} |" - "| --- |") - - (test-mustache "Triple Mustache - Surrounding Whitespace" - '((string . "---")) - "| {{{string}}} |" - "| --- |") - - (test-mustache "Ampersand - Surrounding Whitespace" - '((string . "---")) - "| {{&string}} |" - "| --- |") - - (test-mustache "Interpolation - Standalone" - '((string . "---")) - " {{string}}\n" - " ---\n") - - (test-mustache "Triple Mustache - Standalone" - '((string . "---")) - " {{{string}}}\n" - " ---\n") - - (test-mustache "Ampersand - Standalone" - '((string . "---")) - " {{&string}}\n" - " ---\n") - - (test-mustache "Interpolation With Padding" - '((string . "---")) - "|{{ string }}|" - "|---|") - - (test-mustache "Triple Mustache With Padding" - '((string . "---")) - "|{{{ string }}}|" - "|---|") - - (test-mustache "Ampersand With Padding" - '((string . "---")) - "|{{& string }}|" - "|---|")) diff --git a/snow/arvyy/mustache-test/inverted.scm b/snow/arvyy/mustache-test/inverted.scm deleted file mode 100644 index f5f68ea..0000000 --- a/snow/arvyy/mustache-test/inverted.scm +++ /dev/null @@ -1,147 +0,0 @@ -(define (run-tests/inverted) - - (test-mustache "Falsey" - '((boolean . #f)) - "\"{{^boolean}}This should be rendered.{{/boolean}}\"" - "\"This should be rendered.\"") - - (test-mustache "Truthy" - '((boolean . #t)) - "\"{{^boolean}}This should not be rendered.{{/boolean}}\"" - "\"\"") - - ;; "Null is falsey" test is skipped; no meaningful value for null - - (test-mustache "Context" - '((context . ((name . "Joe")))) - "\"{{^context}}Hi {{name}}.{{/context}}\"" - "\"\"") - - (test-mustache "List" - '(list . #(((n . 1)) - ((n . 2)) - ((n . 3)))) - "\"{{^list}}{{n}}{{/list}}\"" - "\"\"") - - (test-mustache "Empty List" - '(list . #()) - "\"{{^list}}Yay lists!{{/list}}\"" - "\"Yay lists!\"") - - (test-mustache "Doubled" - '((bool . #f) (two . "second")) - " - {{^bool}} - * first - {{/bool}} - * {{two}} - {{^bool}} - * third - {{/bool}} - " - " - * first - * second - * third - ") - - (test-mustache "Nested (Falsey)" - '((bool . #f)) - "| A {{^bool}}B {{^bool}}C{{/bool}} D{{/bool}} E |" - "| A B C D E |") - - (test-mustache "Nested (Truthy)" - '((bool . #t)) - "| A {{^bool}}B {{^bool}}C{{/bool}} D{{/bool}} E |" - "| A E |") - - (test-mustache "Context Misses" - '(()) - "[{{^missing}}Cannot find key 'missing'!{{/missing}}]" - "[Cannot find key 'missing'!]") - - (test-mustache "Dotted Names - Truthy" - '((a . ((b . ((c . #t)))))) - "\"{{^a.b.c}}Not Here{{/a.b.c}}\" == \"\"" - "\"\" == \"\"") - - (test-mustache "Dotted Names - Falsey" - '((a . ((b . ((c . #f)))))) - "\"{{^a.b.c}}Not Here{{/a.b.c}}\" == \"Not Here\"" - "\"Not Here\" == \"Not Here\"") - - (test-mustache "Dotted Names - Broken Chains" - '((a . ())) - "\"{{^a.b.c}}Not Here{{/a.b.c}}\" == \"Not Here\"" - "\"Not Here\" == \"Not Here\"") - - (test-mustache "Surrounding Whitespace" - '((boolean . #f)) - " | {{^boolean}}\t|\t{{/boolean}} | \n" - " | \t|\t | \n") - - (test-mustache "Internal Whitespace" - '((boolean . #f)) - " | {{^boolean}} {{! Important Whitespace }}\n {{/boolean}} | \n" - " | \n | \n") - - (test-mustache "Indented Inline Sections" - '((boolean . #f)) - " {{^boolean}}NO{{/boolean}}\n {{^boolean}}WAY{{/boolean}}\n" - " NO\n WAY\n") - - (test-mustache "Standalone Lines" - '((boolean . #f)) - " - | - | This Is - {{^boolean}} - | - {{/boolean}} - | A Line - " - " - | - | This Is - | - | A Line - ") - - (test-mustache "Standalone Indented Lines" - '((boolean . #f)) - " - | - | This Is - {{^boolean}} - | - {{/boolean}} - | A Line - " - " - | - | This Is - | - | A Line - ") - - (test-mustache "Standalone Line Endings" - '((boolean . #f)) - "|\r\n{{^boolean}}\r\n{{/boolean}}\r\n|" - "|\r\n|") - - (test-mustache "Standalone Without Previous Line" - '((boolean . #f)) - " {{^boolean}}\n^{{/boolean}}\n/" - "^\n/") - - (test-mustache "Standalone Without Newline" - '((boolean . #f)) - "^{{^boolean}}\n/\n {{/boolean}}" - "^\n/\n") - - (test-mustache "Padding" - '((boolean . #f)) - "|{{^ boolean }}={{/ boolean }}|" - "|=|")) - diff --git a/snow/arvyy/mustache-test/partials.scm b/snow/arvyy/mustache-test/partials.scm deleted file mode 100644 index af82f05..0000000 --- a/snow/arvyy/mustache-test/partials.scm +++ /dev/null @@ -1,46 +0,0 @@ -(define (run-tests/partials) - - (test-mustache "Basic Behavior" - '() - '(("text" . "from partial")) - "\"{{>text}}\"" - "\"from partial\"") - - (test-mustache "Failed Lookup" - '() - '() - "\"{{>text}}\"" - "\"\"") - - (test-mustache "Context" - '((text . "content")) - '(("partial" . "*{{text}}*")) - "\"{{>partial}}\"" - "\"*content*\"") - - (test-mustache "Recursion" - '((content . "X") - (nodes . #(((content . "Y") - (nodes . #()))))) - '(("node" . "{{content}}<{{#nodes}}{{>node}}{{/nodes}}>")) - "{{>node}}" - "X>") - - (test-mustache "Surrounding Whitespace" - '() - '(("partial" . "\t|\t")) - "| {{>partial}} |" - "| \t|\t |") - - (test-mustache "Inline Indentation" - '((data . "|")) - '(("partial" . ">\n>")) - " {{data}} {{> partial}}\n" - " | >\n>\n") - - (test-mustache "Standalone Line Endings" - '() - '(("partial" . ">")) - "|\r\n{{>partial}}\r\n|" - "|\r\n>|")) - diff --git a/snow/arvyy/mustache-test/sections.scm b/snow/arvyy/mustache-test/sections.scm deleted file mode 100644 index 10534e1..0000000 --- a/snow/arvyy/mustache-test/sections.scm +++ /dev/null @@ -1,84 +0,0 @@ -(define (run-tests/sections) - (test-mustache "Truthy" - '((boolean . #t)) - "\"{{#boolean}}This should be rendered.{{/boolean}}\"" - "\"This should be rendered.\"") - - (test-mustache "Falsey" - '((boolean . #f)) - "\"{{#boolean}}This should not be rendered.{{/boolean}}\"" - "\"\"") - - ;; "Null is falsey" test is skipped; no meaningful value for null - - (test-mustache "Context" - '((context . ((name . "Joe")))) - "\"{{#context}}Hi {{name}}.{{/context}}\"" - "\"Hi Joe.\"") - - (test-mustache "Parent contexts" - '((a . "foo") - (b . "wrong") - (sec . ((b . "bar"))) - (c . ((d . "baz")))) - "\"{{#sec}}{{a}}, {{b}}, {{c.d}}{{/sec}}\"" - "\"foo, bar, baz\"") - - (test-mustache "Variable test" - '((foo . "bar")) - "\"{{#foo}}{{.}} is {{foo}}{{/foo}}\"" - "\"bar is bar\"") - - (test-mustache "List Contexts" - '((tops . #(((tname . ((upper . "A") - (lower . "a"))) - (middles . #(((mname . "1") - (bottoms . #(((bname . "x")) - ((bname . "y"))))))))))) - "{{#tops}}{{#middles}}{{tname.lower}}{{mname}}.{{#bottoms}}{{tname.upper}}{{mname}}{{bname}}.{{/bottoms}}{{/middles}}{{/tops}}" - "a1.A1x.A1y.") - - (test-mustache "Deeply Nested Contexts" - '((a . ((one . 1))) - (b . ((two . 2))) - (c . ((three . 3) - (d . ((four . 4) - (five . 5)))))) - " - {{#a}} - {{one}} - {{#b}} - {{one}}{{two}}{{one}} - {{#c}} - {{one}}{{two}}{{three}}{{two}}{{one}} - {{#d}} - {{one}}{{two}}{{three}}{{four}}{{three}}{{two}}{{one}} - {{#five}} - {{one}}{{two}}{{three}}{{four}}{{five}}{{four}}{{three}}{{two}}{{one}} - {{one}}{{two}}{{three}}{{four}}{{.}}6{{.}}{{four}}{{three}}{{two}}{{one}} - {{one}}{{two}}{{three}}{{four}}{{five}}{{four}}{{three}}{{two}}{{one}} - {{/five}} - {{one}}{{two}}{{three}}{{four}}{{three}}{{two}}{{one}} - {{/d}} - {{one}}{{two}}{{three}}{{two}}{{one}} - {{/c}} - {{one}}{{two}}{{one}} - {{/b}} - {{one}} - {{/a}} - " - " - 1 - 121 - 12321 - 1234321 - 123454321 - 12345654321 - 123454321 - 1234321 - 12321 - 121 - 1 - " - )) - diff --git a/snow/arvyy/mustache.sld b/snow/arvyy/mustache.sld deleted file mode 100644 index 42aea6f..0000000 --- a/snow/arvyy/mustache.sld +++ /dev/null @@ -1,27 +0,0 @@ -(define-library - (arvyy mustache) - (import (scheme base) - (scheme case-lambda) - (scheme write) - (arvyy mustache lookup) - (arvyy mustache collection) - (prefix (arvyy mustache executor) executor-) - (arvyy mustache parser) - (arvyy mustache tokenizer) - (srfi 1)) - (export - execute - compile - current-lookup - current-collection - current-writer - - compose-lookups - alist-lookup - - collection - compose-collections - vector-collection - list-collection - stream-collection) - (include "mustache-impl.scm")) diff --git a/snow/arvyy/mustache/collection.sld b/snow/arvyy/mustache/collection.sld deleted file mode 100644 index 1688a1a..0000000 --- a/snow/arvyy/mustache/collection.sld +++ /dev/null @@ -1,64 +0,0 @@ -(define-library - (arvyy mustache collection) - (import (scheme base) - (srfi 41)) - (export - collection - collection-pred-proc - collection-empty?-proc - collection-for-each-proc - - compose-collections - vector-collection - stream-collection - list-collection) - (begin - - (define-record-type - (collection pred-proc empty?-proc for-each-proc) - collection? - (pred-proc collection-pred-proc) - (empty?-proc collection-empty?-proc) - (for-each-proc collection-for-each-proc)) - - (define vector-collection - (collection vector? - (lambda (v) (= 0 (vector-length v))) - vector-for-each)) - - (define list-collection - (collection list? - null? - for-each)) - - (define stream-collection - (collection stream? - stream-null? - stream-for-each)) - - (define (compose-collections . collections) - (define (find-collection object) - (let loop ((collections collections)) - (cond - ((null? collections) - #f) - (((collection-pred-proc (car collections)) object) - (car collections)) - (else (loop (cdr collections)))))) - - (collection - ;; predicate - (lambda (object) - (cond - ((find-collection object) #t) - (else #f))) - ;; empty proc - (lambda (object) - (cond - ((find-collection object) => (lambda (c) ((collection-empty?-proc c) object))) - (else (error "Collection not found")))) - ;; for-each proc - (lambda (proc object) - (cond - ((find-collection object) => (lambda (c) ((collection-for-each-proc c) proc object))) - (else (error "Collection not found")))))))) diff --git a/snow/arvyy/mustache/executor-impl.scm b/snow/arvyy/mustache/executor-impl.scm deleted file mode 100644 index 08bdf95..0000000 --- a/snow/arvyy/mustache/executor-impl.scm +++ /dev/null @@ -1,94 +0,0 @@ -(define (html-escape writer value) - (define str-value - (let ((out (open-output-string))) - (writer value out) - (get-output-string out))) - (define out (open-output-string)) - (string-for-each - (lambda (char) - (case char - ((#\&) (write-string "&" out)) - ((#\<) (write-string "<" out)) - ((#\>) (write-string ">" out)) - ((#\") (write-string """ out)) - (else (write-char char out)))) - str-value) - (get-output-string out)) - -(define (lookup-in-stack-single name objs-stack lookup) - (let loop ((objs objs-stack)) - (if (null? objs) - (values objs #f) - (lookup (car objs) - name - (lambda (value) (values objs value)) - (lambda () (loop (cdr objs))))))) - -(define (lookup-in-stack name-lst objs-stack lookup) - (define-values (objs value) - (lookup-in-stack-single (car name-lst) objs-stack lookup)) - (cond - ((not value) #f) - ((null? (cdr name-lst)) value) - (else (lookup-in-stack (cdr name-lst) - (list value) - lookup)))) - -(define (execute template objs-stack partials out lookup collection? collection-empty? collection-for-each writer) - (define (execute-h template indent objs-stack) - (for-each - (lambda (fragment) - (cond - ((string? fragment) - (write-string fragment out)) - ((new-line? fragment) - (begin - (write-string (new-line-content fragment) out) - (write-string (make-string indent #\space) out))) - ((interp? fragment) - (let* ((name (interp-ref fragment)) - (value (if (equal? '(".") name) - (car objs-stack) - (lookup-in-stack name - objs-stack - lookup)))) - (if (interp-escape? fragment) - (write-string (html-escape writer value) out) - (writer value out)))) - - ((section? fragment) - (let ((value (lookup-in-stack (section-ref fragment) - objs-stack - lookup)) - (inner-template (section-content fragment))) - - (cond - ((not value) - (when (section-invert? fragment) - (execute-h inner-template indent objs-stack))) - ((not (collection? value)) - (unless (section-invert? fragment) - (execute-h inner-template indent (cons value objs-stack)))) - (else - (if (section-invert? fragment) - (when (collection-empty? value) - (execute-h inner-template indent objs-stack)) - (collection-for-each - (lambda (el) - (execute-h inner-template indent (cons el objs-stack))) - value)))))) - - ((partial? fragment) - (let () - (define partial-tpl - (cond - ((assoc (partial-name fragment) partials) => cdr) - (else #f))) - (when partial-tpl - (execute-h partial-tpl - (+ indent (partial-indent fragment)) - objs-stack) ))) - - (else (error "Unknown fragment")))) - template)) - (execute-h template 0 objs-stack)) diff --git a/snow/arvyy/mustache/executor.sld b/snow/arvyy/mustache/executor.sld deleted file mode 100644 index 47e013b..0000000 --- a/snow/arvyy/mustache/executor.sld +++ /dev/null @@ -1,6 +0,0 @@ -(define-library - (arvyy mustache executor) - (import (scheme base) - (arvyy mustache parser)) - (export execute) - (include "executor-impl.scm")) diff --git a/snow/arvyy/mustache/lookup.sld b/snow/arvyy/mustache/lookup.sld deleted file mode 100644 index 4d9135d..0000000 --- a/snow/arvyy/mustache/lookup.sld +++ /dev/null @@ -1,27 +0,0 @@ -(define-library - (arvyy mustache lookup) - (import (scheme base)) - (export - compose-lookups - alist-lookup) - (begin - - (define (compose-lookups . lookups) - (lambda (obj name found not-found) - (let loop ((lookups lookups)) - (if (null? lookups) - (not-found) - (let ((l (car lookups))) - (l obj name found (lambda () - (loop (cdr lookups))))))))) - - (define (alist-lookup obj name found not-found) - (define key (string->symbol name)) - (define alist? (and (list? obj) - (or (null? obj) - (pair? (car obj))))) - (if alist? - (cond - ((assoc key obj) => (lambda (pair) (found (cdr pair)))) - (else (not-found))) - (not-found))))) diff --git a/snow/arvyy/mustache/parser-impl.scm b/snow/arvyy/mustache/parser-impl.scm deleted file mode 100644 index 8a90cc7..0000000 --- a/snow/arvyy/mustache/parser-impl.scm +++ /dev/null @@ -1,296 +0,0 @@ -(define-record-type - (interp ref escape?) - interp? - (ref interp-ref) - (escape? interp-escape?) ;; should html be escaped - ) - -(define-record-type
- (section ref invert? content raw-content) - section? - (ref section-ref) - (invert? section-invert?) ;; normal section if false, {{^ section if true - (content section-content) ;; compiled inner content - (raw-content section-raw-content) ;; uncompiled inner content as a string; used for lambdas - ) - -(define-record-type - (partial name indent) - partial? - (name partial-name) - (indent partial-indent)) - -(define-record-type - (new-line content) - new-line? - (content new-line-content)) - -(define (parse tokens) - (let* ((tokens (replace-standalone tokens)) - (tokens (remove-non-visible tokens)) - (tokens (convert-string-tokens tokens)) - (tokens (parse-interp+sections tokens))) - tokens)) - -(define (tpl->string tokens) - (define (->string item out) - (cond - ((string? item) (write-string item out)) - ((new-line? item) (write-string (new-line-content item) out)) - ((section? item) - (let ((tagname (list->tagname (section-ref item)))) - (write-string (if (section-invert? item) "{{^" "{{#") out) - (write-string tagname out) - (write-string "}}" out) - (for-each - (lambda (item*) - (->string item* out)) - (section-content item)) - (write-string "{{/" out) - (write-string tagname out) - (write-string "}}" out))) - ((interp? item) - (let ((tagname (list->tagname (interp-ref item)))) - (write-string (if (interp-escape? item) "{{" "{{&") out) - (write-string tagname out) - (write-string "}}" out))))) - (define out (open-output-string)) - (for-each - (lambda (item) (->string item out)) - tokens) - (get-output-string out)) - -;;TODO remove this -(define (debug-tokens tokens) - (for-each - (lambda (t) - (cond - ((token-str? t) (display (string-append "#< " (token-str-content t) "> "))) - ((token-nl? t) (display "#<> ")) - ((token-section-open? t) (display (string-append "#< " (token-section-open-tag t) "> "))) - ((token-section-close? t) (display "#<> ")) - ((token-ws? t) (display (string-append "#< " (number->string (token-ws-count t)) "> "))) - ((token-interp? t) (display (string-append "#< " (token-interp-tag t) "> "))) - (else (display t)))) - tokens - ) - - ) - -(define (standalone/remove? token) - (or (token-comment? token) - (token-delimchager? token))) - -(define (standalone/trim? token) - (or (token-section-open? token) - (token-section-close? token))) - -(define (replace-standalone tokens) - (let loop ((tokens tokens) - (result/inv '()) - (first #t)) - - (cond - ((null? tokens) (reverse result/inv)) - - ((and first - (or (match-follows tokens standalone/remove? token-ws? token-nl?) - (match-follows tokens standalone/remove? token-nl?) - (match-follows tokens token-ws? standalone/remove? token-ws? token-nl?) - (match-follows tokens token-ws? standalone/remove? token-nl?))) => - (lambda (tokens*) - (loop tokens* - result/inv - #t))) - - ((and first - (or (match-follows tokens token-ws? standalone/remove? token-ws? eof-object?) - (match-follows tokens token-ws? standalone/remove? eof-object?) - (match-follows tokens standalone/remove? token-ws? eof-object?) - (match-follows tokens standalone/remove? eof-object?))) => - (lambda (tokens*) - (loop '() - result/inv - #t))) - - ((and first - (or (match-follows tokens token-ws? standalone/trim? token-ws? token-nl?) - (match-follows tokens token-ws? standalone/trim? token-nl?) - (match-follows tokens token-ws? standalone/trim? token-ws? eof-object?) - (match-follows tokens token-ws? standalone/trim? eof-object?))) => - (lambda (tokens*) - (loop tokens* - (append (list (cadr tokens)) - result/inv) - #t))) - - ((and first - (or (match-follows tokens standalone/trim? token-ws? token-nl?) - (match-follows tokens standalone/trim? token-nl?) - (match-follows tokens standalone/trim? token-ws? eof-object?) - (match-follows tokens standalone/trim? eof-object?))) => - (lambda (tokens*) - (loop tokens* - (append (list (car tokens)) - result/inv) - #t))) - - ((and first - (or (match-follows tokens token-ws? token-partial? token-ws? token-nl?) - (match-follows tokens token-ws? token-partial? token-nl?) - (match-follows tokens token-ws? token-partial? token-ws? eof-object?) - (match-follows tokens token-ws? token-partial? eof-object?))) => - (lambda (tokens*) - (loop tokens* - (append (list (partial (token-partial-tag (cadr tokens)) - (token-ws-count (car tokens)))) - result/inv) - #t))) - - ((and first - (or (match-follows tokens token-partial? token-ws? token-nl?) - (match-follows tokens token-partial? token-nl?) - (match-follows tokens token-partial? token-ws? eof-object?) - (match-follows tokens token-partial? eof-object?))) => - (lambda (tokens*) - (loop tokens* - (append (list (partial (token-partial-tag (car tokens)) - 0)) - result/inv) - #t))) - - ((match-follows tokens token-partial?) => (lambda (tokens*) - (loop tokens* - (cons (partial (token-partial-tag (car tokens)) - 0) - result/inv) - #f))) - - (else (loop (cdr tokens) - (cons (car tokens) result/inv) - (token-nl? (car tokens))))))) - -(define (convert-string-tokens tokens) - (let loop ((tokens tokens) - (out #f) - (result/inv '())) - (cond - ((null? tokens) - (let ((result-final/inv (if out - (cons (get-output-string out) - result/inv) - result/inv))) - (reverse result-final/inv))) - ((or (token-str? (car tokens)) - (token-ws? (car tokens))) - (let* ((token (car tokens)) - (out* (if out - out - (open-output-string))) - (str (if (token-str? token) - (token-str-content token) - (make-string (token-ws-count token) #\space)))) - (write-string str out*) - (loop (cdr tokens) - out* - result/inv))) - (else (let* ((token (car tokens)) - (value (cond - ((token-nl? token) (new-line (list->string (token-nl-chars token)))) - (else token))) - (new-result/inv (if out - (cons (get-output-string out) - result/inv) - result/inv))) - (loop (cdr tokens) - #f - (cons value new-result/inv))))))) - -(define (parse-interp+sections tokens) - (define (parse-interp+sections* tokens expected-close-tag) - (let loop ((tokens tokens) - (result/inv '())) - (cond - ((null? tokens) - (if expected-close-tag - (error "Unexpected eof") - (values '() (reverse result/inv)))) - ((token-section-close? (car tokens)) - (if (equal? expected-close-tag (token-section-close-tag (car tokens))) - (values (cdr tokens) (reverse result/inv)) - (error "Closing token mismatch"))) - ((token-section-open? (car tokens)) - (let* ((token (car tokens)) - (tag (token-section-open-tag token)) - (ref (tagname->list tag))) - (define-values (tokens* result*) - (parse-interp+sections* (cdr tokens) - tag)) - (define value (section ref - (token-section-open-inverted? token) - result* - #f)) - (loop tokens* - (cons value result/inv)))) - ((token-interp? (car tokens)) - (let* ((token (car tokens)) - (tag (token-interp-tag token)) - (ref (tagname->list tag))) - (define value (interp ref (token-interp-escape? token))) - (loop (cdr tokens) - (cons value result/inv)))) - (else (loop (cdr tokens) - (cons (car tokens) - result/inv)))))) - (define-values (tokens* result) - (parse-interp+sections* tokens #f)) - result) - -(define (remove-non-visible tokens) - (filter - (lambda (token) - (not (or (token-comment? token) - (token-delimchager? token)))) - tokens)) - -(define (match-follows in . preds) - (let loop ((in* in) - (preds* preds)) - (cond - ((null? preds*) in*) - ((null? in*) (and (null? (cdr preds*)) - (eq? (car preds*) eof-object?) - '())) - (((car preds*) (car in*)) - (loop (cdr in*) - (cdr preds*))) - (else #f)))) - -(define (tagname->list str) - (define (prepend-part parts part) - (when (null? part) - (error "Trailing period in tag name")) - (cons (list->string (reverse part)) - parts)) - (if (equal? "." str) - '(".") - (let loop ((in (string->list str)) - (parts '()) - (part '())) - (cond - ((null? in) - (reverse (prepend-part parts part))) - ((char=? #\. (car in)) - (loop (cdr in) - (prepend-part parts part) - '())) - (else (loop (cdr in) - parts - (cons (car in) part))))))) - -(define (list->tagname lst) - (apply string-append - (cdr (apply append - (map - (lambda (el) (list "." el)) - lst))))) diff --git a/snow/arvyy/mustache/parser.sld b/snow/arvyy/mustache/parser.sld deleted file mode 100644 index 6efa52a..0000000 --- a/snow/arvyy/mustache/parser.sld +++ /dev/null @@ -1,14 +0,0 @@ -(define-library - (arvyy mustache parser) - (import (scheme base) - (scheme write) - (scheme cxr) - (arvyy mustache tokenizer) - (srfi 1)) - (export - parse - interp? interp-ref interp-escape? - section? section-ref section-invert? section-content section-raw-content - partial? partial-name partial-indent - new-line? new-line-content) - (include "parser-impl.scm")) diff --git a/snow/arvyy/mustache/tokenizer-impl.scm b/snow/arvyy/mustache/tokenizer-impl.scm deleted file mode 100644 index 4870e89..0000000 --- a/snow/arvyy/mustache/tokenizer-impl.scm +++ /dev/null @@ -1,237 +0,0 @@ -(define-record-type - (token-ws count) - token-ws? - (count token-ws-count)) - -(define-record-type - (token-nl chars) - token-nl? - (chars token-nl-chars)) - -(define-record-type - (token-comment) - token-comment?) - -(define-record-type - (token-str content) - token-str? - (content token-str-content)) - -(define-record-type - (token-delimchager open close) - token-delimchager? - (open token-delimchager-open) - (close token-delimchager-close)) - -(define-record-type - (token-interp tag escape?) - token-interp? - (tag token-interp-tag) - (escape? token-interp-escape?)) - -(define-record-type - (token-section-open tag inverted?) - token-section-open? - (tag token-section-open-tag) - (inverted? token-section-open-inverted?)) - -(define-record-type - (token-section-close tag) - token-section-close? - (tag token-section-close-tag)) - -(define-record-type - (token-partial tag) - token-partial? - (tag token-partial-tag)) - -(define (read-tokens str) - (let loop ((in (string->list str)) - (ws-count 0) - (str-value '()) - (open-delim '(#\{ #\{)) - (close-delim '(#\} #\})) - (result/inv '())) - - (define (resolve-ws/str) - (cond - ;; unflushed ws and str info - ((and (not (null? str-value)) - (> ws-count 0)) - (append (list (token-ws ws-count) - (token-str (list->string (reverse str-value)))) - result/inv)) - - ;; unflushed str info - ((not (null? str-value)) - (cons (token-str (list->string (reverse str-value))) - result/inv)) - - ;; unflushed ws info - ((> ws-count 0) - (cons (token-ws ws-count) - result/inv)) - - ;; no unflushed info - (else result/inv))) - - ;; handle when in is null; ie final function return - (define (return) - (define final-result/inv (resolve-ws/str)) - (reverse final-result/inv)) - - ;; handle after tag read - (define (continue-after-tag in token) - (loop - in - 0 - '() - open-delim - close-delim - (cons token (resolve-ws/str)))) - - (define (process-interp in) - (define-values (in* tag) - (read-tag in close-delim)) - (continue-after-tag in* (token-interp tag #t))) - - (define (process-triple-mustache in) - (define-values (in* tag) - (read-tag in '(#\} #\} #\}))) - (continue-after-tag in* (token-interp tag #f))) - - (define (process-ampersand in) - (define-values (in* tag) - (read-tag in close-delim)) - (continue-after-tag in* (token-interp tag #f))) - - (define (process-inverted in) - (define-values (in* tag) - (read-tag in close-delim)) - (continue-after-tag in* (token-section-open tag #t))) - - (define (process-section in) - (define-values (in* tag) - (read-tag in close-delim)) - (continue-after-tag in* (token-section-open tag #f))) - - (define (process-close in) - (define-values (in* tag) - (read-tag in close-delim)) - (continue-after-tag in* (token-section-close tag))) - - (define (process-partial in) - (define-values (in* tag) - (read-tag in close-delim)) - (continue-after-tag in* (token-partial tag))) - - (define (process-comment in) - (let loop* ((in in)) - (cond - ((null? in) (error "Unexpected EOF")) - ((match-follows in close-delim) => (lambda (in*) - (continue-after-tag in* (token-comment)))) - (else (loop* (cdr in)))))) - - (define (process-delim-change in) - (let*-values (((in new-open) (read-tag in #f)) - ((in new-close) (read-tag in (cons #\= close-delim)))) - (loop in - 0 - '() - (string->list new-open) - (string->list new-close) - (cons (token-delimchager new-open new-close) - (resolve-ws/str))))) - - (define (process-open-delim in*) - (cond - ((match-follows in* '(#\&)) => process-ampersand) - ((match-follows in* '(#\^)) => process-inverted) - ((match-follows in* '(#\#)) => process-section) - ((match-follows in* '(#\/)) => process-close) - ((match-follows in* '(#\>)) => process-partial) - ((match-follows in* '(#\=)) => process-delim-change) - ((match-follows in* '(#\!)) => process-comment) - (else (process-interp in*)))) - - (define (process-space in*) - (loop in* - (+ 1 ws-count) - str-value - open-delim - close-delim - result/inv)) - - (define (process-eol in* chars) - (loop in* - 0 - '() - open-delim - close-delim - (cons (token-nl chars) - (resolve-ws/str)))) - - (define (process-nl in*) - (process-eol in* '(#\newline))) - - (define (process-crnl in*) - (process-eol in* '(#\return #\newline))) - - (define (process-char) - (loop (cdr in) - 0 - (append (list (car in)) - (make-list ws-count #\space) - str-value) - open-delim - close-delim - result/inv)) - - ;; loop handler - (cond - ((null? in) (return)) - ((match-follows in '(#\{ #\{ #\{)) => process-triple-mustache) - ((match-follows in open-delim) => process-open-delim) - ((match-follows in '(#\space)) => process-space) - ((match-follows in '(#\newline)) => process-nl) - ((match-follows in '(#\return #\newline)) => process-crnl) - (else (process-char))))) - -(define (match-follows in chars) - (let loop ((in* in) - (chars* chars)) - (cond - ((null? chars*) in*) - ((null? in*) #f) - ((char=? (car in*) (car chars*)) - (loop (cdr in*) - (cdr chars*))) - (else #f)))) - -(define (skip-spaces in) - (cond - ((null? in) '()) - ((char=? (car in) #\space) (skip-spaces (cdr in))) - (else in))) - -(define (read-tag in close-delim) - (define-values - (tag in*) - (let loop ((in (skip-spaces in)) - (result '())) - (define (return) - (values (list->string (reverse result)) - in)) - (cond - ((null? in) (error "Unexpected EOF")) - ((char=? (car in) #\space) (return)) - ((and close-delim (match-follows in close-delim)) - (return)) - (else (loop (cdr in) - (cons (car in) result)))))) - (cond - ((not close-delim) (values in* tag)) - ((match-follows (skip-spaces in*) close-delim) => (lambda (in**) - (values in** tag))) - (else (error "Bad tag")))) diff --git a/snow/arvyy/mustache/tokenizer.sld b/snow/arvyy/mustache/tokenizer.sld deleted file mode 100644 index edeea7e..0000000 --- a/snow/arvyy/mustache/tokenizer.sld +++ /dev/null @@ -1,15 +0,0 @@ -(define-library - (arvyy mustache tokenizer) - (import (scheme base)) - (export - read-tokens - token-ws? token-ws-count - token-nl token-nl? token-nl-chars - token-comment? - token-str? token-str-content - token-delimchager? token-delimchager-open token-delimchager-close - token-interp? token-interp-tag token-interp-escape? - token-section-open? token-section-open-tag token-section-open-inverted? - token-section-close? token-section-close-tag - token-partial? token-partial-tag) - (include "tokenizer-impl.scm")) diff --git a/src/libtest.c b/src/libtest.c deleted file mode 100644 index f0740fc..0000000 --- a/src/libtest.c +++ /dev/null @@ -1,283 +0,0 @@ -#include -#include -#include -#include -#include - -#if defined(_MSC_VER) -#define EXPORT __declspec(dllexport) -#define IMPORT __declspec(dllimport) -#elif defined(__GNUC__) -#define EXPORT __attribute__((visibility("default"))) -#define IMPORT -#else -#define EXPORT -#define IMPORT -#pragma warning Unknown dynamic link import/export semantics. -#endif - -struct color { - int8_t r; - int8_t g; - int8_t b; - int8_t a; -}; - -struct test { - int8_t a; - char b; - double c; - char d; - void* e; - float f; - char* g; - int8_t h; - void* i; - int j; - int k; - int l; - double m; - float n; -}; - -void print_string_pointer(char* p) { - printf("C print_string_pointer: %s\n", p); -} - -void print_offsets() { - printf("C: Offset of a = %u\n", offsetof(struct test, a)); - printf("C: Offset of b = %u\n", offsetof(struct test, b)); - printf("C: Offset of c = %u\n", offsetof(struct test, c)); - printf("C: Offset of d = %u\n", offsetof(struct test, d)); - printf("C: Offset of e = %u\n", offsetof(struct test, e)); - printf("C: Offset of f = %u\n", offsetof(struct test, f)); - printf("C: Offset of g = %u\n", offsetof(struct test, g)); - printf("C: Offset of h = %u\n", offsetof(struct test, h)); - printf("C: Offset of i = %u\n", offsetof(struct test, i)); - printf("C: Offset of j = %u\n", offsetof(struct test, j)); - printf("C: Offset of k = %u\n", offsetof(struct test, k)); - printf("C: Offset of l = %u\n", offsetof(struct test, l)); - printf("C: Offset of m = %u\n", offsetof(struct test, m)); - printf("C: Offset of n = %u\n", offsetof(struct test, n)); -} - -void check_offset(int member_index, int offset) { - if (member_index == 1) { - int true_offset = offsetof(struct test, a); - printf("C: Checking that member_index : %u, is offset: %u, true offset: %u\n", member_index, offset, true_offset); - fflush(stdout); - assert(true_offset == offset); - } else if (member_index == 2) { - int true_offset = offsetof(struct test, b); - printf("C: Checking that member_index : %u, is offset: %u, true offset: %u\n", member_index, offset, true_offset); - fflush(stdout); - assert(true_offset == offset); - } else if (member_index == 3) { - int true_offset = offsetof(struct test, c); - printf("C: Checking that member_index : %u, is offset: %u, true offset: %u\n", member_index, offset, true_offset); - fflush(stdout); - assert(true_offset == offset); - } else if (member_index == 4) { - int true_offset = offsetof(struct test, d); - printf("C: Checking that member_index : %u, is offset: %u, true offset: %u\n", member_index, offset, true_offset); - fflush(stdout); - assert(true_offset == offset); - } else if (member_index == 5) { - int true_offset = offsetof(struct test, e); - printf("C: Checking that member_index : %u, is offset: %u, true offset: %u\n", member_index, offset, true_offset); - fflush(stdout); - assert(true_offset == offset); - } else if (member_index == 6) { - int true_offset = offsetof(struct test, f); - printf("C: Checking that member_index : %u, is offset: %u, true offset: %u\n", member_index, offset, true_offset); - fflush(stdout); - assert(true_offset == offset); - } else if (member_index == 7) { - int true_offset = offsetof(struct test, g); - printf("C: Checking that member_index : %u, is offset: %u, true offset: %u\n", member_index, offset, true_offset); - fflush(stdout); - assert(true_offset == offset); - } else if (member_index == 8) { - int true_offset = offsetof(struct test, h); - printf("C: Checking that member_index : %u, is offset: %u, true offset: %u\n", member_index, offset, true_offset); - fflush(stdout); - assert(true_offset == offset); - } else if (member_index == 9) { - int true_offset = offsetof(struct test, i); - printf("C: Checking that member_index : %u, is offset: %u, true offset: %u\n", member_index, offset, true_offset); - fflush(stdout); - assert(true_offset == offset); - } else if (member_index == 10) { - int true_offset = offsetof(struct test, j); - printf("C: Checking that member_index : %u, is offset: %u, true offset: %u\n", member_index, offset, true_offset); - fflush(stdout); - assert(true_offset == offset); - } else if (member_index == 11) { - int true_offset = offsetof(struct test, k); - printf("C: Checking that member_index : %u, is offset: %u, true offset: %u\n", member_index, offset, true_offset); - fflush(stdout); - assert(true_offset == offset); - } else if (member_index == 12) { - int true_offset = offsetof(struct test, l); - printf("C: Checking that member_index : %u, is offset: %u, true offset: %u\n", member_index, offset, true_offset); - fflush(stdout); - assert(true_offset == offset); - } else if (member_index == 13) { - int true_offset = offsetof(struct test, m); - printf("C: Checking that member_index : %u, is offset: %u, true offset: %u\n", member_index, offset, true_offset); - fflush(stdout); - assert(true_offset == offset); - } else if (member_index == 14) { - int true_offset = offsetof(struct test, n); - printf("C: Checking that member_index : %u, is offset: %u, true offset: %u\n", member_index, offset, true_offset); - fflush(stdout); - assert(true_offset == offset); - } -} - - -EXPORT struct test* init_struct(struct test* test) { - print_offsets(); - test->a = 1; - test->b = 'b'; - test->c = 3.0; - test->d = 'd'; - test->e = NULL; - test->f = 6.0; - char* foo = malloc(sizeof("FOOBAR")); - snprintf(foo, sizeof("FOOBAR") + 1, "FOOBAR"); - test->g = foo; - test->h = 8; - test->i = NULL; - test->j = 10; - test->k = 11; - test->l = 12; - test->m = 13; - test->n = 14; -} - -EXPORT int color_check(struct color* color) { - printf("C: Value of r is %c\n", color->r); - assert(color->r == 100); - printf("C: Value of g is %c\n", color->g); - assert(color->g == 101); - printf("C: Value of b is %c\n", color->b); - assert(color->b == 102); - printf("C: Value of a is %c\n", color->a); - assert(color->a == 103); - return 0; -} - -EXPORT int color_check_by_value(struct color color) { - printf("C: Value of r is %i\n", color.r); - assert(color.r == 100); - printf("C: Value of g is %i\n", color.g); - assert(color.g == 101); - printf("C: Value of b is %i\n", color.b); - assert(color.b == 102); - printf("C: Value of a is %i\n", color.a); - assert(color.a == 103); - return 0; -} - -EXPORT int test_check(struct test* test) { - print_offsets(); - printf("C: Value of a is %c\n", test->a); - assert(test->a == 1); - printf("C: Value of b is %c\n", test->b); - assert(test->b == 'b'); - printf("C: Value of c is %lf\n", test->c); - //FIXME - //assert(test->c == 3.0); - printf("C: Value of d is %c\n", test->d); - assert(test->d == 'd'); - printf("C: Value of e is %s\n", test->e); - assert(test->e == NULL); - printf("C: Value of f is %f\n", test->f); - //FIXME - //assert(test->f == 6.0); - //FIXME - //printf("C: Value of g is %f\n", test->g); - //assert(strcmp(test->g, "foo") == 0); - printf("C: Value of h is %i\n", test->h); - assert(test->h == 8); - printf("C: Value of i is %s\n", test->i); - assert(test->i == NULL); - //FIXME - //printf("C: Value of j is %i\n", test->j); - //assert(test->j == 10); - //FIXME - //printf("C: Value of k is %i\n", test->k); - //assert(test->k == 11); - //FIXME - //printf("C: Value of l is %i\n", test->l); - //assert(test->l == 12); - //FIXME - //printf("C: Value of m is %i\n", test->m); - //assert(test->m == 13); - //FIXME - //printf("C: Value of n is %i\n", test->n); - //assert(test->n == 14); -} - -EXPORT int test_check_by_value(struct test test) { - print_offsets(); - printf("C: Value of a is %i\n", test.a); - assert(test.a == 1); - printf("C: Value of b is %c\n", test.b); - assert(test.b == 'b'); - printf("C: Value of c is %lf\n", test.c); - assert(test.c == 3.0); - printf("C: Value of d is %c\n", test.d); - assert(test.d == 'd'); - printf("C: Value of e is %s\n", test.e); - assert(test.e == NULL); - printf("C: Value of f is %f\n", test.f); - assert(test.f == 6.0); - printf("C: Value of g is %f\n", test.g); - assert(strcmp(test.g, "foo") == 0); - printf("C: Value of h is %i\n", test.h); - assert(test.h == 8); - printf("C: Value of i is %s\n", test.i); - assert(test.i == NULL); - printf("C: Value of j is %i\n", test.j); - assert(test.j == 10); - printf("C: Value of k is %i\n", test.k); - assert(test.k == 11); - printf("C: Value of l is %i\n", test.l); - assert(test.l == 12); - printf("C: Value of m is %i\n", test.m); - assert(test.m == 13); - printf("C: Value of n is %i\n", test.n); - assert(test.n == 14); -} - -EXPORT struct test* test_new() { - print_offsets(); - struct test* t = malloc(sizeof(struct test)); - t->a = 1; - t->b = 'b'; - t->c = 3.0; - t->d = 'd'; - t->e = NULL; - t->f = 6.0; - char* foo = malloc(sizeof("FOOBAR")); - snprintf(foo, sizeof("FOOBAR") + 1, "FOOBAR"); - t->g = foo; - t->h = 8; - t->i = NULL; - t->j = 10; - t->k = 11; - t->l = 12; - t->m = 13; - t->n = 14; - return t; -} - -EXPORT void takes_no_args() { - puts("I take no arguments :)"); -} - -EXPORT int takes_no_args_returns_int() { - return 0; -} diff --git a/templates/Jenkinsfile b/templates/Jenkinsfile deleted file mode 100644 index 2ef33e0..0000000 --- a/templates/Jenkinsfile +++ /dev/null @@ -1,53 +0,0 @@ -pipeline { - agent { - dockerfile { - filename 'dockerfiles/jenkins' - dir '.' - args '--user=root --privileged -v /var/run/docker.sock:/var/run/docker.sock' - } - } - - options { - buildDiscarder(logRotator(numToKeepStr: '10', artifactNumToKeepStr: '10')) - } - - stages { - stage('Build test libraries') { - steps { - catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') { - sh 'make libtest.so libtest.a' - } - } - } - stage('Build Chibi libraries') { - agent { - dockerfile { - filename 'dockerfiles/build-chibi' - } - } - steps { - catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') { - sh 'make cbibi' - } - } - } - {{#script-implementations}} - stage('{{.}} script') { - steps { - catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') { - sh 'make SCHEME={{.}} test-script-docker' - } - } - } - {{/script-implementations}} - {{#compiler-implementations}} - stage('{{.}} compile') { - steps { - catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') { - sh 'make SCHEME={{.}} test-compile-docker' - } - } - } - {{/compiler-implementations}} - } -}