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

;;FIXME 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) )

;FIXME use badargerr so can have descriptive argument name

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