;;;; 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) (every ver-part? l))
(define-inline (ver-puncs? l) (every ver-punc? l))

(define-inline (ver-depth ver) (length (ver-parts ver)))

;;

(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) )

;FIXME use badargerr so can have descriptive argument name

(define-inline (check-fixnum loc obj #!optional nam) (##sys#check-fixnum obj loc) obj)
(define-inline (check-number loc obj #!optional nam) (##sys#check-number obj loc) obj)
(define-inline (check-string loc obj #!optional nam) (##sys#check-string obj loc) obj)
(define-inline (check-procedure loc obj #!optional nam) (##sys#check-procedure obj loc) obj)

(define-inline (check-range loc i from to #!optional nam)
  (##sys#check-range i from to loc)
  i )

(define-inline (check-parts loc x #!optional nam)
  (unless (ver-parts? x) (badargerr loc x "invalid semantic-version parts" 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)) )