### ----------------------------------------------------
### -- Format::Lisp
### -- Licenses: Artistic-2.0
### -- Authors: Jeffrey Goff
### -- File: t/lib/Utils.rakumod
### ----------------------------------------------------
use Format::Lisp;

sub formatter-call-to-string( $formatter, **@arguments ) is export {
	return $formatter( @arguments );
}

sub deftest( &block, $result ) is export {
	&block() eqv $result
}

sub def-format-test( $format, $arg-ref, $result, $xxx-dunno? ) is export {
	$*fl.format( $format, |@( $arg-ref ) ) eqv $result;
}

our $CHAR-CODE-LIMIT is export = 0x10000;
our @standard-chars is export =
	'a'..'z',
	'A'..'Z',
	'0'..'9',
	split( '', Q{~!@#$%^&*()_+|\\=-`{}[]:\";'<>?,./} ),
	"\n"
;

our @english-number-names is export = <
	zero         one         two           three         four
	five         six         seven         eight         nine
	ten          eleven      twelve        thirteen      fourteen
	fifteen      sixteen     seventeen     eighteen      nineteen
	twenty       twenty-one  twenty-two    twenty-three  twenty-four
	twenty-five  twenty-six  twenty-seven  twenty-eight  twenty-nine
	thirty       thirty-one  thirty-two    thirty-three  thirty-four
	thirty-five  thirty-six  thirty-seven  thirty-eight  thirty-nine
	forty        forty-one   forty-two     forty-three   forty-four
	forty-five   forty-six   forty-seven   forty-eight   forty-nine
	fifty        fifty-one   fifty-two     fifty-three   fifty-four
	fifty-five   fifty-six   fifty-seven   fifty-eight   fifty-nine
	sixty        sixty-one   sixty-two     sixty-three   sixty-four
	sixty-five   sixty-six   sixty-seven   sixty-eight   sixty-nine
	seventy      seventy-one seventy-two   seventy-three seventy-four
	seventy-five seventy-six seventy-seven seventy-eight seventy-nine
	eighty       eighty-one  eighty-two    eighty-three  eighty-four
	eighty-five  eighty-six  eighty-seven  eighty-eight  eighty-nine
	ninety       ninety-one  ninety-two    ninety-three  ninety-four
	ninety-five  ninety-six  ninety-seven  ninety-eight  ninety-nine
>;
@english-number-names.append( 'one hundred' );

our @english-ordinal-names is export = <
	zeroth        first         second          third          fourth
	fifth         sixth         seventh         eighth         ninth
	tenth         eleventh      twelfth         thirteenth     fourteenth
	fifteenth     sixteenth     seventeenth     eighteenth     nineteenth
	twentieth     twenty-first  twenty-second   twenty-third   twenty-fourth
	twenty-fifth twenty-sixth   twenty-seventh  twenty-eighth  twenty-ninth
	thirtieth     thirty-first  thirty-second   thirty-third   thirty-fourth
	thirty-fifth thirty-sixth   thirty-seventh  thirty-eighth  thirty-ninth
	fortieth      forty-first   forty-second    forty-third    forty-fourth
	forty-fifth   forty-sixth   forty-seventh   forty-eighth   forty-ninth
	fiftieth      fifty-first   fifty-second    fifty-third    fifty-fourth
	fifty-fifth   fifty-sixth   fifty-seventh   fifty-eighth   fifty-ninth
	sixtieth      sixty-first   sixty-second    sixty-third    sixty-fourth
	sixty-fifth   sixty-sixth   sixty-seventh   sixty-eighth   sixty-ninth
	seventieth    seventy-first seventy-second  seventy-third  seventy-fourth
	seventy-fifth seventy-sixth seventy-seventh seventy-eighth seventy-ninth
	eightieth     eighty-first  eighty-second   eighty-third   eighty-fourth
	eighty-fifth  eighty-sixth  eighty-seventh  eighty-eighth  eighty-ninth
	ninetieth     ninety-first  ninety-second   ninety-third   ninety-fourth
	ninety-fifth  ninety-sixth  ninety-seventh  ninety-eighth  ninety-ninth
>;
@english-ordinal-names.append( 'one hundredth' );

###;-*- Mode:     Lisp -*-
###;;;; Author:   Paul Dietz
###;;;; Created:  Thu Apr  9 19:32:56 1998
###;;;; Contains: A global variable containing a list of
###;;;;           as many kinds of CL objects as we can think of
###;;;;           This list is used to test many other CL functions

###(defparameter *condition-types*
###    '(arithmetic-error
###      cell-error
###      condition
###      control-error
###      division-by-zero
###      end-of-file
###      error
###      file-error
###      floating-point-inexact
###      floating-point-invalid-operation
###      floating-point-underflow
###      floating-point-overflow
###      package-error
###      parse-error
###      print-not-readable
###      program-error
###      reader-error
###      serious-condition
###      simple-condition
###      simple-error
###      simple-type-error
###      simple-warning
###      storage-condition
###      stream-error
###      style-warning
###      type-error
###      unbound-slot
###      unbound-variable
###      undefined-function
###      warning))

###(defparameter *condition-objects*
###  (locally (declare (optimize safety))
###           (loop for tp in *condition-types* append
###                 (handler-case (list (make-condition tp))
###                               (error () nil)))))

our @standard-package-names = <
	COMMON-LISP
	COMMON-LISP-USER
	KEYWORD
>;

###(defparameter *package-objects*
###  (locally (declare (optimize safety))
###           (loop for pname in *standard-package-names* append
###                 (handler-case (let ((pkg (find-package pname)))
###                                 (and pkg (list pkg)))
###                               (error () nil)))))

our constant MOST-POSITIVE-FIXNUM = 1000; # XXX
our constant MOST-NEGATIVE-FIXNUM = -1000; # XXX

our @integers = 
	0,
	# Integers near fixnum/bignum boundaries
	{ map { $_ + MOST-POSITIVE-FIXNUM }, -5..5 },
	{ map { $_ + MOST-NEGATIVE-FIXNUM }, -5..5 },
	# Powers of two, negatives and off by one
	{ map { 2 ** $_ }, 1..64 },
	{ map { ( 2 ** $_ ) - 1 }, 1..64 },
	{ map { 2 ** -$_ }, 1..64 },
	{ map { ( 2 ** -$_ ) - 1 }, 1..64 },
	# A big integer
	17 ** 50,
	# Some arbitrarily chosen integers
	12387131, 1272314, 231, -131, -561823,
	23713, -1234611312123, 444121, 991
;

###(defparameter *floats*
###    (append
###     (loop for sym in '(pi
###                        most-positive-short-float
###                        least-positive-short-float
###                        least-positive-normalized-short-float
###                        most-positive-double-float
###                        least-positive-double-float
###                        least-positive-normalized-double-float
###                        most-positive-long-float
###                        least-positive-long-float
###                        least-positive-normalized-long-float
###                        most-positive-single-float
###                        least-positive-single-float
###                        least-positive-normalized-single-float
###                        most-negative-short-float
###                        least-negative-short-float
###                        least-negative-normalized-short-float
###                        most-negative-single-float
###                        least-negative-single-float
###                        least-negative-normalized-single-float
###                        most-negative-double-float
###                        least-negative-double-float
###                        least-negative-normalized-double-float
###                        most-negative-long-float
###                        least-negative-long-float
###                        least-negative-normalized-long-float
###                        short-float-epsilon
###                        short-float-negative-epsilon
###                        single-float-epsilon
###                        single-float-negative-epsilon
###                        double-float-epsilon
###                        double-float-negative-epsilon
###                        long-float-epsilon
###                        long-float-negative-epsilon)
###           when (boundp sym) collect (symbol-value sym))
###     (list
###      0.0 1.0 -1.0 313123.13 283143.231 -314781.9
###      1.31283d2 834.13812D-45
###      8131238.1E14 -4618926.231e-2
###      -37818.131F3 81.318231f-19
###      1.31273s3 12361.12S-7
###      6124.124l0 13123.1L-23)))

our @ratios =
	1/3,
	1/1000,
	1/1000000000000000,
	-10/3,
	-1000/7,
	-987129387912381/13612986912361,
	189729874978126783786123/1234678123487612347896123467851234671234
;

our @complexes =
	0.0+0.0i,
	1.0+0.0i,
	0.0+1.0i,
	1.0+1.0i,
	-1.0-1.0i,
	1289713.12312-9.12681271i,
	1.0e100+1.0e100i,
	-1.0e-100-1.0e-100i,
	10.0e0+20.0e0i,
	100.0e0+200.0e0i,
	1.0e0+2.0e0i,
	1.0e0+3.0e0i,
	1.0e0+4.0e0i,
	1.0e0+5.0e0i,
	1.0e0+6.0e0i,
	1.0e0+7.0e0i,
	1.0e0+2.0e0i,
	1.0e0+3.0e0i,
	1.0e0+4.0e0i,
	1.0e0+5.0e0i,
	1.0e0+6.0e0i,
	1.0e0+7.0e0i,
	1/2+(1/3)*i,
;

# our @numbers =
#	@integers,
#	@floats,
#	@ratios,
#	@complexes
# ;

# out @reals =
#	@integers,
#	@floats,
#	@ratios
# ;

# our @rationals =
#	@integers,
#	@ratios
# ;

###(defun try-to-read-chars (&rest namelist)
###  (declare (optimize safety))
###  (loop
###    for name in namelist append
###        (handler-case
###            (list (read-from-string
###                   (concatenate 'string "\#\\" name)))
###          (error () nil))))

###(defparameter *characters*
###    (remove-duplicates
###     `(#\Newline
###       #\Space
###       ,@(try-to-read-chars "Rubout"
###                            "Page"
###                            "Tab"
###                            "Backspace"
###                            "Return"
###                            "Linefeed"
###                            "Null")
###       #\a #\A #\0 #\9 #\. #\( #\) #\[ #\]
###       )))

###(defparameter *strings*
###    (append
###     (and (code-char 0)
###          (list
###           (make-string 1 :initial-element (code-char 0))
###           (make-string 10 :initial-element (code-char 0))))
###     (list
###      "" "A" "a" "0" "abcdef"
###      "~!@#$%^&*()_+`1234567890-=<,>.?/:;\"'{[}]|\\ abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWYXZ"
###      (make-string 100000 :initial-element #\g)
###      (let ((s (make-string 256)))
###        (loop
###            for i from 0 to 255
###            do (let ((c (code-char i)))
###                 (when c
###                   (setf (elt s i) c))))
###        s)
###      ;; Specialized strings
###      (make-array 3
###                  :element-type 'character
###                  :displaced-to (make-array 5 :element-type 'character
###                                            :initial-contents "abcde")
###                  :displaced-index-offset 1)
###      (make-array 10 :initial-element #\x
###                  :fill-pointer 5
###                  :element-type 'character)
###      (make-array 10 :initial-element #\x
###                  :element-type 'base-char)
###      (make-array 3 :initial-element #\y
###                  :adjustable t
###                  :element-type 'base-char)
###      )))

###(defparameter *conses*
###    (list
###     (list 'a 'b)
###     (list nil)
###     (list 1 2 3 4 5 6)))

###(defparameter *circular-conses*
###    (list
###     (let ((s (copy-list '(a b c d))))
###       (nconc s s)
###       s)
###     (let ((s (list nil)))
###       (setf (car s) s)
###       s)
###     (let ((s (list nil)))
###       (setf (car s) s)
###       (setf (cdr s) s))))

###(defparameter *booleans* '(nil t))

###(defparameter *keywords* '(:a :b :|| :|a| :|1234|))

###(defparameter *uninterned-symbols*
###  (list '#:nil '#:t '#:foo '#:||))

###(defparameter *cl-test-symbols*
###    `(,(intern "a" :cl-test)
###      ,(intern "" :cl-test)
###      ,@(and (code-char 0)
###             (list (intern (make-string 1 :initial-element (code-char 0)) :cl-test)))
###      ,@(and (code-char 0)
###             (let* ((s (make-string 10 :initial-element (code-char 0)))
###                    (s2 (copy-seq s))
###                    (s3 (copy-seq s)))
###               (setf (subseq s 3 4) "a")
###               (setf (subseq s2 4 5) "a")
###               (setf (subseq s3 4 5) "a")
###               (setf (subseq s3 7 8) "b")
###               (list (intern s :cl-test)
###                     (intern s2 :cl-test)
###                     (intern s3 :cl-test))))
###      ))

###(defparameter *cl-user-symbols*
###  '(cl-user::foo
###    cl-user::x
###    cl-user::cons
###    cl-user::lambda
###    cl-user::*print-readably*
###    cl-user::push))

###(defparameter *symbols*
###    (append *booleans* *keywords* *uninterned-symbols*
###            *cl-test-symbols*
###            *cl-user-symbols*))

###(defparameter *array-dimensions*
###    (loop
###        for i from 0 to 8 collect
###          (loop for j from 1 to i collect 2)))

our @default-array-target = 300;

###(defparameter *arrays*
###    (append
###     (list (make-array '10))
###     (mapcar #'make-array *array-dimensions*)
###
###     ;; typed arrays
###     (loop for tp in '(fixnum float bit character base-char
###                       (signed-byte 8) (unsigned-byte 8))
###           for element in '(18 16.0f0 0 #\x #\y 127 200)
###         append
###           (loop
###               for d in *array-dimensions*
###               collect (make-array d :element-type tp
###                                   :initial-element element)))
###
###     ;; More typed arrays
###     (loop for i from 1 to 64
###           append
###           (list (make-array 10 :element-type `(unsigned-byte ,i)
###                             :initial-element 1)
###                 (make-array 10 :element-type `(signed-byte ,i)
###                             :initial-element 0)))
###
###     ;; adjustable arrays
###     (loop
###       for d in *array-dimensions*
###         collect (make-array d :adjustable t))
###
###     ;; Displaced arrays
###     (loop
###      for d in *array-dimensions*
###      for i from 1
###      collect (make-array d :displaced-to *default-array-target*
###                          :displaced-index-offset i))
###
###     (list
###      #()
###      #*
###      #*00000
###      #*1010101010101101
###      (make-array 10 :element-type 'bit
###                  :initial-contents '(0 1 1 0 1 1 1 1 0 1)
###                  :fill-pointer 8)
###      (make-array 5 :element-type 'bit
###                  :displaced-to #*0111000110
###                  :displaced-index-offset 3)
###      (make-array 10 :element-type 'bit
###                  :initial-contents '(1 1 0 0 1 1 1 0 1 1)
###                  :adjustable t)
###      )
###
###     ;; Integer arrays
###     (list
###      (make-array '(10) :element-type '(integer 0 (256))
###                  :initial-contents '(8 9 10 11 12 1 2 3 4 5))
###      (make-array '(10) :element-type '(integer -128 (128))
###                  :initial-contents '(8 9 -10 11 -12 1 -2 -3 4 5))
###      (make-array '(6) :element-type '(integer 0 (#.(ash 1 16)))
###                  :initial-contents '(5 9 100 1312 23432 87))
###      (make-array '(4) :element-type '(integer 0 (#.(ash 1 28)))
###                  :initial-contents '(100000 231213 8123712 19))
###      (make-array '(4) :element-type '(integer 0 (#.(ash 1 32)))
###                  :initial-contents '(#.(1- (ash 1 32)) 0 872312 10000000))
###
###      (make-array nil :element-type '(integer 0 (256))
###                  :initial-element 14)
###      (make-array '(2 2) :element-type '(integer 0 (256))
###                  :initial-contents '((34 98)(14 119)))
###      )
###
###     ;; Float arrays
###     (list
###      (make-array '(5) :element-type 'short-float
###                  :initial-contents '(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0))
###      (make-array '(5) :element-type 'single-float
###                  :initial-contents '(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0))
###      (make-array '(5) :element-type 'double-float
###                  :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))
###      (make-array '(5) :element-type 'long-float
###                  :initial-contents '(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0))
###      )
###
###     ;; The ever-popular NIL array
###     (locally (declare (optimize safety))
###              (handler-case
###               (list (make-array '(0) :element-type nil))
###               (error () nil)))))

###(defparameter *hash-tables*
###  (list
###   (make-hash-table)
###   (make-hash-table :test #'eq)
###   (make-hash-table :test #'eql)
###   (make-hash-table :test #'equal)
###   (make-hash-table :test #'equalp)
###   ))

###(defparameter *pathnames*
###  (locally
###   (declare (optimize safety))
###   (loop for form in '((make-pathname :name "foo")
###                       (make-pathname :name "FOO" :case :common)
###                       (make-pathname :name "bar")
###                       (make-pathname :name "foo" :type "txt")
###                       (make-pathname :name "bar" :type "txt")
###                       (make-pathname :name "XYZ" :type "TXT" :case :common)
###                       (make-pathname :name nil)
###                       (make-pathname :name :wild)
###                       (make-pathname :name nil :type "txt")
###                       (make-pathname :name :wild :type "txt")
###                       (make-pathname :name :wild :type "TXT" :case :common)
###                       (make-pathname :name :wild :type "abc" :case :common)
###                       (make-pathname :directory :wild)
###                       (make-pathname :type :wild)
###                       (make-pathname :version :wild)
###                       (make-pathname :version :newest))
###         append (ignore-errors (eval `(list ,form))))))

###(eval-when (:compile-toplevel :load-toplevel :execute)
###  (locally
###   (declare (optimize safety))
###   (ignore-errors
###     (setf (logical-pathname-translations "CLTESTROOT")
###           `(("**;*.*.*" ,(make-pathname :directory '(:absolute :wild-inferiors)
###                                         :name :wild :type :wild)))))
###   (ignore-errors
###     (setf (logical-pathname-translations "CLTEST")
###           `(("**;*.*.*" ,(make-pathname
###                           :directory (append
###                                       (pathname-directory
###                                        (truename (make-pathname)))
###                                       '(:wild-inferiors))
###                           :name :wild :type :wild)))))
###   ))

###(defparameter *logical-pathnames*
###  (locally
###   (declare (optimize safety))
###   (append
###    (ignore-errors (list (logical-pathname "CLTESTROOT:")))
###    )))

###(defparameter *streams*
###  (remove-duplicates
###   (remove-if
###    #'null
###    (list
###     *debug-io*
###     *error-output*
###     *query-io*
###     *standard-input*
###     *standard-output*
###     *terminal-io*
###     *trace-output*))))

###(defparameter *readtables*
###  (list *readtable*
###        (copy-readtable)))

class foo-structure { has $.x; has $.y; has $.z; }

class bar-structure { has $.x; has $.y; has $.z; }

our @structures =
	foo-structure.new( :x(1), :y('a'), :z(Nil) ),
	foo-structure.new( :x(1), :y('a'), :z(Nil) ),
	bar-structure.new( :x(1), :y('a'), :z(Nil) )
;

sub meaningless-user-function-for-universe( $x, $y, $z ) {
	$x + 1, $y + 2, $z + 3;
}

###(defgeneric meaningless-user-generic-function-for-universe (x y z)
###  (:method ((x integer) (y integer) (z integer)) (+ x y z)))

###(eval-when (:load-toplevel :execute)
###  (compile 'meaningless-user-function-for-universe)
###  ;; Conditionalize to avoid a cmucl bug
###  (compile 'meaningless-user-generic-function-for-universe)
###  )

###(defparameter *functions*
###  (list #'cons #'car #'append #'values
###        (macro-function 'cond)
###        #'meaningless-user-function-for-universe
###        #'meaningless-user-generic-function-for-universe
###        #'(lambda (x) x)
###        (compile nil '(lambda (x) x))))

###(defparameter *methods*
###  (list
###   (find-method #'meaningless-user-generic-function-for-universe nil
###                (mapcar #'find-class '(integer integer integer)))
###   ;; Add more methods here
###   ))

###(defparameter *random-states*
###  (list (make-random-state)))

###(defparameter *universe*
###  (remove-duplicates
###   (append
###    *symbols*
###    *numbers*
###    *characters*
###    (mapcar #'copy-seq *strings*)
###    *conses*
###    *condition-objects*
###    *package-objects*
###    *arrays*
###    *hash-tables*
###    *pathnames*
###    *logical-pathnames*
###    *streams*
###    *readtables*
###    *structures*
###    *functions*
###    *random-states*
###    *methods*
###    nil)))

###(defparameter *mini-universe*
###  (remove-duplicates
###   (append
###    (mapcar #'first
###            (list *symbols*
###                  *numbers*
###                  *characters*
###                  (list (copy-seq (first *strings*)))
###                  *conses*
###                  *condition-objects*
###                  *package-objects*
###                  *arrays*
###                  *hash-tables*
###                  *pathnames*
###                  *logical-pathnames*
###                  *streams*
###                  *readtables*
###                  *structures*
###                  *functions*
###                  *random-states*
###                  *methods*))
###    '(;;; Others to fill in gaps
###      1.2s0 1.3f0 1.5d0 1.8l0 3/5 10000000000000000000000))))

###(defparameter *classes*
###  (remove-duplicates (mapcar #'class-of *universe*)))

###(defparameter *built-in-classes*
###  (remove-if-not #'(lambda (x) (typep x 'built-in-class))
###                 *classes*))

###(defparameter *symbols*
###    (append (nil t) ;;; booleans
###            (:a :b :|| :|a| :|1234|) ;;; keywords
###            (#:nil #:t #:foo #:||) ;;; uninterned-symbols
###            *cl-test-symbols*
###            *cl-user-symbols*))

our @mini-universe is export =
	False, # *booleans* #'first( False True )
;


