diff --git a/Makefile b/Makefile index ebb1898..0d5eebf 100644 --- a/Makefile +++ b/Makefile @@ -90,7 +90,8 @@ sextest: $(EGGS_STAMP) $(MAKE) -C ./tools/sextest sextest cp ./tools/sextest/sextest . -SEX_TEST_PROGRAMS = hello-world lists comments unicode serialize features +SEX_TEST_PROGRAMS = hello-world lists comments unicode serialize features \ + feature-flags # Multi-module linking is checked end to end; see tests/modules/Makefile. check-modules: sexc diff --git a/fmt-c-writer.scm b/fmt-c-writer.scm index e5d6731..d64b749 100644 --- a/fmt-c-writer.scm +++ b/fmt-c-writer.scm @@ -135,9 +135,6 @@ forms, and what remains." (car type) type)) -(define (comment-form? f) - (and (pair? f) (eq? (car f) 'comment))) - ;;; Strip ;s so ;;; Foo becomes /* Foo */ and not /* ;; Foo */ (define (strip-comment-marker text) (string-trim-both (string-trim text #\;))) @@ -279,7 +276,7 @@ forms, and what remains." ;; it's a strong semantic cue `(%array ,(walk-type (maybe-unwrap-type array-type))))) (('fn arglist ret-type) - `(%fun ,(walk-type ret-type) ,(walk-arglist arglist))) + `(%fun ,(walk-type ret-type) ,(walk-arg-types arglist))) (('fn . _) (sex-error form "malformed function type" form)) @@ -291,8 +288,13 @@ forms, and what remains." (else (type-convert-to-c form)))) +;;; An array or a function type +(define (structured-type? form) + (and (pair? form) (memq (car form) '(¤ fn)))) + (define (has-pointer-star? form) (and (pair? form) + (not (structured-type? form)) (or (memq '* form) (any has-pointer-star? (filter pair? form))))) @@ -304,6 +306,10 @@ forms, and what remains." (and (pair? type) (any has-pointer-star? (filter pair? type)))) +(define (nested-structured-type type) + (and (pair? type) + (find structured-type? (filter pair? type)))) + (define (type-convert-to-c type) ;; Our pointers to C pointers ;; int -> int @@ -311,6 +317,12 @@ forms, and what remains." ;; const * const char -> const char * const (when (nested-pointer? type) (sex-error type "pointer chains are written flat, as (* * T), not nested" type)) + (let ((inner (nested-structured-type type))) + (when inner + (if (eq? (car inner) 'fn) + ;; (fn ...) is spelled as the pointer it already is in C + (sex-error type "a fn type is a function pointer already: write (fn ...), not (* (fn ...))" type) + (sex-error type "a pointer to an array is not supported" type)))) (if (atom? type) (atom-to-fmt-c type) (flatten (tree-map atom-to-fmt-c @@ -334,26 +346,39 @@ forms, and what remains." ((¤ * const volatile struct union) #t) (else #f))) +;;; Does the parameter name itself? +;;; (f1 float) does +;;; (float), (const char) and (¤ float 4) do not +(define (named-arg? arg) + (and (pair? arg) + (pair? (cdr arg)) ; 1 element args are always type + (not (eq? (car arg) '¤)) + (not (is-probably-type arg)))) + +;;; The type of one parameter +(define (arg-type arg) + (if (named-arg? arg) + (walk-type (maybe-unwrap-type (cdr arg))) + ;; A lone type may arrive wrapped in parens of its own, and those + ;; are not part of it: ((* const char)) + ;; Plain names e.g. (int) are left as is + (walk-type (if (and (pair? arg) (null? (cdr arg)) (pair? (car arg))) + (car arg) + arg)))) + (define (walk-arglist form) ;; E.g.: ;; ((float) (int) (const char) (* const char) (¤ (* const struct res) 32)) ;; ((f1 float) (f2 float) (f3 float) (res (¤ float 4))) - (map (fn - (match x - (('¤ . _) (walk-type x)) - - ;; yeah shitty, but I don't know yet how to determine if the - ;; first entry is part of the type and not an argument name - ;; :( - ((? is-probably-type) (walk-type x)) - - ;; 1 element args are always type - ((_) (walk-type x)) - - ((var . type) (append (list (walk-type (maybe-unwrap-type type))) - (list (walk-type var)))))) + (map (lambda (arg) + (if (named-arg? arg) + (list (arg-type arg) (walk-type (car arg))) + (arg-type arg))) (remove comment-form? form))) +(define (walk-arg-types form) + (map arg-type (remove comment-form? form))) + (define (walk-function form) ;; (fn ret-type name arglist body) -> normal function ;; (fn ret-type name arglist) -> prototype diff --git a/reader.scm b/reader.scm index 45b8fd5..dcc8e94 100644 --- a/reader.scm +++ b/reader.scm @@ -115,6 +115,21 @@ ((eq? tok dot-token) (error "Unexpected .")) (else tok)))) +;;; A token that stands for a datum +(define (datum-token? tok) + (not (or (eof-object? tok) + (eq? tok close-paren) + (eq? tok close-bracket) + (eq? tok dot-token)))) + +;;; next-token, sans the comments +(define (next-code-token port) + (let loop () + (let ((tok (next-token port))) + (if (comment-form? tok) + (loop) + tok)))) + ;;; Read list elements up to close-paren or close-bracket, ;;; honoring dotted-pair notation (a b . c) (define (read-list port closer) @@ -208,13 +223,24 @@ (else (error "Malformed feature expression" test)))) ;;; The #-/#+ preceded datum is always read -- there is no other way -;;; to know where it ends -- and then either returned or dropped +;;; to know where it ends -- and then either returned or dropped. What +;;; follows a dropped datum is read in its place: `#+x #+y (a) (b)' +;;; with only x is (b). +;;; +;;; That next thing may be nothing: the end of the file, or the +;;; paren closing the list we are in (define (read-conditional port keep-when) - (let ((keep (eq? keep-when (feature-true? (read-datum port))))) - (if keep - (read-datum port) - (begin (read-datum port) - (next-token port))))) + (let* ((test (next-code-token port)) + (keep (begin + (unless (datum-token? test) + (error "Unexpected end of input in feature expression")) + (eq? keep-when (feature-true? test)))) + (guarded (next-code-token port))) + (cond + (keep guarded) + ;; A datum was dropped, so the next one stands in for it + ((datum-token? guarded) (next-token port)) + (else guarded)))) ;;; #t / #true / #f / #false. `val' is the boolean; consume any ;;; trailing name characters and validate diff --git a/semen.scm b/semen.scm index 4b0800e..1b4ad85 100644 --- a/semen.scm +++ b/semen.scm @@ -145,9 +145,6 @@ ;;; C code it will be placed as a C commentary just before the function ;;; definition (actually that works for all blocky things: enum, struct, union as well). -(define (comment-form? f) - (and (pair? f) (eq? (car f) 'comment))) - (define (fn-header-length fn-form) (if (memq (first fn-form) '(pub extern)) 5 4)) @@ -207,21 +204,10 @@ acc))) (define (strip-fn-header-comments fn-form) - ;; Remove comment forms from the function header - ;; ([pub|extern] fn name arglist rettype) so the positional accessors - ;; below are not shifted. Comments in the body are left in place as - ;; ordinary statements and preserved into the generated C. - (let ((header-count (fn-header-length fn-form))) - ;; This always rebuilds the list, so the location has to be carried - ;; over explicitly -- otherwise every function loses it - (copy-form-source! - fn-form - (let loop ((form fn-form) (kept 0) (acc (list))) - (cond - ((null? form) (reverse acc)) - ((= kept header-count) (append (reverse acc) form)) - ((comment-form? (car form)) (loop (cdr form) kept acc)) - (else (loop (cdr form) (+ kept 1) (cons (car form) acc)))))))) + ;; ([pub|extern] fn name arglist rettype). Comments in the body are + ;; left in place as ordinary statements and preserved into the + ;; generated C. + (strip-header-comments fn-form (fn-header-length fn-form))) (define (process-fn sex-fn-raw acc) (let-values (((doc sex-fn) diff --git a/sex-fmt-c.scm b/sex-fmt-c.scm index 6680ffc..7740383 100644 --- a/sex-fmt-c.scm +++ b/sex-fmt-c.scm @@ -737,10 +737,13 @@ (cat (c-type (cadr type) #f) " (*" (or name "") ")(" (fmt-join (lambda (x) (c-type x #f)) (caddr type) ", ") ")")) + ;; MODIFIED FROM UPSTREAM fmt-c: a nameless declarator -- an + ;; array parameter of a function type, where C has no room + ;; for a name -- arrives as #f, and upstream printed it ((%array) - (let ((name (cat name "[" (if (pair? (cddr type)) - (c-expr (caddr type)) - "") + (let ((name (cat (or name "") "[" (if (pair? (cddr type)) + (c-expr (caddr type)) + "") "]"))) (c-type (cadr type) name))) ((%pointer *) @@ -773,10 +776,13 @@ (cat (c-type (cadr type) #f) " (*" (or name "") ")(" (fmt-join (lambda (x) (c-type x #f)) (caddr type) ", ") ")")) + ;; MODIFIED FROM UPSTREAM fmt-c: a nameless declarator -- an + ;; array parameter of a function type, where C has no room + ;; for a name -- arrives as #f, and upstream printed it ((%array) - (let ((name (cat name "[" (if (pair? (cddr type)) - (c-expr (caddr type)) - "") + (let ((name (cat (or name "") "[" (if (pair? (cddr type)) + (c-expr (caddr type)) + "") "]"))) (c-type (cadr type) name))) ((%pointer *) diff --git a/sex-macros.scm b/sex-macros.scm index 1923a46..ade2ce0 100644 --- a/sex-macros.scm +++ b/sex-macros.scm @@ -26,8 +26,8 @@ (import scheme (scheme base) (only sex-macros cat comment) - (only types get-type-info get-fields get-underlying-type - type-match map-fields)) + (only types get-type-info get-tag-info get-fields + get-underlying-type type-match map-fields)) ,@body))) (define (get-macro name) diff --git a/sex-modules.scm b/sex-modules.scm index fd07f6e..9939bd8 100644 --- a/sex-modules.scm +++ b/sex-modules.scm @@ -72,18 +72,19 @@ (list) raw-forms))) -(define (public-fn-interface form) +(define (public-fn-interface raw-form) ;; (pub fn name args ret . body) -> prototype, keeping a docstring so ;; the importer can emit it above the declaration - (match form - (('pub 'fn name args ret) - form) - (('pub 'fn name args ret ('comment . _) . rest) - (public-fn-interface `(pub fn ,name ,args ,ret ,@rest))) - (('pub 'fn name args ret (? string? doc) . _) - `(pub fn ,name ,args ,ret ,doc)) - (('pub 'fn name args ret . _) - `(pub fn ,name ,args ,ret)))) + (let ((form (strip-header-comments raw-form 5))) + (match form + (('pub 'fn name args ret) + form) + (('pub 'fn name args ret ('comment . _) . rest) + (public-fn-interface `(pub fn ,name ,args ,ret ,@rest))) + (('pub 'fn name args ret (? string? doc) . _) + `(pub fn ,name ,args ,ret ,doc)) + (('pub 'fn name args ret . _) + `(pub fn ,name ,args ,ret))))) ;;; TODO: use semen facilities to analyze modules (define (process-public-interface-form form acc) @@ -92,8 +93,9 @@ ;; with external linkage (('pub 'fn . _) (cons (copy-form-source! form (public-fn-interface form)) acc)) - (('pub 'var name type . _) - (cons (copy-form-source! form `(extern var ,name ,type)) acc)) + (('pub 'var . _) + (match-let ((('pub 'var name type . _) (strip-header-comments form 4))) + (cons (copy-form-source! form `(extern var ,name ,type)) acc))) (('pub (or 'define 'defmacro 'enum 'import 'include 'struct 'typedef 'union) . _) (cons (copy-form-source! form (cdr form)) acc)) (('pub . _) diff --git a/tests/modules/Makefile b/tests/modules/Makefile index 1821967..bd1e966 100644 --- a/tests/modules/Makefile +++ b/tests/modules/Makefile @@ -11,6 +11,9 @@ # It also checks what only a second translation unit can check: that an # imported type reaches the type database, by expanding a macro that # reads the imported struct's fields. +# +# The public forms carry comments in their headers, which the reduction +# to a prototype and to an extern both have to look past. SEXC ?= ../../sexc diff --git a/tests/modules/greet.sex b/tests/modules/greet.sex index 96e36ff..50c1aa0 100644 --- a/tests/modules/greet.sex +++ b/tests/modules/greet.sex @@ -7,7 +7,11 @@ (include stdio.h) -(pub var greet-count int 0) +(pub var greet-count ;; a comment in the header of a public form is + ;; not part of it: what the importer is given has + ;; to be `extern int greet-count', not a form + ;; counted off by one + int 0) (pub struct greeting "A greeting to print." @@ -25,7 +29,8 @@ (lambda (name field-type) `(printf "%s " ,(symbol->string name)))))) -(pub fn greet ((name (* const char))) void +(pub fn greet ;; ...and here the prototype would lose its return type + ((name (* const char))) void "Print a greeting for NAME." (++ greet-count) (printf "hello, %s\n" name)) diff --git a/tests/reader.scm b/tests/reader.scm index b525b05..7367b48 100644 --- a/tests/reader.scm +++ b/tests/reader.scm @@ -80,6 +80,22 @@ ;; guards nest (feature-test '((a)) (x y) "#+x #+y (a)") (feature-test '((b)) (x) "#+x #+y (a) (b)") + ;; ...and the inner one may leave nothing behind: the end of the + ;; file, or the paren closing the list, is what the outer one then + ;; produces, and neither is an error + (feature-test '() (x) "#+x #+y (a)") + (feature-test '((f)) (x) "(f #+x #+y 1)") + (feature-test '((f 2)) (x) "(f #+x #+y 1 2)") + (feature-test '((a)) (x) "(a) #+x #+y (b)") + + ;; a comment between a guard and the form it guards describes the + ;; guard. Taking it for the guarded datum would leave the form itself + ;; unconditional + (feature-test '((a)) (x) "#+x ;; why\n (a)") + (feature-test '() (y) "#+x ;; why\n (a)") + (feature-test '((b)) (y) "#+x ;; why\n (a) (b)") + ;; a comment after the guarded form is an ordinary form, and stays + (feature-test '((comment "; tail")) (y) "#+x (a) ;; tail") ;; a feature the program was not given is simply absent (feature-test '() () "#+anything (a)") diff --git a/tests/sex-programs/feature-flags.sex b/tests/sex-programs/feature-flags.sex new file mode 100644 index 0000000..683c9f8 --- /dev/null +++ b/tests/sex-programs/feature-flags.sex @@ -0,0 +1,25 @@ +(compilation "-f alpha -f beta,gamma --features=delta --no-platform-features") +(input) +(output "alpha" "beta" "gamma" "delta" "elsewhere") +(return 0) + +;;; The flags naming the features, in every spelling sexc takes. This +;;; is not pedantry about the command line: sextest reads the program +;;; itself and prints the surviving forms to sexc, so a spelling it +;;; does not recognise leaves the guards below resolved against the +;;; wrong set -- quietly, since the test then checks the output of a +;;; program it did not mean to compile. +;;; +;;; --no-platform-features is what makes `#-unix' true wherever this is +;;; compiled, and it has to be honoured on both sides for that to hold. + +(include stdio.h) + +(pub fn main () int + #+alpha (puts "alpha") + #+beta (puts "beta") + #+gamma (puts "gamma") + #+delta (puts "delta") + #-unix (puts "elsewhere") + #+unix (puts "here") + (return 0)) diff --git a/tests/types.module.scm b/tests/types.module.scm index 8ae1186..c262cd7 100644 --- a/tests/types.module.scm +++ b/tests/types.module.scm @@ -9,6 +9,7 @@ map-fields get-type-info + get-tag-info get-fields get-underlying-type) "../types.scm") diff --git a/tests/types.scm b/tests/types.scm index d9bfc8a..94ce626 100644 --- a/tests/types.scm +++ b/tests/types.scm @@ -79,6 +79,38 @@ #f (get-fields 't-u8)) + ;; C keeps typedefs and ordinary identifiers apart, and the canonical way + ;; to declare a struct uses both names at once. Neither declaration + ;; may stand on the other. + (add-struct 't-node '(struct t-node ((next (* t-node)) (v int)))) + (add-typedef 't-node '(typedef t-node (struct t-node))) + (test "a typedef of a struct's own name keeps the struct reachable" + '((next (* t-node)) (v int)) + (get-fields 't-node)) + (test "and the tag is there under its own name" + '(struct t-node ((next (* t-node)) (v int))) + (get-tag-info 't-node)) + (add-struct 't-rect '(struct t-rect ((w int) (h int)))) + (add-define 't-rect '(define t-rect 3)) + (test "a define of a tag's name does not hide the fields" + '((w int) (h int)) + (get-fields 't-rect)) + + ;; A type built over a struct is not that struct. Handing back the + ;; element's fields would have a macro write v->x for an array + (add-typedef 't-points '(typedef t-points (¤ t-point 4))) + (test "an array of a struct has no fields of its own" + #f + (get-fields 't-points)) + (add-typedef 't-point-p '(typedef t-point-p (* t-point))) + (test "nor does a pointer to one" + #f + (get-fields 't-point-p)) + (add-typedef 't-cb '(typedef t-cb (fn ((t-point)) void))) + (test "nor a function type over one" + #f + (get-fields 't-cb)) + ;; A typedef can be written to lead back to itself. Resolving it must ;; stop rather than spin (add-typedef 't-loop-a '(typedef t-loop-a t-loop-b)) diff --git a/tools/sextest/sextest.scm b/tools/sextest/sextest.scm index decb2e5..4ce6229 100644 --- a/tools/sextest/sextest.scm +++ b/tools/sextest/sextest.scm @@ -1,4 +1,5 @@ (import scheme + (scheme base) ; let-values brev-separate (chicken base) (chicken file) @@ -33,27 +34,45 @@ (cons (list) (list)) contents)) -;;; --features from the (compilation ...) form, which we have to honour -;;; ourselves: the program is read here and printed back out for sexc, -;;; so #+ and #- are resolved on this side +;;; The feature flags of the (compilation ...) form, which we have to +;;; honour ourselves: the program is read here and printed back out for +;;; sexc, so #+ and #- are resolved on this side. +;;; +;;; Returns the named features and whether the host's own are in play (define (compilation-features settings) (let ((compilation (assoc 'compilation settings))) - (if compilation - (append-map (lambda (flag) - (if (string-prefix? "--features=" flag) - (map string->symbol - (string-split (substring flag 11) ",")) + (let loop ((flags (if compilation + (string-split (cadr compilation)) (list))) - (string-split (cadr compilation))) - (list)))) + (features (list)) + (platform #t)) + (define (add names rest) + (loop rest + (append features (map string->symbol (string-split names ","))) + platform)) + (cond + ((null? flags) (values features platform)) + ;; past `--' the flags are the C compiler's + ((string=? (car flags) "--") (values features platform)) + ((string=? (car flags) "--no-platform-features") + (loop (cdr flags) features #f)) + ((and (member (car flags) '("-f" "--features")) (pair? (cdr flags))) + (add (cadr flags) (cddr flags))) + ((string-prefix? "--features=" (car flags)) + (add (substring (car flags) 11) (cdr flags))) + ((string-prefix? "-f" (car flags)) + (add (substring (car flags) 2) (cdr flags))) + (else (loop (cdr flags) features platform)))))) (define (process-file target-path) - (let* ((first-pass (split-settings (read-raw-forms target-path))) - (features (compilation-features (car first-pass)))) - (if (null? features) - first-pass - (parameterize ((current-features (append (platform-features) features))) - (split-settings (read-raw-forms target-path)))))) + (let ((first-pass (split-settings (read-raw-forms target-path)))) + (let-values (((features platform?) (compilation-features (car first-pass)))) + (if (and (null? features) platform?) + first-pass + (parameterize ((current-features + (append (if platform? (platform-features) (list)) + features))) + (split-settings (read-raw-forms target-path))))))) (define (compile src compilation sexc) (let ((compiler (or diff --git a/tools/sextest/utils.module.scm b/tools/sextest/utils.module.scm index 13c0bed..8f41e2f 100644 --- a/tools/sextest/utils.module.scm +++ b/tools/sextest/utils.module.scm @@ -2,6 +2,8 @@ (get-env-var set-working-directory to-absolute-pathname + comment-form? + strip-header-comments list-split list-join recons diff --git a/types.module.scm b/types.module.scm index 8f94b70..afdb80f 100644 --- a/types.module.scm +++ b/types.module.scm @@ -9,6 +9,7 @@ map-fields get-type-info + get-tag-info get-fields get-underlying-type) "types.scm") diff --git a/types.scm b/types.scm index 6e6b4b0..700146c 100644 --- a/types.scm +++ b/types.scm @@ -15,7 +15,11 @@ srfi-1 srfi-69) -(define +type-db+ (make-hash-table)) +;;; Two namespaces: `struct point' and a `point' typedef are separate +;;; declarations. Tags -- struct, union and enum alike -- share the +;;; second table between them +(define +type-db+ (make-hash-table)) ; typedefs and defines +(define +tag-db+ (make-hash-table)) ; struct, union and enums (define (strip-pub form) (if (eq? (car form) 'pub) (cdr form) form)) @@ -44,17 +48,17 @@ (list)))) (define (add-struct name form) - (hash-table-set! +type-db+ name + (hash-table-set! +tag-db+ name (list 'struct name (normalize-fields (aggregate-fields form))))) (define (add-union name form) - (hash-table-set! +type-db+ name + (hash-table-set! +tag-db+ name (list 'union name (normalize-fields (aggregate-fields form))))) ;;; ([pub] enum name (value ...)) (define (add-enum name form) (let ((f (strip-pub form))) - (hash-table-set! +type-db+ name + (hash-table-set! +tag-db+ name (list 'enum name (if (and (pair? (cddr f)) (list? (caddr f))) (caddr f) (list)))))) @@ -70,8 +74,14 @@ (hash-table-set! +type-db+ name (list 'define name (cddr (strip-pub form))))) +(define (get-tag-info name) + (hash-table-ref/default +tag-db+ name #f)) + +;;; First look up the ordinary identifier, then tag of that id when +;;; no ordinary one was declared, as C does (define (get-type-info name) - (hash-table-ref/default +type-db+ name #f)) + (or (hash-table-ref/default +type-db+ name #f) + (get-tag-info name))) ;;; ((name type) ...) for a struct or union, #f for anything else -- ;;; including a name that was never declared. Callers give the better @@ -100,19 +110,31 @@ ;;; The declaration NAME ultimately names. For a typedef that is the ;;; entry of whatever it stands for, and for anything else it is -;;; NAME's own info. +;;; NAME's own info +(define (target-tag target) + (cond + ((symbol? target) target) + ((and (pair? target) + (memq (car target) '(struct union enum)) + (pair? (cdr target)) + (symbol? (cadr target))) + (cadr target)) + (else #f))) + (define (resolve-type-info name) + (let ((info (resolve-ordinary-type-info name))) + (if (and info (memq (car info) '(struct union enum))) + info + (or (get-tag-info name) info)))) + +(define (resolve-ordinary-type-info name) (let ((info (get-type-info name))) (and info (if (eq? (car info) 'typedef) - (let* ((target (get-underlying-type name)) - (tag (cond ((symbol? target) target) - ((and (pair? target) - (pair? (cdr target)) - (symbol? (cadr target))) - (cadr target)) - (else #f)))) - (and tag (get-type-info tag))) + (let ((tag (target-tag (get-underlying-type name)))) + ;; A typedef target is written in type position, where + ;; `struct point' means the tag + (and tag (or (get-tag-info tag) (get-type-info tag)))) info)))) ;;; Type matcher macro diff --git a/utils.module.scm b/utils.module.scm index 7e1e3f1..e9f6678 100644 --- a/utils.module.scm +++ b/utils.module.scm @@ -2,6 +2,8 @@ (get-env-var set-working-directory to-absolute-pathname + comment-form? + strip-header-comments list-split list-join recons diff --git a/utils.scm b/utils.scm index 7a99fb1..1dbc60e 100644 --- a/utils.scm +++ b/utils.scm @@ -42,6 +42,24 @@ (current-directory) pathname))) +(define (comment-form? form) + (and (pair? form) (eq? (car form) 'comment))) + +;;; Remove the comment forms from the first COUNT elements of FORM -- +;;; its header -- so that the positional accessors reading it are not +;;; shifted by one +(define (strip-header-comments form count) + ;; This always rebuilds the list, so the location has to be carried + ;; over explicitly -- otherwise every form loses it + (copy-form-source! + form + (let loop ((rest form) (kept 0) (acc (list))) + (cond + ((null? rest) (reverse acc)) + ((= kept count) (append (reverse acc) rest)) + ((comment-form? (car rest)) (loop (cdr rest) kept acc)) + (else (loop (cdr rest) (+ kept 1) (cons (car rest) acc))))))) + (define (list-split src-list split-elt) ;; split '(1 2 / 3 4 / 5 6) by '/ -> '((1 2) (3 4) (5 6)) (fold (lambda (elt acc)