diff --git a/TeXmacs/plugins/goldfish/goldfish/guenchi/json.scm b/TeXmacs/plugins/goldfish/goldfish/guenchi/json.scm index 4102965028..3c1d7b7efd 100644 --- a/TeXmacs/plugins/goldfish/goldfish/guenchi/json.scm +++ b/TeXmacs/plugins/goldfish/goldfish/guenchi/json.scm @@ -27,7 +27,8 @@ (export json-string-escape json-string-unescape string->json json->string json-ref json-ref* - json-set json-set* json-push json-push* json-drop json-drop* json-reduce json-reduce*) + json-set json-set* json-push json-push* json-drop json-drop* json-reduce json-reduce* +) ;export (begin (define (json-string-escape str) @@ -37,7 +38,8 @@ (if (= i (string-length str)) (begin (write-char #\" out) ; 结束引号 - (get-output-string out)) + (get-output-string out) + ) ;begin (let ((c (string-ref str i))) (case c ((#\") (display "\\\"" out)) @@ -48,8 +50,14 @@ ((#\newline) (display "\\n" out)) ((#\return) (display "\\r" out)) ((#\tab) (display "\\t" out)) - (else (write-char c out))) - (loop (+ i 1))))))) ; 尾递归调用 + (else (write-char c out)) + ) ;case + (loop (+ i 1)) ; 尾递归调用 + ) ;let + ) ;if + ) ;let + ) ;let +) ;define (define (string-length-sum strings) @@ -59,7 +67,12 @@ ((eq? '() rest) o) (else (loop (+ o (string-length (car rest))) - (cdr rest)))))) + (cdr rest) + ) ;loop + ) ;else + ) ;cond + ) ;let +) ;define (define (fast-string-list-append strings) (let* ((output-length (string-length-sum strings)) @@ -76,8 +89,17 @@ (else (string-set! output fill (string-ref s i)) (set! fill (+ fill 1)) - (inner (+ i 1)))))) - (outer (cdr rest))))))) + (inner (+ i 1)) + ) ;else + ) ;cond + ) ;let + ) ;let* + (outer (cdr rest)) + ) ;else + ) ;cond + ) ;let + ) ;let* +) ;define (define (handle-escape-char s end len) (let ((next-char (if (< (+ end 1) len) @@ -85,21 +107,29 @@ #f))) (case next-char ((#\") ; 处理双引号 - (values "\\\"" 2)) + (values "\\\"" 2) + ) ; ((#\\) ; 处理反斜杠 - (values "\\\\" 2)) + (values "\\\\" 2) + ) ; ((#\/) ; 处理斜杠 - (values "/" 2)) + (values "/" 2) + ) ; ((#\b) ; 处理退格符 - (values "\\b" 2)) + (values "\\b" 2) + ) ; ((#\f) ; 处理换页符 - (values "\\f" 2)) + (values "\\f" 2) + ) ; ((#\n) ; 处理换行符 - (values "\\n" 2)) + (values "\\n" 2) + ) ; ((#\r) ; 处理回车符 - (values "\\r" 2)) + (values "\\r" 2) + ) ; ((#\t) ; 处理制表符 - (values "\\t" 2)) + (values "\\t" 2) + ) ; ((#\u) ; 处理 \u 转义字符 (let ((start-pos (+ end 2)) ; \u 后的起始位置 (end-pos (+ end 6))) ; \u 后的结束位置 @@ -107,7 +137,8 @@ (let ((hex-str (substring s start-pos end-pos))) ; 提取 4 位十六进制数 (let ((code-point (string->number hex-str 16))) ; 将十六进制转换为整数 (when (not code-point) - (error 'parse-error (string-append "Invalid HEX sequence " hex-str))) + (error 'parse-error (string-append "Invalid HEX sequence " hex-str)) + ) ;when ;; 检查是否存在连续的两个 \u (let ((next-u-pos (+ end 6))) ; 下一个 \u 的起始位置 (if (and (< (+ next-u-pos 6) len) ; 检查是否足够剩余字符 @@ -117,22 +148,38 @@ (let ((next-hex-str (substring s (+ next-u-pos 2) (+ next-u-pos 6)))) ; 提取下一个 4 位十六进制数 (let ((next-code-point (string->number next-hex-str 16))) ; 将十六进制转换为整数 (when (not next-code-point) - (error 'parse-error (string-append "Invalid HEX sequence " next-hex-str))) + (error 'parse-error (string-append "Invalid HEX sequence " next-hex-str)) + ) ;when ;; 检查是否满足代理对条件 (if (and (>= code-point #xD800) (<= code-point #xDBFF) ; 高代理 (>= next-code-point #xDC00) (<= next-code-point #xDFFF)) ; 低代理 ;; 满足代理对条件，使用 unicode 模块计算码点并转换为字符串 (let ((surrogate-code-point (+ (* (- code-point #xD800) #x400) (- next-code-point #xDC00) #x10000))) ; 计算码点 - (values (utf8->string (codepoint->utf8 surrogate-code-point)) 12)) + (values (utf8->string (codepoint->utf8 surrogate-code-point)) 12) + ) ;let ;; 不满足代理对条件，仅对第一个 \u 进行转换 - (values (utf8->string (codepoint->utf8 code-point)) 6)))) + (values (utf8->string (codepoint->utf8 code-point)) 6) + ) ;if + ) ;let + ) ;let ;; 不存在连续的两个 \u，仅对第一个 \u 进行转换 - (values (utf8->string (codepoint->utf8 code-point)) 6))))) + (values (utf8->string (codepoint->utf8 code-point)) 6) + ) ;if + ) ;let + ) ;let + ) ;let ;; 索引无效，返回原字符 - (error 'parse-error (string-append "HEX sequence too short " (substring s start-pos)))))) + (error 'parse-error (string-append "HEX sequence too short " (substring s start-pos))) + ) ;if + ) ;let + ) ; (else - (error 'parse-error (string-append "Invalid escape char: " (string next-char))))))) + (error 'parse-error (string-append "Invalid escape char: " (string next-char))) + ) ;else + ) ;case + ) ;let +) ;define (define string->json (lambda (s) @@ -141,14 +188,19 @@ ((s s) (bgn 0) (end 0) (rst '()) (len (string-length s)) (quts? #f) (lst '(#t))) (cond ((= end len) - (fast-string-list-append (reverse rst))) + (fast-string-list-append (reverse rst)) + ) ; ((and quts? (char=? (string-ref s end) #\\) (< (+ end 1) len)) (let-values (((unescaped step) (handle-escape-char s end len))) (loop s (+ end step) (+ end step) (cons (string-append (substring s bgn end) unescaped) rst) - len quts? lst))) + len quts? lst + ) ;loop + ) ;let-values + ) ; ((and quts? (not (char=? (string-ref s end) #\"))) - (loop s bgn (+ 1 end) rst len quts? lst)) + (loop s bgn (+ 1 end) rst len quts? lst) + ) ; (else (case (string-ref s end) ((#\{) @@ -183,9 +235,18 @@ (substring s bgn end) (if (loose-car lst) ")(" " ")) rst) len quts? lst)) ((#\") - (loop s bgn (+ 1 end) rst len (not quts?) lst)) + (loop s bgn (+ 1 end) rst len (not quts?) lst) + ) ; (else - (loop s bgn (+ 1 end) rst len quts? lst)))))))))) + (loop s bgn (+ 1 end) rst len quts? lst)) + ) ;else + ) ;case + ) ;else + ) ;cond + ) ;let + ) ;read + ) ;lambda +) ;define (define json->string (lambda (json-scm) @@ -197,13 +258,18 @@ ((boolean? x) (if x "true" "false")) ((symbol? x) (symbol->string x)) ((null? x) "{}") - (else (type-error "Unexpected x: " x))))) + (else (type-error "Unexpected x: " x)) + ) ;cond + ) ;lambda + ) ;define (define (delim x) - (if (zero? x) "" ",")) + (if (zero? x) "" ",") + ) ;define (when (procedure? json-scm) - (type-error "json->string: input must not be a procedure")) + (type-error "json->string: input must not be a procedure") + ) ;when (let loop ((lst json-scm) (x (if (vector? json-scm) "[" "{"))) (if (vector? lst) @@ -213,22 +279,34 @@ (let* ((k (vector-ref lst n)) (result (cond ((vector? k) - (loop k "[")) + (loop k "[") + ) ; ((pair? k) - (loop k "{")) + (loop k "{") + ) ; (else - (f k))))) + (f k))) + ) ;else + ) ;result (loop-v len (+ n 1) - (string-append y (delim n) result))) - (string-append y "]")))) + (string-append y (delim n) result) + ) ;loop-v + ) ;let* + (string-append y "]") + ) ;if + ) ;let + ) ;string-append (let* ((d (car lst)) (k (loose-car d)) (v (loose-cdr d))) (when (not (list? d)) - (value-error d " must be a list")) + (value-error d " must be a list") + ) ;when (let ((len (length d))) (when (not (or (= len 0) (= len -1) (>= len 2))) - (value-error d " must be null, pair, or list with at least 2 elements"))) + (value-error d " must be null, pair, or list with at least 2 elements") + ) ;when + ) ;let (if (null? (cdr lst)) (if (null? d) @@ -238,13 +316,24 @@ ((null? v) "{}") ((list? v) (loop v "{")) ((vector? v) (loop v "[")) - (else (f v))) - "}")) + (else (f v)) + ) ;cond + "}" + ) ;string-append + ) ;if (loop (cdr lst) (cond ((list? v) (string-append x (f k) ":" (loop v "{") ",")) ((vector? v) (string-append x (f k) ":" (loop v "[") ",")) - (else (string-append x (f k) ":" (f v) ",")))))))))) + (else (string-append x (f k) ":" (f v) ",")) + ) ;cond + ) ;loop + ) ;if + ) ;let* + ) ;if + ) ;let + ) ;lambda +) ;define (define json-ref @@ -255,8 +344,12 @@ (cond ((symbol=? x 'true) #t) ((symbol=? x 'false) #f) - (else x)) - x))) + (else x) + ) ;cond + x + ) ;if + ) ;lambda + ) ;define (if (vector? x) (return (vector-ref x k)) (let loop ((x x) (k k)) @@ -264,13 +357,22 @@ '() (if (equal? (caar x) k) (return (cdar x)) - (loop (cdr x) k))))))) + (loop (cdr x) k) + ) ;if + ) ;if + ) ;let + ) ;if + ) ;lambda +) ;define (define (json-ref* j . keys) (let loop ((expr j) (keys keys)) (if (null? keys) expr - (loop (json-ref expr (car keys)) (cdr keys))))) + (loop (json-ref expr (car keys)) (cdr keys)) + ) ;if + ) ;let +) ;define (define json-set (lambda (x v p) @@ -283,49 +385,84 @@ (let l ((x (vector->alist x))(p p)) (if (null? x) '() - (cons (p (cdar x)) (l (cdr x) p)))))) + (cons (p (cdar x)) (l (cdr x) p)) + ) ;if + ) ;let + ) ;if + ) ; ((procedure? v) (let l ((x (vector->alist x))(v v)(p p)) (if (null? x) '() (if (v (caar x)) (cons (p (cdar x)) (l (cdr x) v p)) - (cons (cdar x) (l (cdr x) v p)))))) + (cons (cdar x) (l (cdr x) v p)) + ) ;if + ) ;if + ) ;let + ) ; (else (let l ((x (vector->alist x))(v v)(p p)) (if (null? x) '() (if (equal? (caar x) v) (cons (p (cdar x)) (l (cdr x) v p)) - (cons (cdar x) (l (cdr x) v p)))))))) + (cons (cdar x) (l (cdr x) v p)) + ) ;if + ) ;if + ) ;let + ) ;else + ) ;cond + ) ;list->vector (cond ((boolean? v) (if v (let l ((x x)(p p)) (if (null? x) '() - (cons (cons (caar x) (p (cdar x)))(l (cdr x) p)))))) + (cons (cons (caar x) (p (cdar x)))(l (cdr x) p)) + ) ;if + ) ;let + ) ;if + ) ; ((procedure? v) (let l ((x x)(v v)(p p)) (if (null? x) '() (if (v (caar x)) (cons (cons (caar x) (p (cdar x)))(l (cdr x) v p)) - (cons (car x) (l (cdr x) v p)))))) + (cons (car x) (l (cdr x) v p)) + ) ;if + ) ;if + ) ;let + ) ; (else (let l ((x x)(v v)(p p)) (if (null? x) '() (if (equal? (caar x) v) (cons (cons v (p (cdar x)))(l (cdr x) v p)) - (cons (car x) (l (cdr x) v p))))))))))) + (cons (car x) (l (cdr x) v p)) + ) ;if + ) ;if + ) ;let + ) ;else + ) ;cond + ) ;if + ) ;let + ) ;lambda +) ;define (define (json-set* json k0 k1_or_v . ks_and_v) (if (null? ks_and_v) (json-set json k0 k1_or_v) (json-set json k0 (lambda (x) - (apply json-set* (cons x (cons k1_or_v ks_and_v))))))) + (apply json-set* (cons x (cons k1_or_v ks_and_v))) + ) ;lambda + ) ;json-set + ) ;if +) ;define (define (json-push x k v) (if (vector? x) @@ -337,14 +474,24 @@ (if b '() (cons v '())) (if (equal? (caar x) k) (cons v (cons (cdar x) (l (cdr x) k v #t))) - (cons (cdar x) (l (cdr x) k v b))))))) - (cons (cons k v) x))) + (cons (cdar x) (l (cdr x) k v b)) + ) ;if + ) ;if + ) ;let + ) ;list->vector + ) ;if + (cons (cons k v) x) + ) ;if +) ;define (define (json-push* json k0 v0 . rest) (if (null? rest) (json-push json k0 v0) (json-set json k0 - (lambda (x) (apply json-push* (cons x (cons v0 rest))))))) + (lambda (x) (apply json-push* (cons x (cons v0 rest)))) + ) ;json-set + ) ;if +) ;define (define json-drop (lambda (x v) @@ -359,14 +506,25 @@ '() (if (v (caar x)) (l (cdr x) v) - (cons (cdar x) (l (cdr x) v)))))) + (cons (cdar x) (l (cdr x) v)) + ) ;if + ) ;if + ) ;let + ) ; (else (let l ((x (vector->alist x)) (v v)) (if (null? x) '() (if (equal? (caar x) v) (l (cdr x) v) - (cons (cdar x) (l (cdr x) v))))))))) + (cons (cdar x) (l (cdr x) v)) + ) ;if + ) ;if + ) ;let + ) ;else + ) ;cond + ) ;list->vector + ) ;if (cond ((procedure? v) (let l ((x x) (v v)) @@ -374,21 +532,37 @@ '() (if (v (caar x)) (l (cdr x) v) - (cons (car x) (l (cdr x) v)))))) + (cons (car x) (l (cdr x) v)) + ) ;if + ) ;if + ) ;let + ) ; (else (let l ((x x) (v v)) (if (null? x) '() (if (equal? (caar x) v) (l (cdr x) v) - (cons (car x) (l (cdr x) v)))))))))) + (cons (car x) (l (cdr x) v)) + ) ;if + ) ;if + ) ;let + ) ;else + ) ;cond + ) ;if + ) ;lambda +) ;define (define json-drop* (lambda (json key . rest) (if (null? rest) (json-drop json key) (json-set json key - (lambda (x) (apply json-drop* (cons x rest))))))) + (lambda (x) (apply json-drop* (cons x rest))) + ) ;json-set + ) ;if + ) ;lambda +) ;define (define json-reduce (lambda (x v p) @@ -400,44 +574,74 @@ (let l ((x (vector->alist x)) (p p)) (if (null? x) '() - (cons (p (caar x) (cdar x)) (l (cdr x) p)))) - x)) + (cons (p (caar x) (cdar x)) (l (cdr x) p)) + ) ;if + ) ;let + x + ) ;if + ) ; ((procedure? v) (let l ((x (vector->alist x)) (v v) (p p)) (if (null? x) '() (if (v (caar x)) (cons (p (caar x) (cdar x)) (l (cdr x) v p)) - (cons (cdar x) (l (cdr x) v p)))))) + (cons (cdar x) (l (cdr x) v p)) + ) ;if + ) ;if + ) ;let + ) ; (else (let l ((x (vector->alist x)) (v v) (p p)) (if (null? x) '() (if (equal? (caar x) v) (cons (p (caar x) (cdar x)) (l (cdr x) v p)) - (cons (cdar x) (l (cdr x) v p)))))))) + (cons (cdar x) (l (cdr x) v p)) + ) ;if + ) ;if + ) ;let + ) ;else + ) ;cond + ) ;list->vector (cond ((boolean? v) (if v (let l ((x x) (p p)) (if (null? x) '() - (cons (cons (caar x) (p (caar x) (cdar x))) (l (cdr x) p)))) - x)) + (cons (cons (caar x) (p (caar x) (cdar x))) (l (cdr x) p)) + ) ;if + ) ;let + x + ) ;if + ) ; ((procedure? v) (let l ((x x) (v v) (p p)) (if (null? x) '() (if (v (caar x)) (cons (cons (caar x) (p (caar x) (cdar x))) (l (cdr x) v p)) - (cons (car x) (l (cdr x) v p)))))) + (cons (car x) (l (cdr x) v p)) + ) ;if + ) ;if + ) ;let + ) ; (else (let l ((x x) (v v) (p p)) (if (null? x) '() (if (equal? (caar x) v) (cons (cons v (p v (cdar x))) (l (cdr x) v p)) - (cons (car x) (l (cdr x) v p)))))))))) + (cons (car x) (l (cdr x) v p)) + ) ;if + ) ;if + ) ;let + ) ;else + ) ;cond + ) ;if + ) ;lambda +) ;define (define (json-reduce* j v1 v2 . rest) (cond @@ -448,7 +652,12 @@ (let* ((new-v1 v2) (p (last rest))) (json-reduce y new-v1 - (lambda (n m) (p (list x n) m))))))) + (lambda (n m) (p (list x n) m)) + ) ;json-reduce + ) ;let* + ) ;lambda + ) ;json-reduce + ) ; (else (json-reduce j v1 (lambda (x y) @@ -456,7 +665,15 @@ (p (last rest))) (apply json-reduce* (append (cons y (cons new-v1 (drop-right rest 1))) - (list (lambda (n m) (p (cons x n) m))))))))))) + (list (lambda (n m) (p (cons x n) m))) + ) ;append + ) ;apply + ) ;let* + ) ;lambda + ) ;json-reduce + ) ;else + ) ;cond +) ;define -) ; end of begin -) ; end of define-library +) ;begin +) ;define-library diff --git a/TeXmacs/plugins/goldfish/goldfish/liii/alist.scm b/TeXmacs/plugins/goldfish/goldfish/liii/alist.scm index 7fbd4e4cc0..7330376f14 100644 --- a/TeXmacs/plugins/goldfish/goldfish/liii/alist.scm +++ b/TeXmacs/plugins/goldfish/goldfish/liii/alist.scm @@ -8,21 +8,29 @@ (begin (define (alist? l) - (and (list? l) (every pair? l))) + (and (list? l) (every pair? l)) + ) ;define (define alist-ref (case-lambda ((alist key) (alist-ref alist key (lambda () - (key-error "alist-ref: key not found " key)))) + (key-error "alist-ref: key not found " key))) + ) ;lambda ((alist key thunk) (alist-ref alist key thunk eqv?)) ((alist key thunk =) (let ((value (assoc key alist =))) - (if value (cdr value) (thunk)))))) + (if value (cdr value) (thunk))) + ) ; + ) ;case-lambda + ) ;define (define alist-ref/default (case-lambda ((alist key default) (alist-ref alist key (lambda () default))) ((alist key default =) - (alist-ref alist key (lambda () default) =)))) + (alist-ref alist key (lambda () default) =) + ) ; + ) ;case-lambda + ) ;define ; MIT License ; Copyright guenchi (c) 2018 - 2019 @@ -32,5 +40,11 @@ '() (let loop ((x (vector->list x)) (n 0)) - (cons (cons n (car x)) (if (null? (cdr x)) '() (loop (cdr x) (+ n 1)))))))))) + (cons (cons n (car x)) (if (null? (cdr x)) '() (loop (cdr x) (+ n 1)))) + ) ;let + ) ;if + ) ;typed-lambda + ) ;define + ) ;begin +) ;define-library diff --git a/TeXmacs/plugins/goldfish/goldfish/liii/argparse.scm b/TeXmacs/plugins/goldfish/goldfish/liii/argparse.scm index 5fcfcf5550..4c57e2ca12 100644 --- a/TeXmacs/plugins/goldfish/goldfish/liii/argparse.scm +++ b/TeXmacs/plugins/goldfish/goldfish/liii/argparse.scm @@ -16,12 +16,14 @@ (define-library (liii argparse) (import (liii base) (liii error) (liii list) (liii string) (liii hash-table) (liii alist) - (liii sys)) + (liii sys) + ) ;import (export make-argument-parser) (begin (define (make-arg-record name type short-name default) - (list name type short-name default default)) + (list name type short-name default default) + ) ;define (define (convert-value value type) (case type @@ -31,56 +33,82 @@ (let ((num (string->number value))) (if num num - (error "Invalid number format" value))))) + (error "Invalid number format" value) + ) ;if + ) ;let + ) ;if + ) ; ((string) (if (string? value) value (error "Value is not a string"))) - (else (error "Unsupported type" type)))) + (else (error "Unsupported type" type)) + ) ;case + ) ;define (define (arg-type? type) (unless (symbol? type) - (type-error "type of the argument must be symbol")) - (member type '(string number))) + (type-error "type of the argument must be symbol") + ) ;unless + (member type '(string number)) + ) ;define (define (%add-argument args-ht args) (let* ((options (car args)) (name (alist-ref options 'name (lambda () - (value-error "name is required for an option")))) + (value-error "name is required for an option")) + ) ;lambda + ) ;name (type (alist-ref/default options 'type 'string)) (short-name (alist-ref/default options 'short #f)) (default (alist-ref/default options 'default #f)) (arg-record (make-arg-record name type short-name default))) (unless (string? name) - (type-error "name of the argument must be string")) + (type-error "name of the argument must be string") + ) ;unless (unless (arg-type? type) - (value-error "Invalid type of the argument" type)) + (value-error "Invalid type of the argument" type) + ) ;unless (unless (or (not short-name) (string? short-name)) (type-error - "short name of the argument must be string if given")) + "short name of the argument must be string if given" + ) ;type-error + ) ;unless (hash-table-set! args-ht name arg-record) (when short-name - (hash-table-set! args-ht short-name arg-record)))) + (hash-table-set! args-ht short-name arg-record) + ) ;when + ) ;let* + ) ;define (define (%get-argument args-ht args) (let ((found (hash-table-ref/default args-ht (car args) #f))) (if found (fifth found) - (error "Argument not found" (car args))))) + (error "Argument not found" (car args)) + ) ;if + ) ;let + ) ;define (define (long-form? arg) (and (string? arg) (>= (string-length arg) 3) - (string-starts? arg "--"))) + (string-starts? arg "--") + ) ;and + ) ;define (define (short-form? arg) (and (string? arg) (>= (string-length arg) 2) - (char=? (string-ref arg 0) #\-))) + (char=? (string-ref arg 0) #\-) + ) ;and + ) ;define (define (retrieve-args args) (if (null? args) (cddr (argv)) - (car args))) + (car args) + ) ;if + ) ;define (define (%parse-args args-ht prog-args) (let loop ((args (retrieve-args prog-args))) @@ -95,9 +123,14 @@ (error "Missing value for argument" name) (begin (let ((value (convert-value (cadr args) (cadr found)))) - (set-car! (cddddr found) value)) - (loop (cddr args)))) - (value-error (string-append "Unknown option: --" name))))) + (set-car! (cddddr found) value) + ) ;let + (loop (cddr args)) + ) ;begin + ) ;if + (value-error (string-append "Unknown option: --" name))) + ) ;if + ) ;let* ((short-form? arg) (let* ((name (substring arg 1)) (found (hash-table-ref args-ht name))) @@ -106,22 +139,41 @@ (error "Missing value for argument" name) (begin (let ((value (convert-value (cadr args) (cadr found)))) - (set-car! (cddddr found) value)) - (loop (cddr args)))) - (value-error (string-append "Unknown option: -" name))))) - (else (loop (cdr args)))))))) + (set-car! (cddddr found) value) + ) ;let + (loop (cddr args)) + ) ;begin + ) ;if + (value-error (string-append "Unknown option: -" name)) + ) ;if + ) ;let* + ) ; + (else (loop (cdr args))) + ) ;cond + ) ;let + ) ;if + ) ;let + ) ;define (define (make-argument-parser) (let ((args-ht (make-hash-table))) (lambda (command . args) (case command - ((add) (%add-argument args-ht args)) - ((add-argument) (%add-argument args-ht args)) - ((get) (%get-argument args-ht args)) - ((get-argument) (%get-argument args-ht args)) - ((parse) (%parse-args args-ht args)) - ((parse-args) (%parse-args args-ht args)) + ((:add) (%add-argument args-ht args)) + ((:add-argument) (%add-argument args-ht args)) + ((:get) (%get-argument args-ht args)) + ((:get-argument) (%get-argument args-ht args)) + ((:parse) (%parse-args args-ht args)) + ((:parse-args) (%parse-args args-ht args)) (else (if (and (null? args) (symbol? command)) (%get-argument args-ht (list (symbol->string command))) - (error "Unknown parser command" command))))))))) + (error "Unknown parser command" command) + ) ;if + ) ;else + ) ;case + ) ;lambda + ) ;let + ) ;define + ) ;begin +) ;define-library diff --git a/TeXmacs/plugins/goldfish/goldfish/liii/array-buffer.scm b/TeXmacs/plugins/goldfish/goldfish/liii/array-buffer.scm index 1a64aff641..5f605a88d5 100644 --- a/TeXmacs/plugins/goldfish/goldfish/liii/array-buffer.scm +++ b/TeXmacs/plugins/goldfish/goldfish/liii/array-buffer.scm @@ -22,37 +22,49 @@ (define-case-class array-buffer ((data vector?) (size integer?) - (capacity integer?)) + (capacity integer?) + ) ; (chained-define (@from-vector vec) (let ((len (vector-length vec))) - (array-buffer (copy vec) len len))) + (array-buffer (copy vec) len len) + ) ;let + ) ;chained-define (chained-define (@from-list lst) (let ((len (length lst))) - (array-buffer (copy lst (make-vector len)) len len))) + (array-buffer (copy lst (make-vector len)) len len) + ) ;let + ) ;chained-define (typed-define (check-bound (n integer?)) (when (or (< n 0) (>= n size)) (index-error - ($ "access No." :+ n :+ " of array-buffer [0:" :+ size :+ ")" :get)))) + ($ "access No." :+ n :+ " of array-buffer [0:" :+ size :+ ")" :get) + ) ;index-error + ) ;when + ) ;typed-define (define (%collect) - (copy data (make-vector size))) + (copy data (make-vector size)) + ) ;define (define (%length) size) (define (%apply n) (check-bound n) - (vector-ref data n)) + (vector-ref data n) + ) ;define (chained-define (%set! n v) (check-bound n) (vector-set! data n v) - (%this)) + (%this) + ) ;chained-define (define (%update! . args) - (apply %set! args)) + (apply %set! args) + ) ;define (chained-define (%extend! n) (when (< capacity n) @@ -61,40 +73,51 @@ (let loop () (when (< capacity n) (set! capacity (* 2 capacity)) - (loop)))) - (set! data (copy data (make-vector capacity) 0 size))) - (%this)) + (loop) + ) ;when + ) ;let + ) ;if + (set! data (copy data (make-vector capacity) 0 size)) + ) ;when + (%this) + ) ;chained-define (define (%size-hint! . args) (apply %extend! args)) (chained-define (%resize! n) (%extend! n) (set! size n) - (%this)) + (%this) + ) ;chained-define (chained-define (%trim-to-size! n) (%extend! n) (set! size n) (when (> capacity (* 2 size)) (set! data (copy data (make-vector size))) - (set! capacity size)) - (%this)) + (set! capacity size) + ) ;when + (%this) + ) ;chained-define (chained-define (%add-one! x) (%extend! (+ size 1)) (vector-set! data size x) (set! size (+ size 1)) - (%this)) + (%this) + ) ;chained-define (chained-define (%clear!) (set! size 0) - (%this)) + (%this) + ) ;chained-define (chained-define (%clear/shrink!) (set! size 0) (set! capacity 1) (set! data (make-vector 1)) - (%this)) + (%this) + ) ;chained-define (chained-define (%insert! index elem) (%extend! (+ size 1)) @@ -103,25 +126,33 @@ (let loop ((p (- size 1))) (when (> p index) (vector-set! data p (vector-ref data (- p 1))) - (loop (- p 1)))) + (loop (- p 1)) + ) ;when + ) ;let (vector-set! data index elem) - (%this)) + (%this) + ) ;chained-define (typed-define (%equals (that case-class?)) (and (that :is-instance-of 'array-buffer) - ((%to-vector) :equals (that :to-vector)))) + ((%to-vector) :equals (that :to-vector)) + ) ;and + ) ;typed-define (define (%to-vector) - (rich-vector (copy data (make-vector size)))) + (rich-vector (copy data (make-vector size))) + ) ;define (define (%to-list) - (vector->list data 0 size)) + (vector->list data 0 size) + ) ;define (define (%to-rich-list) - (box (%to-list))) + (box (%to-list)) + ) ;define - ) ; end of array-buffer + ) ;define-case-class - ) ; end of begin - ) ; end of define-library + ) ;begin +) ;define-library diff --git a/TeXmacs/plugins/goldfish/goldfish/liii/ascii.scm b/TeXmacs/plugins/goldfish/goldfish/liii/ascii.scm index 770c93d2b5..0a243f435a 100644 --- a/TeXmacs/plugins/goldfish/goldfish/liii/ascii.scm +++ b/TeXmacs/plugins/goldfish/goldfish/liii/ascii.scm @@ -54,5 +54,27 @@ ascii-string-ci? ascii-string-ci<=? - ascii-string-ci>=?) - (import (srfi srfi-175))) + ascii-string-ci>=? + + ascii-left-paren? + ascii-right-paren? + ) ;export + (import (srfi srfi-175)) + (begin + + (define (ascii-left-paren? x) + (if (char? x) + (char=? x #\() + (and (integer? x) (= x #x28)) + ) ;if + ) ;define + + (define (ascii-right-paren? x) + (if (char? x) + (char=? x #\)) + (and (integer? x) (= x #x29)) + ) ;if + ) ;define + + ) ;begin +) ;define-library diff --git a/TeXmacs/plugins/goldfish/goldfish/liii/bag.scm b/TeXmacs/plugins/goldfish/goldfish/liii/bag.scm index 7c24548060..1e3957aef7 100644 --- a/TeXmacs/plugins/goldfish/goldfish/liii/bag.scm +++ b/TeXmacs/plugins/goldfish/goldfish/liii/bag.scm @@ -28,8 +28,10 @@ bag-union! bag-intersection! bag-difference! bag-xor! bag-adjoin bag-adjoin! bag-replace bag-replace! bag-delete bag-delete! bag-delete-all bag-delete-all! - bag-search!) - (srfi srfi-128)) + bag-search! + ) ;only + (srfi srfi-128) + ) ;import (export bag bag-unfold bag-member bag-comparator bag->list list->bag list->bag! bag-copy bag? bag-contains? bag-empty? bag-disjoint? @@ -39,14 +41,17 @@ bag-union! bag-intersection! bag-difference! bag-xor! bag-adjoin bag-adjoin! bag-replace bag-replace! bag-delete bag-delete! bag-delete-all bag-delete-all! - bag-search!) + bag-search! + ) ;export (define comp (make-default-comparator)) (define (bag . elements) - (apply make-bag-with-comparator comp elements)) + (apply make-bag-with-comparator comp elements) + ) ;define (define (list->bag elements) - (list->bag-with-comparator comp elements)) + (list->bag-with-comparator comp elements) + ) ;define -) ; end of define-library +) ;define-library diff --git a/TeXmacs/plugins/goldfish/goldfish/liii/base.scm b/TeXmacs/plugins/goldfish/goldfish/liii/base.scm index d0144848c4..77492f2b38 100644 --- a/TeXmacs/plugins/goldfish/goldfish/liii/base.scm +++ b/TeXmacs/plugins/goldfish/goldfish/liii/base.scm @@ -17,7 +17,8 @@ (define-library (liii base) (import (scheme base) (srfi srfi-2) - (srfi srfi-8)) + (srfi srfi-8) + ) ;import (export ; (scheme base) defined by R7RS let-values @@ -60,21 +61,26 @@ loose-car loose-cdr compose identity any? ; Extra structure let1 typed-lambda - ) + ) ;export (begin (define* (u8-substring str (start 0) (end #t)) - (utf8->string (string->utf8 str start end))) + (utf8->string (string->utf8 str start end)) + ) ;define* (define (loose-car pair-or-empty) (if (eq? '() pair-or-empty) '() - (car pair-or-empty))) + (car pair-or-empty) + ) ;if + ) ;define (define (loose-cdr pair-or-empty) (if (eq? '() pair-or-empty) '() - (cdr pair-or-empty))) + (cdr pair-or-empty) + ) ;if + ) ;define (define identity (lambda (x) x)) @@ -82,13 +88,17 @@ (if (null? fs) (lambda (x) x) (lambda (x) - ((car fs) ((apply compose (cdr fs)) x))))) + ((car fs) ((apply compose (cdr fs)) x)) + ) ;lambda + ) ;if + ) ;define (define (any? x) #t) (define-macro (let1 name1 value1 . body) `(let ((,name1 ,value1)) - ,@body)) + ,@body) + ) ;define-macro ; 0 clause BSD, from S7 repo stuff.scm (define-macro (typed-lambda args . body) @@ -99,7 +109,9 @@ (do ((p new-args (cdr p))) ((not (pair? p))) (if (pair? (car p)) - (set-car! p (caar p)))) + (set-car! p (caar p)) + ) ;if + ) ;do `(lambda ,new-args ,@(map (lambda (arg) (if (pair? arg) @@ -108,8 +120,11 @@ "~S is not ~S~%" ',(car arg) ',(cadr arg))) (values))) args) - ,@body)))) + ,@body) + ) ;let + ) ;if + ) ;define-macro - ) ; end of begin - ) ; end of define-library + ) ;begin +) ;define-library diff --git a/TeXmacs/plugins/goldfish/goldfish/liii/base64.scm b/TeXmacs/plugins/goldfish/goldfish/liii/base64.scm index 2ef43889c3..0f61643c41 100644 --- a/TeXmacs/plugins/goldfish/goldfish/liii/base64.scm +++ b/TeXmacs/plugins/goldfish/goldfish/liii/base64.scm @@ -17,10 +17,12 @@ (define-library (liii base64) (import (liii base) (liii bitwise)) (export string-base64-encode bytevector-base64-encode base64-encode string-base64-decode - bytevector-base64-decode base64-decode) + bytevector-base64-decode base64-decode + ) ;export (begin (define-constant BYTE2BASE64_BV - (string->utf8 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")) + (string->utf8 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") + ) ;define-constant (define-constant BASE64_PAD_BYTE (char->integer #\=)) @@ -38,10 +40,15 @@ (values (BYTE2BASE64_BV c1) (BYTE2BASE64_BV c2) (if b2 (BYTE2BASE64_BV c3) - BASE64_PAD_BYTE) + BASE64_PAD_BYTE + ) ;if (if b3 (BYTE2BASE64_BV c4) - BASE64_PAD_BYTE)))) + BASE64_PAD_BYTE + ) ;if + ) ;values + ) ;let* + ) ;define (let* ((input-N (bytevector-length bv)) (output-N (* 4 (ceiling (/ input-N 3)))) (output (make-bytevector output-N))) @@ -51,36 +58,56 @@ (let* ((b1 (bv i)) (b2 (if (< (+ i 1) input-N) (bv (+ i 1)) - #f)) + #f) + ) ;b2 (b3 (if (< (+ i 2) input-N) (bv (+ i 2)) - #f))) + #f)) + ) ;b3 (receive (r1 r2 r3 r4) (encode b1 b2 b3) (bytevector-u8-set! output j r1) (bytevector-u8-set! output (+ j 1) r2) (bytevector-u8-set! output (+ j 2) r3) - (bytevector-u8-set! output (+ j 3) r4) (loop (+ i 3) (+ j 4)))))) - output))) + (bytevector-u8-set! output (+ j 3) r4) (loop (+ i 3) (+ j 4)) + ) ;receive + ) ;let* + ) ;when + ) ;let + output + ) ;let* + ) ;typed-lambda + ) ;define (define string-base64-encode (typed-lambda ((str string?)) (utf8->string - (bytevector-base64-encode (string->utf8 str))))) + (bytevector-base64-encode (string->utf8 str)) + ) ;utf8->string + ) ;typed-lambda + ) ;define (define (base64-encode x) (cond ((string? x) (string-base64-encode x)) ((bytevector? x) (bytevector-base64-encode x)) (else - (type-error "input must be string or bytevector")))) + (type-error "input must be string or bytevector") + ) ;else + ) ;cond + ) ;define (define-constant BASE64_TO_BYTE_V - (let1 byte2base64-N (bytevector-length BYTE2BASE64_BV) + (let ((byte2base64-N (bytevector-length BYTE2BASE64_BV))) (let loop ((i 0) (v (make-vector 256 -1))) (if (< i byte2base64-N) (begin (vector-set! v (BYTE2BASE64_BV i) i) - (loop (+ i 1) v)) - v)))) + (loop (+ i 1) v) + ) ;begin + v + ) ;if + ) ;let + ) ;let + ) ;define-constant (define (bytevector-base64-decode bv) (define (decode c1 c2 c3 c4) @@ -91,22 +118,31 @@ (if (or (negative? b1) (negative? b2) (and (negative? b3) - (not (equal? c3 BASE64_PAD_BYTE))) + (not (equal? c3 BASE64_PAD_BYTE)) + ) ;and (and (negative? b4) - (not (equal? c4 BASE64_PAD_BYTE)))) + (not (equal? c4 BASE64_PAD_BYTE))) + ) ;and (value-error "Invalid base64 input") (values (bitwise-ior (ash b1 2) (ash b2 -4)) (bitwise-and (bitwise-ior (ash b2 4) (ash b3 -2)) 255) (bitwise-and (bitwise-ior (ash b3 6) b4) 255) (if (negative? b3) 1 - (if (negative? b4) 2 3)))))) + (if (negative? b4) 2 3) + ) ;if + ) ;values + ) ;if + ) ;let* + ) ;define (let* ((input-N (bytevector-length bv)) (output-N (* input-N 3/4)) (output (make-bytevector output-N))) (unless (zero? (modulo input-N 4)) (value-error - "length of the input bytevector must be 4X")) + "length of the input bytevector must be 4X" + ) ;value-error + ) ;unless (let loop ((i 0) (j 0)) (if (< i input-N) @@ -114,21 +150,37 @@ (decode (bv i) (bv (+ i 1)) (bv (+ i 2)) (bv (+ i 3))) (bytevector-u8-set! output j r1) (when (>= cnt 2) - (bytevector-u8-set! output (+ j 1) r2)) + (bytevector-u8-set! output (+ j 1) r2) + ) ;when (when (>= cnt 3) - (bytevector-u8-set! output (+ j 2) r3)) - (loop (+ i 4) (+ j cnt))) + (bytevector-u8-set! output (+ j 2) r3) + ) ;when + (loop (+ i 4) (+ j cnt)) + ) ;receive (let ((final (make-bytevector j))) (vector-copy! final 0 output 0 j) - final))))) + final + ) ;let + ) ;if + ) ;let + ) ;let* + ) ;define (define string-base64-decode (typed-lambda ((str string?)) (utf8->string - (bytevector-base64-decode (string->utf8 str))))) + (bytevector-base64-decode (string->utf8 str)) + ) ;utf8->string + ) ;typed-lambda + ) ;define (define (base64-decode x) (cond ((string? x) (string-base64-decode x)) ((bytevector? x) (bytevector-base64-decode x)) (else - (type-error "input must be string or bytevector")))))) + (type-error "input must be string or bytevector") + ) ;else + ) ;cond + ) ;define + ) ;begin +) ;define-library diff --git a/TeXmacs/plugins/goldfish/goldfish/liii/bitwise.scm b/TeXmacs/plugins/goldfish/goldfish/liii/bitwise.scm index 18a832a523..a289ed67f7 100644 --- a/TeXmacs/plugins/goldfish/goldfish/liii/bitwise.scm +++ b/TeXmacs/plugins/goldfish/goldfish/liii/bitwise.scm @@ -23,7 +23,10 @@ bitwise-nand bit-count bitwise-orc1 bitwise-orc2 bitwise-andc1 bitwise-andc2 arithmetic-shift integer-length bitwise-if bit-set? copy-bit bit-swap any-bit-set? every-bit-set? first-set-bit bit-field bit-field-any? bit-field-every? bit-field-clear - bit-field-set) + bit-field-set + ) ;export (begin - (define bitwise-or bitwise-ior))) + (define bitwise-or bitwise-ior) + ) ;begin +) ;define-library diff --git a/TeXmacs/plugins/goldfish/goldfish/liii/case.scm b/TeXmacs/plugins/goldfish/goldfish/liii/case.scm index 1ac938edaf..d2a67eb0b3 100644 --- a/TeXmacs/plugins/goldfish/goldfish/liii/case.scm +++ b/TeXmacs/plugins/goldfish/goldfish/liii/case.scm @@ -23,7 +23,8 @@ (define case* (let ((case*-labels (lambda (label) (let ((labels ((funclet ((funclet 'case*) 'case*-helper)) 'labels))) - (labels (symbol->string label))))) ; if ellipsis, this has been quoted by case* + (labels (symbol->string label)))) ; if ellipsis, this has been quoted by case* + ) ;let (case*-match? (lambda* (matchee pattern (e (curlet))) (let ((matcher ((funclet ((funclet 'case*) 'case*-helper)) 'handle-sequence))) @@ -32,7 +33,12 @@ (vector? matchee)) (begin (fill! ((funclet ((funclet 'case*) 'case*-helper)) 'labels) #f) ; clear labels - ((matcher pattern e) matchee))))))) + ((matcher pattern e) matchee)) + ) ;begin + ) ;and + ) ;or + ) ;let + ) ;case*-match? (case*-helper (with-let (unlet) (define labels (make-hash-table)) @@ -42,20 +48,32 @@ (or (equal? pat #<...>) (let ((str (object->string pat))) (and (char-position #\: str) - (string=? "...>" (substring str (- (length str) 4)))))))) + (string=? "...>" (substring str (- (length str) 4))) + ) ;and + ) ;let + ) ;or + ) ;and + ) ;define (define (ellipsis-pair-position pos pat) (and (pair? pat) (if (ellipsis? (car pat)) pos - (ellipsis-pair-position (+ pos 1) (cdr pat))))) + (ellipsis-pair-position (+ pos 1) (cdr pat)) + ) ;if + ) ;and + ) ;define (define (ellipsis-vector-position pat vlen) (let loop ((pos 0)) (and (< pos vlen) (if (ellipsis? (pat pos)) pos - (loop (+ pos 1)))))) + (loop (+ pos 1)) + ) ;if + ) ;and + ) ;let + ) ;define (define (splice-out-ellipsis sel pat pos e) (let ((sel-len (length sel)) @@ -64,7 +82,10 @@ (let* ((str (object->string (pat pos))) (colon (char-position #\: str))) (and colon - (substring str 2 colon)))))) + (substring str 2 colon))) + ) ;and + ) ;let* + ) ;ellipsis-label (let ((func (and (string? ellipsis-label) (let ((comma (char-position #\, ellipsis-label))) (and comma @@ -72,67 +93,100 @@ (set! ellipsis-label (substring ellipsis-label 0 comma)) (let ((func-val (symbol->value (string->symbol str) e))) (if (undefined? func-val) - (error 'unbound-variable "function ~S is undefined\n" func)) + (error 'unbound-variable "function ~S is undefined\n" func) + ) ;if (if (not (procedure? func-val)) - (error 'wrong-type-arg "~S is not a function\n" func)) - func-val))))))) + (error 'wrong-type-arg "~S is not a function\n" func) + ) ;if + func-val))) + ) ;let + ) ;let + ) ;and + ) ;let (if (pair? pat) (cond ((= pos 0) ; ellipsis at start of pattern (if ellipsis-label (set! (labels ellipsis-label) - (list 'quote (copy sel (make-list (- sel-len new-pat-len)))))) + (list 'quote (copy sel (make-list (- sel-len new-pat-len)))) + ) ;set! + ) ;if (values (list-tail sel (- sel-len new-pat-len)) (cdr pat) (or (not func) - (func (cadr (labels ellipsis-label)))))) ; value is (quote ...) and we want the original list here + (func (cadr (labels ellipsis-label)))) ; value is (quote ...) and we want the original list here + ) ;or + ) ;values ((= pos new-pat-len) ; ellipsis at end of pattern (if ellipsis-label (set! (labels ellipsis-label) - (list 'quote (copy sel (make-list (- sel-len pos)) pos)))) + (list 'quote (copy sel (make-list (- sel-len pos)) pos)) + ) ;set! + ) ;if (values (copy sel (make-list pos)) (copy pat (make-list pos)) (or (not func) - (func (cadr (labels ellipsis-label)))))) + (func (cadr (labels ellipsis-label))) + ) ;or + ) ;values + ) ; (else ; ellipsis somewhere in the middle (let ((new-pat (make-list new-pat-len)) (new-sel (make-list new-pat-len))) (if ellipsis-label (set! (labels ellipsis-label) - (list 'quote (copy sel (make-list (- sel-len new-pat-len)) pos)))) + (list 'quote (copy sel (make-list (- sel-len new-pat-len)) pos)) + ) ;set! + ) ;if (copy pat new-pat 0 pos) (copy pat (list-tail new-pat pos) (+ pos 1)) (copy sel new-sel 0 pos) (copy sel (list-tail new-sel pos) (- sel-len pos)) (values new-sel new-pat (or (not func) - (func (cadr (labels ellipsis-label)))))))) + (func (cadr (labels ellipsis-label))) + ) ;or + ) ;values + ) ;let + ) ;else + ) ;cond (cond ((= pos 0) (if ellipsis-label (set! (labels ellipsis-label) - (list 'quote (copy sel (make-list (- sel-len new-pat-len)))))) + (list 'quote (copy sel (make-list (- sel-len new-pat-len)))) + ) ;set! + ) ;if (values (subvector sel (max 0 (- sel-len new-pat-len)) sel-len) ; was new-pat-len (max 0 (- sel-len new-pat-len)) (subvector pat 1 (+ new-pat-len 1)) ; new-pat-len 1 (or (not func) - (func (cadr (labels ellipsis-label)))))) + (func (cadr (labels ellipsis-label)))) + ) ;or + ) ;values ((= pos new-pat-len) (if ellipsis-label (set! (labels ellipsis-label) - (list 'quote (copy sel (make-list (- sel-len new-pat-len)) pos)))) + (list 'quote (copy sel (make-list (- sel-len new-pat-len)) pos)) + ) ;set! + ) ;if (values (subvector sel 0 new-pat-len) (subvector pat 0 new-pat-len) (or (not func) - (func (cadr (labels ellipsis-label)))))) + (func (cadr (labels ellipsis-label))) + ) ;or + ) ;values + ) ; (else (let ((new-pat (make-vector new-pat-len)) (new-sel (make-vector new-pat-len))) (if ellipsis-label (set! (labels ellipsis-label) - (list 'quote (copy sel (make-list (- sel-len new-pat-len)) pos)))) + (list 'quote (copy sel (make-list (- sel-len new-pat-len)) pos)) + ) ;set! + ) ;if (copy pat new-pat 0 pos) (copy pat (subvector new-pat pos new-pat-len) (+ pos 1)) ; (- new-pat-len pos) pos) copy: (+ pos 1)) (copy sel new-sel 0 pos) @@ -140,7 +194,16 @@ ; (- new-pat-len pos) pos) copy: (- sel-len pos)) (values new-sel new-pat (or (not func) - (cadr (func (labels ellipsis-label)))))))))))) + (cadr (func (labels ellipsis-label))) + ) ;or + ) ;values + ) ;let + ) ;else + ) ;cond + ) ;if + ) ;let + ) ;let + ) ;define (define (handle-regex x) #f) ;(define handle-regex @@ -163,7 +226,8 @@ (let* ((str1 (object->string undef)) (str1-end (- (length str1) 1))) (if (not (char=? (str1 str1-end) #\>)) - (error 'wrong-type-arg "pattern descriptor does not end in '>': ~S\n" str1)) + (error 'wrong-type-arg "pattern descriptor does not end in '>': ~S\n" str1) + ) ;if (let ((str (substring str1 2 str1-end))) (if (= (length str) 0) ; #<> = accept anything (lambda (x) #t) @@ -173,18 +237,23 @@ (func (substring str (+ colon 1)))) ; func might be "" (cond ((labels label) ; see if we already have saved something under this label (lambda (sel) ; if so, return function that will return an error - (error 'syntax-error "label ~S is defined twice: old: ~S, new: ~S~%" label (labels label) sel))) + (error 'syntax-error "label ~S is defined twice: old: ~S, new: ~S~%" label (labels label) sel)) + ) ;lambda ;; otherwise the returned function needs to store the current sel-item under label in labels ((zero? (length func)) (lambda (x) (set! (labels label) x) ; #, set label, accept anything - #t)) + #t + ) ;lambda + ) ; ((char=? (func 0) #\") ; labelled regex, # (lambda (x) (set! (labels label) x) - (handle-regex func))) + (handle-regex func) + ) ;lambda + ) ; (else ; # (let ((func-val (symbol->value (string->symbol func) e))) @@ -194,27 +263,49 @@ (error 'wrong-type-arg "~S is not a function\n" func) (lambda (x) ; set label and call func (set! (labels label) x) - (func-val x))))))))) + (func-val x)) + ) ;lambda + ) ;if + ) ;if + ) ;let + ) ;else + ) ;cond + ) ;let ;; if no colon either #