;;;; standard library ;;; void (def (void . rest) «Return the constant `#<void>` while ignoring any arguments. `#<void>` is mainly used when a function has side effects but does not produce any meaningful value to return, so even though `T` or `NIL` could be returned instead, in case of `#<void>` alone, REPL will not print it.» :doc-group misc :doc-see void? #.(void)) (def (void? v) «Return `T` if `v` is `#<void>`, `NIL` otherwise.» :doc-group type :doc-group misc :doc-see void (eq? v #.(void))) ;;; syntax environment (unless (bound? '*syntax-environment*) (def *syntax-environment* «Table containing macro definitions. The keys are macro names, the values are their application functions.» :doc-group syntax :doc-see get-syntax :doc-see set-syntax! (table))) (def (set-syntax! sym fn) «Associate a macro name with its application function.» :doc-group syntax :doc-see defmacro :doc-see get-syntax (put! *syntax-environment* sym fn)) (def (get-syntax sym) «Return a macro application function based on its name, or `NIL` if it's not defined.» :doc-group syntax :doc-see set-syntax! (get *syntax-environment* sym NIL)) ;;; props ;; This is implemented in a slightly different fashion as expected:;;;; *properties* : key → { symbol → value };;;; The assumption here is that keys will most likely be the same across multiple symbols;; so it makes more sense to reduce the number of subtables for the *properties* table.(unless (bound? '*properties*) (def *properties* «All properties of symbols recorded with `putprop` are in this table.» :doc-group prop (table))) (def (putprop symbol key val) «Associate a property with the symbol, return the value.» :doc-example «(def x '(1 2 3)) (putprop x 'words "one two three") ; ↳ "one two three" (getprop x 'words) ; ↳ "one two three"» :doc-group prop :doc-see getprop :doc-see remprop (let ((kt (get *properties* key NIL))) (unless kt (let ((ta (table))) (put! *properties* key ta) (set! kt ta))) (put! kt symbol val) val)) (def (getprop symbol key (def NIL def-supplied?)) «Return a property value associated with the symbol or `def` if missing. If the default value is not supplied and the property is missing, exception `key-error` will be thrown.» :doc-example «(def x '(1 2 3)) (putprop x 'words "one two three") ; ↳ "one two three" (getprop x 'words) ; ↳ "one two three" (getprop x 'huh) ; ‼ key not found: huh (getprop x 'huh "fallback") ; ↳ "fallback"» :doc-group prop :doc-see putprop :doc-see remprop (let ((kt (get *properties* key NIL))) (if def-supplied? (or (and kt (get kt symbol def)) def) (if (and kt (has? kt symbol)) (get kt symbol) (raise (list 'key-error key)))))) (def (remprop symbol key) «Remove a property associated with the symbol. Returns `T` if the property was removed, `NIL` if there was no such association defined for the symbol.» :doc-example «(def x '(1 2 3)) (putprop x 'words "one two three") ; ↳ "one two three" (remprop x 'unknown) ; no such association ; ↳ NIL (getprop x 'words NIL) ; ↳ "one two three" (remprop x 'words) ; ↳ T (getprop x 'words NIL) ; ↳ NIL» :doc-group prop :doc-see getprop :doc-see putprop (let ((kt (get *properties* key NIL))) (and kt (has? kt symbol) (del! kt symbol) T))) ;;; documentation (def (separate-doc-from-body body (doc NIL)) «Take a list of terms and return a pair `(doc . body)`, where the first element contains a list of documentation-related terms, and the second contains the rest of the terms.» :doc-group doc (def (doc? kw) (<= :doc-a kw :doc-z)) (def (maybe-lambda t) (if (and (cons? t) (eq? (car t) 'λ) (cons? (cadr t))) (compile t) t)) (let {[hd (car body)] [tl (cdr body)]} (cond [(and (str? hd) (not doc) tl) (separate-doc-from-body tl (cons hd doc))] [(and doc (doc? hd)) (separate-doc-from-body (cdr tl) (cons (cons hd (maybe-lambda (car tl))) doc))] [else (cons (reverse doc) body)]))) (def (set-doc! symbol doc-seq . formals-list) «Set the documentation for the symbol.» :doc-group doc (def (formals-clean fs) (when (atom? fs) (return fs)) (let ((f (car fs))) (cons (if (and (cons? f) (length> f 2)) (subseq f 0 2) f) (formals-clean (cdr fs))))) (def (trim-indent s) (unless (and (bound? 'str-trim) (bound? 'str-join)) (return s)) (let* {[lines (str-split s "\n")] [hd (car lines)] [tl (cdr lines)] [indent (and tl (apply min (map (λ (s) (and (> (length s) 0) (- (length s) (length (str-trim s))))) tl)))] [trimmed (and tl (map (λ (s) (if (<= indent (length s)) (str-sub s indent) s)) tl))]} (str-join (cons hd trimmed) "\n"))) (def (extra-clean e) (unless (and (cons? e) (str? (cdr e))) (return e)) (set-cdr! e (trim-indent (cdr e)))) (let* {[doc-only (str? doc-seq)] [doc (if doc-only doc-seq (car doc-seq))] [extra (if doc-only NIL (map extra-clean (cdr doc-seq)))] [formals-list (map formals-clean formals-list)]} (when doc (putprop symbol '*doc* (trim-indent doc)) (when extra (putprop symbol '*doc-extra* extra))) (when (cons? formals-list) (putprop symbol '*formals-list* (remove-duplicates [append (getprop symbol '*formals-list* NIL) formals-list]))) #.(void))) (def (help-print-header term sigs (:kind NIL) (:lpad "")) «Format and print signatures of the term for `(help term)` output.» :doc-group doc (def (print-type e) (set! print-type void) (princ " ;; [" [cond ((not (sym? e)) (type-of e)) ((and (sym? e) (bound? e)) (type-of (top-level-value term))) ((get-syntax e) "macro") (else "any")] "]")) (def (term->str term) (with-output (b) (with-bindings ((*print-readably* T) (*print-pretty* NIL)) (write term b)))) (if sigs (for-each (λ (sig) (let* {[sug (term->str (cons term sig))] [b (buffer)] [sig (with-bindings ((*print-syntax-sugar* NIL)) (term->str (cons term sig)))]} (princ lpad) (princ sug) (unless (equal? sug sig) (princ " | " sig)) (print-type term) (newline))) sigs) (princ lpad) (if kind (princ (caddr term) " ;; [doc group]") (print term) (print-type term)) (newline)) (newline)) (defmacro (help (topic NIL topic-supplied) (:print-header help-print-header) . rest) «Display documentation for a specific term or group of terms, if available. An optional symbol `group` is used to query for documentation on a group instead of a single term. All available documentation groups can be displayed with `(help groups)`. Asterisk can be added to the beginning and/or end of the term in order to list the matching terms defined in the current environment. This can be useful to recall a function's name. Rune `↳` followed by an object appearing in the documentation describes the returned value. Rune `‼` follows by what is being written to the output or by an error raised.» :doc-example «(help str?) ; show documentation for str? (help groups) ; show documentation groups (help type group) ; list items for dealing with types (help group type) ; same as above (help str->*) ; find functions converting from strings (help *->str) ; find functions converting to strings (help *num*) ; find anything related to numbers» :doc-group doc (let* {[topic (if topic-supplied topic 'help)] [term (if (eq? topic 'group) (car rest) topic)] [kind (if (eq? topic term) (car rest) topic)] [doc-extra-term (and kind (cons (sym ":doc-" kind) term))] [docterm (if kind (list 'doc kind term) term)] [doc (getprop docterm '*doc* NIL)] [formals-list (getprop docterm '*formals-list* NIL)] [term-bound (and (sym? term) (or (bound? term) (get-syntax term)))] [buf-mode (io-buffer-mode *io-out*)]} (io-buffer-mode! *io-out* :block) (def (deunicode str) (if (member +os-name+ '("dos" "macos" "unknown")) (str-map (λ (r) (case r (#\↳ "->") (#\… "...") (#\‼ "!!") (#\λ "lambda") (#\₀ #\0) (#\₁ #\1) (#\ₙ #\n) (#\ᵢ #\i) (else r))) str) str)) (def (environment-find-matching) (let* {[s (str term)] [ts (eq? 0 (str-find s "*"))] ; starts with [s (or (and ts (str-sub s 1)) s)] [ei (1- (length s))] [te (eq? (str-find s "*") ei)] ; ends with [s (or (and te (str-sub s 0 ei)) s)] [slen (length s)] [matches? (λ (term) (let* {[name (str term)] [i (str-find name s)] [nlen (and i (length name))]} (and i (or ts (= 0 i)) (or te (= nlen (+ i slen))))))] [matching (nconc (filter matches? (environment)) (filter matches? (table-keys *syntax-environment*)))]} (when matching (for-each (λ (term) (princ term) (newline)) (sort matching <))))) (def (print-sig term sigs lpad) (with-bindings ((*print-syntax-sugar* NIL) (*print-pretty* NIL)) (if sigs (for-each (λ (sig) (newline) (princ lpad) (print (cons term sig))) sigs) (newline) (princ lpad) (print term)))) (def (princ-indent s lpad) (for-each (λ (line) (princ lpad line) (newline)) (str-split s "\n"))) (def (first-line s) (str-sub s 0 (str-find s "\n"))) (def (doc-group? k) (and (cons? k) (eq? (car k) 'doc) (eq? (cadr k) 'group))) (def (doc-extra-term? k) (and (atom? k) (member doc-extra-term (getprop k '*doc-extra* NIL)))) (def (table-keys-filter-sort tbl pred) (sort (table-fold (λ (k _ z) (if (pred k) (cons k z) z)) NIL tbl) <)) (if (eq? term 'groups) (for-each (λ (k) (princ " " (str-pad (str (caddr k)) 10 :align :left) (first-line (getprop k '*doc* NIL))) (newline)) (table-keys-filter-sort (get *properties* '*doc*) doc-group?)) (if (or doc formals-list) (let* {[extra (getprop docterm '*doc-extra* NIL)] [fmt (filter (λ (v) (eq? (car v) :doc-fmt)) extra)] [see (filter (λ (v) (eq? (car v) :doc-see)) extra)] [grp (filter (λ (v) (eq? (car v) :doc-group)) extra)] [exa (filter (λ (v) (eq? (car v) :doc-example)) extra)]} (and print-header (print-header docterm formals-list :kind kind)) (when doc (princ (deunicode (foldl (λ (fmt doc) ((cdr fmt) doc)) doc fmt))) (newline)) (when exa (newline) (princ "Examples:") (newline) (for-each (λ (e) (newline) (princ-indent (deunicode (cdr e)) " ")) exa)) (when see (newline) (princ "See also:") (newline) (for-each (λ (v) (print-sig (cdr v) (getprop (cdr v) '*formals-list* NIL) " ")) see) (newline)) (when grp (newline) (princ "Groups:") (newline) (for-each (λ (g) (newline) (princ " (help group " (cdr g) ")")) grp) (newline)) (when kind (newline) (princ "Members:") (newline) (for-each (λ (k) (print-sig k (getprop k '*formals-list* NIL) " ")) (table-keys-filter-sort (get *properties* '*doc*) doc-extra-term?)) (newline)) #.(void)) (unless (and (not term-bound) (environment-find-matching)) (princ "no help for " (if kind (str kind " ") "") term) (when (and (not kind) (sym? term) (not term-bound)) (princ " (undefined)")) (newline)))) (io-buffer-mode! *io-out* buf-mode) (io-flush *io-out*) (void))) ;; chicken & egg problem - need doc logic to define a doc group(doc-group prop «Dealing with properties of symbols.») ;;; standard procedures (def (member item lst) «Return the tail of a list beginning with the item, or `NIL` otherwise. List elements are compared to the `item` using `equal?`.» :doc-example «(member 1 '(3 2 1 0)) ; ↳ (1 0)» :doc-example «(member 1 '(2 3)) ; ↳ NIL» :doc-group list :doc-see memq :doc-see memv (cond ((equal? (car lst) item) lst) (lst (member item (cdr lst))))) (def (memv item lst) «Return the tail of a list beginning with the item, or `NIL` otherwise. List elements are compared to the `item` using `eqv?`.» :doc-group list :doc-see member :doc-see memq (cond ((eqv? (car lst) item) lst) (lst (memv item (cdr lst))))) (def (assoc-list . kvs) «Construct an association list from the arguments. Every two arguments are expected to be a key and a value associated with that key.» :doc-example «(assoc-list 'a 0 'b 1) ; ↳ ((a . 0) (b . 1))» :doc-group list :doc-see assoc (let ((s (cdr kvs))) (when (cons? s) (cons (cons (car kvs) (car s)) (apply assoc-list (cdr s)))))) (def (assoc key lst) «Return a pair of a matching key and the associated value, or `NIL` if none matched. Keys are compared using `equal?`.» :doc-example «(def L (assoc-list 'a 0 'b 1)) (assoc 'b L) ; ↳ (b . 1) (assoc 'c L) ; ↳ NIL» :doc-group list :doc-see assoc-list :doc-see assq :doc-see assv (cond ((equal? (caar lst) key) (car lst)) (lst (assoc key (cdr lst))))) (def (assv key lst) «Return a pair of a matching key and the associated value, or `NIL` if none matched. Keys are compared using `eqv?`.» :doc-group list :doc-see assoc :doc-see assq (cond ((eqv? (caar lst) key) (car lst)) (lst (assv key (cdr lst))))) (doc-group compare «Comparison operators.») (def (> v . rest) «Return `T` if the arguments are in strictly decreasing order (previous one is greater than the next one).» :doc-group compare (let loop ((v v) (rest rest)) (or (not rest) (and (< (car rest) v) (loop (car rest) (cdr rest))))))(defmacro (> v . rest) `(< ,.(reverse rest) ,v)) (def (<= v . rest) «Return `T` if the arguments are in non-decreasing order (previous one is less than or equal to the next one).» :doc-group compare (let loop ((v v) (rest rest)) (or (not rest) (unless (or (< (car rest) v) (nan? v)) (loop (car rest) (cdr rest)))))) (def (>= v . rest) «Return `T` if the arguments are in non-increasing order (previous one is greater than or equal to the next one).» :doc-group compare (let loop ((v v) (rest rest)) (or (not rest) (unless (or (< v (car rest)) (nan? v)) (loop (car rest) (cdr rest)))))) (def (negative? n) «Return `T` if `n` is a negative number. Shorthand for `(< n 0)`.» :doc-group number :doc-group compare (< n 0)) Lines 1–500 of 3787. Load more
;;;; standard library ;;; void (def (void . rest) «Return the constant `#<void>` while ignoring any arguments. `#<void>` is mainly used when a function has side effects but does not produce any meaningful value to return, so even though `T` or `NIL` could be returned instead, in case of `#<void>` alone, REPL will not print it.» :doc-group misc :doc-see void? #.(void)) (def (void? v) «Return `T` if `v` is `#<void>`, `NIL` otherwise.» :doc-group type :doc-group misc :doc-see void (eq? v #.(void))) ;;; syntax environment (unless (bound? '*syntax-environment*) (def *syntax-environment* «Table containing macro definitions. The keys are macro names, the values are their application functions.» :doc-group syntax :doc-see get-syntax :doc-see set-syntax! (table))) (def (set-syntax! sym fn) «Associate a macro name with its application function.» :doc-group syntax :doc-see defmacro :doc-see get-syntax (put! *syntax-environment* sym fn)) (def (get-syntax sym) «Return a macro application function based on its name, or `NIL` if it's not defined.» :doc-group syntax :doc-see set-syntax! (get *syntax-environment* sym NIL)) ;;; props ;; This is implemented in a slightly different fashion as expected: ;; ;; *properties* : key → { symbol → value } ;; ;; The assumption here is that keys will most likely be the same across multiple symbols ;; so it makes more sense to reduce the number of subtables for the *properties* table. (unless (bound? '*properties*) (def *properties* «All properties of symbols recorded with `putprop` are in this table.» :doc-group prop (table))) (def (putprop symbol key val) «Associate a property with the symbol, return the value.» :doc-example «(def x '(1 2 3)) (putprop x 'words "one two three") ; ↳ "one two three" (getprop x 'words) ; ↳ "one two three"» :doc-group prop :doc-see getprop :doc-see remprop (let ((kt (get *properties* key NIL))) (unless kt (let ((ta (table))) (put! *properties* key ta) (set! kt ta))) (put! kt symbol val) val)) (def (getprop symbol key (def NIL def-supplied?)) «Return a property value associated with the symbol or `def` if missing. If the default value is not supplied and the property is missing, exception `key-error` will be thrown.» :doc-example «(def x '(1 2 3)) (putprop x 'words "one two three") ; ↳ "one two three" (getprop x 'words) ; ↳ "one two three" (getprop x 'huh) ; ‼ key not found: huh (getprop x 'huh "fallback") ; ↳ "fallback"» :doc-group prop :doc-see putprop :doc-see remprop (let ((kt (get *properties* key NIL))) (if def-supplied? (or (and kt (get kt symbol def)) def) (if (and kt (has? kt symbol)) (get kt symbol) (raise (list 'key-error key)))))) (def (remprop symbol key) «Remove a property associated with the symbol. Returns `T` if the property was removed, `NIL` if there was no such association defined for the symbol.» :doc-example «(def x '(1 2 3)) (putprop x 'words "one two three") ; ↳ "one two three" (remprop x 'unknown) ; no such association ; ↳ NIL (getprop x 'words NIL) ; ↳ "one two three" (remprop x 'words) ; ↳ T (getprop x 'words NIL) ; ↳ NIL» :doc-group prop :doc-see getprop :doc-see putprop (let ((kt (get *properties* key NIL))) (and kt (has? kt symbol) (del! kt symbol) T))) ;;; documentation (def (separate-doc-from-body body (doc NIL)) «Take a list of terms and return a pair `(doc . body)`, where the first element contains a list of documentation-related terms, and the second contains the rest of the terms.» :doc-group doc (def (doc? kw) (<= :doc-a kw :doc-z)) (def (maybe-lambda t) (if (and (cons? t) (eq? (car t) 'λ) (cons? (cadr t))) (compile t) t)) (let {[hd (car body)] [tl (cdr body)]} (cond [(and (str? hd) (not doc) tl) (separate-doc-from-body tl (cons hd doc))] [(and doc (doc? hd)) (separate-doc-from-body (cdr tl) (cons (cons hd (maybe-lambda (car tl))) doc))] [else (cons (reverse doc) body)]))) (def (set-doc! symbol doc-seq . formals-list) «Set the documentation for the symbol.» :doc-group doc (def (formals-clean fs) (when (atom? fs) (return fs)) (let ((f (car fs))) (cons (if (and (cons? f) (length> f 2)) (subseq f 0 2) f) (formals-clean (cdr fs))))) (def (trim-indent s) (unless (and (bound? 'str-trim) (bound? 'str-join)) (return s)) (let* {[lines (str-split s "\n")] [hd (car lines)] [tl (cdr lines)] [indent (and tl (apply min (map (λ (s) (and (> (length s) 0) (- (length s) (length (str-trim s))))) tl)))] [trimmed (and tl (map (λ (s) (if (<= indent (length s)) (str-sub s indent) s)) tl))]} (str-join (cons hd trimmed) "\n"))) (def (extra-clean e) (unless (and (cons? e) (str? (cdr e))) (return e)) (set-cdr! e (trim-indent (cdr e)))) (let* {[doc-only (str? doc-seq)] [doc (if doc-only doc-seq (car doc-seq))] [extra (if doc-only NIL (map extra-clean (cdr doc-seq)))] [formals-list (map formals-clean formals-list)]} (when doc (putprop symbol '*doc* (trim-indent doc)) (when extra (putprop symbol '*doc-extra* extra))) (when (cons? formals-list) (putprop symbol '*formals-list* (remove-duplicates [append (getprop symbol '*formals-list* NIL) formals-list]))) #.(void))) (def (help-print-header term sigs (:kind NIL) (:lpad "")) «Format and print signatures of the term for `(help term)` output.» :doc-group doc (def (print-type e) (set! print-type void) (princ " ;; [" [cond ((not (sym? e)) (type-of e)) ((and (sym? e) (bound? e)) (type-of (top-level-value term))) ((get-syntax e) "macro") (else "any")] "]")) (def (term->str term) (with-output (b) (with-bindings ((*print-readably* T) (*print-pretty* NIL)) (write term b)))) (if sigs (for-each (λ (sig) (let* {[sug (term->str (cons term sig))] [b (buffer)] [sig (with-bindings ((*print-syntax-sugar* NIL)) (term->str (cons term sig)))]} (princ lpad) (princ sug) (unless (equal? sug sig) (princ " | " sig)) (print-type term) (newline))) sigs) (princ lpad) (if kind (princ (caddr term) " ;; [doc group]") (print term) (print-type term)) (newline)) (newline)) (defmacro (help (topic NIL topic-supplied) (:print-header help-print-header) . rest) «Display documentation for a specific term or group of terms, if available. An optional symbol `group` is used to query for documentation on a group instead of a single term. All available documentation groups can be displayed with `(help groups)`. Asterisk can be added to the beginning and/or end of the term in order to list the matching terms defined in the current environment. This can be useful to recall a function's name. Rune `↳` followed by an object appearing in the documentation describes the returned value. Rune `‼` follows by what is being written to the output or by an error raised.» :doc-example «(help str?) ; show documentation for str? (help groups) ; show documentation groups (help type group) ; list items for dealing with types (help group type) ; same as above (help str->*) ; find functions converting from strings (help *->str) ; find functions converting to strings (help *num*) ; find anything related to numbers» :doc-group doc (let* {[topic (if topic-supplied topic 'help)] [term (if (eq? topic 'group) (car rest) topic)] [kind (if (eq? topic term) (car rest) topic)] [doc-extra-term (and kind (cons (sym ":doc-" kind) term))] [docterm (if kind (list 'doc kind term) term)] [doc (getprop docterm '*doc* NIL)] [formals-list (getprop docterm '*formals-list* NIL)] [term-bound (and (sym? term) (or (bound? term) (get-syntax term)))] [buf-mode (io-buffer-mode *io-out*)]} (io-buffer-mode! *io-out* :block) (def (deunicode str) (if (member +os-name+ '("dos" "macos" "unknown")) (str-map (λ (r) (case r (#\↳ "->") (#\… "...") (#\‼ "!!") (#\λ "lambda") (#\₀ #\0) (#\₁ #\1) (#\ₙ #\n) (#\ᵢ #\i) (else r))) str) str)) (def (environment-find-matching) (let* {[s (str term)] [ts (eq? 0 (str-find s "*"))] ; starts with [s (or (and ts (str-sub s 1)) s)] [ei (1- (length s))] [te (eq? (str-find s "*") ei)] ; ends with [s (or (and te (str-sub s 0 ei)) s)] [slen (length s)] [matches? (λ (term) (let* {[name (str term)] [i (str-find name s)] [nlen (and i (length name))]} (and i (or ts (= 0 i)) (or te (= nlen (+ i slen))))))] [matching (nconc (filter matches? (environment)) (filter matches? (table-keys *syntax-environment*)))]} (when matching (for-each (λ (term) (princ term) (newline)) (sort matching <))))) (def (print-sig term sigs lpad) (with-bindings ((*print-syntax-sugar* NIL) (*print-pretty* NIL)) (if sigs (for-each (λ (sig) (newline) (princ lpad) (print (cons term sig))) sigs) (newline) (princ lpad) (print term)))) (def (princ-indent s lpad) (for-each (λ (line) (princ lpad line) (newline)) (str-split s "\n"))) (def (first-line s) (str-sub s 0 (str-find s "\n"))) (def (doc-group? k) (and (cons? k) (eq? (car k) 'doc) (eq? (cadr k) 'group))) (def (doc-extra-term? k) (and (atom? k) (member doc-extra-term (getprop k '*doc-extra* NIL)))) (def (table-keys-filter-sort tbl pred) (sort (table-fold (λ (k _ z) (if (pred k) (cons k z) z)) NIL tbl) <)) (if (eq? term 'groups) (for-each (λ (k) (princ " " (str-pad (str (caddr k)) 10 :align :left) (first-line (getprop k '*doc* NIL))) (newline)) (table-keys-filter-sort (get *properties* '*doc*) doc-group?)) (if (or doc formals-list) (let* {[extra (getprop docterm '*doc-extra* NIL)] [fmt (filter (λ (v) (eq? (car v) :doc-fmt)) extra)] [see (filter (λ (v) (eq? (car v) :doc-see)) extra)] [grp (filter (λ (v) (eq? (car v) :doc-group)) extra)] [exa (filter (λ (v) (eq? (car v) :doc-example)) extra)]} (and print-header (print-header docterm formals-list :kind kind)) (when doc (princ (deunicode (foldl (λ (fmt doc) ((cdr fmt) doc)) doc fmt))) (newline)) (when exa (newline) (princ "Examples:") (newline) (for-each (λ (e) (newline) (princ-indent (deunicode (cdr e)) " ")) exa)) (when see (newline) (princ "See also:") (newline) (for-each (λ (v) (print-sig (cdr v) (getprop (cdr v) '*formals-list* NIL) " ")) see) (newline)) (when grp (newline) (princ "Groups:") (newline) (for-each (λ (g) (newline) (princ " (help group " (cdr g) ")")) grp) (newline)) (when kind (newline) (princ "Members:") (newline) (for-each (λ (k) (print-sig k (getprop k '*formals-list* NIL) " ")) (table-keys-filter-sort (get *properties* '*doc*) doc-extra-term?)) (newline)) #.(void)) (unless (and (not term-bound) (environment-find-matching)) (princ "no help for " (if kind (str kind " ") "") term) (when (and (not kind) (sym? term) (not term-bound)) (princ " (undefined)")) (newline)))) (io-buffer-mode! *io-out* buf-mode) (io-flush *io-out*) (void))) ;; chicken & egg problem - need doc logic to define a doc group (doc-group prop «Dealing with properties of symbols.») ;;; standard procedures (def (member item lst) «Return the tail of a list beginning with the item, or `NIL` otherwise. List elements are compared to the `item` using `equal?`.» :doc-example «(member 1 '(3 2 1 0)) ; ↳ (1 0)» :doc-example «(member 1 '(2 3)) ; ↳ NIL» :doc-group list :doc-see memq :doc-see memv (cond ((equal? (car lst) item) lst) (lst (member item (cdr lst))))) (def (memv item lst) «Return the tail of a list beginning with the item, or `NIL` otherwise. List elements are compared to the `item` using `eqv?`.» :doc-group list :doc-see member :doc-see memq (cond ((eqv? (car lst) item) lst) (lst (memv item (cdr lst))))) (def (assoc-list . kvs) «Construct an association list from the arguments. Every two arguments are expected to be a key and a value associated with that key.» :doc-example «(assoc-list 'a 0 'b 1) ; ↳ ((a . 0) (b . 1))» :doc-group list :doc-see assoc (let ((s (cdr kvs))) (when (cons? s) (cons (cons (car kvs) (car s)) (apply assoc-list (cdr s)))))) (def (assoc key lst) «Return a pair of a matching key and the associated value, or `NIL` if none matched. Keys are compared using `equal?`.» :doc-example «(def L (assoc-list 'a 0 'b 1)) (assoc 'b L) ; ↳ (b . 1) (assoc 'c L) ; ↳ NIL» :doc-group list :doc-see assoc-list :doc-see assq :doc-see assv (cond ((equal? (caar lst) key) (car lst)) (lst (assoc key (cdr lst))))) (def (assv key lst) «Return a pair of a matching key and the associated value, or `NIL` if none matched. Keys are compared using `eqv?`.» :doc-group list :doc-see assoc :doc-see assq (cond ((eqv? (caar lst) key) (car lst)) (lst (assv key (cdr lst))))) (doc-group compare «Comparison operators.») (def (> v . rest) «Return `T` if the arguments are in strictly decreasing order (previous one is greater than the next one).» :doc-group compare (let loop ((v v) (rest rest)) (or (not rest) (and (< (car rest) v) (loop (car rest) (cdr rest)))))) (defmacro (> v . rest) `(< ,.(reverse rest) ,v)) (def (<= v . rest) «Return `T` if the arguments are in non-decreasing order (previous one is less than or equal to the next one).» :doc-group compare (let loop ((v v) (rest rest)) (or (not rest) (unless (or (< (car rest) v) (nan? v)) (loop (car rest) (cdr rest)))))) (def (>= v . rest) «Return `T` if the arguments are in non-increasing order (previous one is greater than or equal to the next one).» :doc-group compare (let loop ((v v) (rest rest)) (or (not rest) (unless (or (< v (car rest)) (nan? v)) (loop (car rest) (cdr rest)))))) (def (negative? n) «Return `T` if `n` is a negative number. Shorthand for `(< n 0)`.» :doc-group number :doc-group compare (< n 0))