Cleanup
This commit is contained in:
parent
48c70ff357
commit
d784de2d80
13
Dockerfile
13
Dockerfile
|
|
@ -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
|
||||
50
Makefile
50
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
|
||||
|
|
|
|||
|
|
@ -268,6 +268,12 @@ in it:
|
|||
cd snow/retropikzel/pffi
|
||||
make <SCHEME>
|
||||
|
||||
If make says:
|
||||
|
||||
make: *** No rule to make target 'SCHEME'. Stop.
|
||||
|
||||
then implementation does not need anything to be built.
|
||||
|
||||
#### Windows
|
||||
<a name="installation-project-local-windows"></a>
|
||||
|
||||
|
|
|
|||
59
build.scm
59
build.scm
|
|
@ -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)))
|
||||
|
|
@ -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();
|
||||
15
manifest.scm
15
manifest.scm
|
|
@ -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"))
|
||||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
@ -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))))
|
||||
|
|
@ -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"))
|
||||
|
||||
|
|
@ -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"
|
||||
'()
|
||||
"|{{= @ @ =}}|"
|
||||
"||"))
|
||||
|
|
@ -1,71 +0,0 @@
|
|||
(define-record-type <foo> (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> (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;")))
|
||||
|
||||
|
|
@ -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 }}|"
|
||||
"|---|"))
|
||||
|
|
@ -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 }}|"
|
||||
"|=|"))
|
||||
|
||||
|
|
@ -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<Y<>>")
|
||||
|
||||
(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>|"))
|
||||
|
||||
|
|
@ -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
|
||||
"
|
||||
))
|
||||
|
||||
|
|
@ -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"))
|
||||
|
|
@ -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>
|
||||
(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"))))))))
|
||||
|
|
@ -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))
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
(define-library
|
||||
(arvyy mustache executor)
|
||||
(import (scheme base)
|
||||
(arvyy mustache parser))
|
||||
(export execute)
|
||||
(include "executor-impl.scm"))
|
||||
|
|
@ -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)))))
|
||||
|
|
@ -1,296 +0,0 @@
|
|||
(define-record-type <interp>
|
||||
(interp ref escape?)
|
||||
interp?
|
||||
(ref interp-ref)
|
||||
(escape? interp-escape?) ;; should html be escaped
|
||||
)
|
||||
|
||||
(define-record-type <section>
|
||||
(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>
|
||||
(partial name indent)
|
||||
partial?
|
||||
(name partial-name)
|
||||
(indent partial-indent))
|
||||
|
||||
(define-record-type <newline>
|
||||
(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> " (token-str-content t) "> ")))
|
||||
((token-nl? t) (display "#<<token-nl>> "))
|
||||
((token-section-open? t) (display (string-append "#<<token-open> " (token-section-open-tag t) "> ")))
|
||||
((token-section-close? t) (display "#<<token-close>> "))
|
||||
((token-ws? t) (display (string-append "#<<token-ws> " (number->string (token-ws-count t)) "> ")))
|
||||
((token-interp? t) (display (string-append "#<<token-interp> " (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)))))
|
||||
|
|
@ -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"))
|
||||
|
|
@ -1,237 +0,0 @@
|
|||
(define-record-type <token-ws>
|
||||
(token-ws count)
|
||||
token-ws?
|
||||
(count token-ws-count))
|
||||
|
||||
(define-record-type <token-nl>
|
||||
(token-nl chars)
|
||||
token-nl?
|
||||
(chars token-nl-chars))
|
||||
|
||||
(define-record-type <token-comment>
|
||||
(token-comment)
|
||||
token-comment?)
|
||||
|
||||
(define-record-type <token-str>
|
||||
(token-str content)
|
||||
token-str?
|
||||
(content token-str-content))
|
||||
|
||||
(define-record-type <token-delimchanger>
|
||||
(token-delimchager open close)
|
||||
token-delimchager?
|
||||
(open token-delimchager-open)
|
||||
(close token-delimchager-close))
|
||||
|
||||
(define-record-type <token-interp>
|
||||
(token-interp tag escape?)
|
||||
token-interp?
|
||||
(tag token-interp-tag)
|
||||
(escape? token-interp-escape?))
|
||||
|
||||
(define-record-type <token-section-open>
|
||||
(token-section-open tag inverted?)
|
||||
token-section-open?
|
||||
(tag token-section-open-tag)
|
||||
(inverted? token-section-open-inverted?))
|
||||
|
||||
(define-record-type <token-section-close>
|
||||
(token-section-close tag)
|
||||
token-section-close?
|
||||
(tag token-section-close-tag))
|
||||
|
||||
(define-record-type <token-partial>
|
||||
(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"))))
|
||||
|
|
@ -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"))
|
||||
283
src/libtest.c
283
src/libtest.c
|
|
@ -1,283 +0,0 @@
|
|||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include <assert.h>
|
||||
#include <string.h>
|
||||
#include <stddef.h>
|
||||
|
||||
#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;
|
||||
}
|
||||
|
|
@ -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}}
|
||||
}
|
||||
}
|
||||
Loading…
Reference in New Issue