;;;; semantic-version-internals.scm -*- Scheme -*- ;FIXME semantic-version API is (unsafe unchecked inline) so cannot use #!optional (define-inline (->boolean x) (and x #t)) ;;record-variants (import (only record-variants define-record-type-variant)) ;; semantic-version type (define-record-type-variant semantic-version (unsafe unchecked inline) (make-ver cs ps) ver? (cs ver-parts ver-parts-set!) (ps ver-puncs ver-puncs-set!)) (define-inline (vertyp? x) (and (ver? x) (list? (ver-parts x)) (list? (ver-puncs x))) ) (define-inline (copy-ver-parts ver) (list-copy (ver-parts ver))) (define-inline (copy-ver-puncs ver) (list-copy (ver-puncs ver))) (define-inline (copy-ver v) (make-ver (copy-ver-parts ver) (copy-ver-puncs ver)) ) ;NOTE symbols are not preserved; the printname is used! (define-inline (ver-part? x) (or (number? x) (string? x) (symbol? x))) (define-inline (ver-punc? x) (char? x)) (define-inline (ver-parts? l) (and (list? l) (every ver-part? l))) (define-inline (ver-puncs? l) (and (list? l) (every ver-punc? l))) (define-inline (ver-depth ver) (length (ver-parts ver))) ;; All so we don't have an egg dependency on check-errors! (define-inline (badargmsg msg #!optional nam) (string-append (or (and nam (->string nam)) "bad argument") " - " msg) ) (define-inline (badargerr loc obj msg #!optional nam) (error loc (badargmsg msg nam) obj) ) (define-inline (check-fixnum loc x) (##sys#check-fixnum x loc) x) (define-inline (check-number loc x) (##sys#check-number x loc) x) (define-inline (check-string loc x) (##sys#check-string x loc) x) (define-inline (check-procedure loc x) (##sys#check-procedure x loc) x) (define-inline (check-fixnum-in-range loc x from to) (##sys#check-range x from to loc) x) (define-inline (check-fixnum-range loc x from to) (check-fixnum-in-range loc (check-fixnum loc x) from to) ) ; (define-inline (check-part loc x #!optional nam) (unless (ver-part? x) (badargerr loc x "invalid semantic-version part" nam)) x ) (define-inline (check-parts loc x #!optional nam) (unless (ver-parts? x) (badargerr loc x "invalid semantic-version parts" nam)) x ) (define-inline (check-punc loc x #!optional nam) (unless (ver-punc? x) (badargerr loc x "invalid semantic-version punc" nam)) x ) (define-inline (check-puncs loc x #!optional nam) (unless (ver-puncs? x) (badargerr loc x "invalid semantic-version puncs" nam)) x ) ;; (define-inline (default-punctuation) (string-ref (version-punctuation) 0)) (define-inline (default-puncs parts) (make-list (sub1 (length parts)) (default-punctuation)) )