#lang scheme

(require "c-compile.ss")

(require (only-in (planet vyzo/crypto)      sha256)
         (only-in (planet vyzo/crypto/util) hex))

(require scheme/foreign)
(unsafe!)

; this module is bad and I feel bad >:(

(define size-cache (make-immutable-hash null))

(define (get-name-for-file type)
  ; remove characters forbidden in file names.
  ; I should just use a sha2 or something...
  (bytes->string/utf-8 (hex (sha256 (string->bytes/utf-8 type)))))

(define get-name-for-function get-name-for-file)

(define (get-source-file type)
  (let ([location (build-path (find-system-path 'pref-dir) "sizeof")])
    (when (not (directory-exists? location)) (make-directory location))
    (build-path location (string-append (get-name-for-file type) ".c"))))
  
(define (sizeof type . includes)
  (hash-ref 
   size-cache type
   (λ ()
     (let* ([function (format "get_sizeof_~a" (get-name-for-function type))]
            [source 
             (string-append
              (if (null? includes) ""
                  (foldl (λ (include head) 
                           (string-append head (format "#include <~a.h>\n" include))) "" includes))
              (format "unsigned int ~a(void) {\n\treturn sizeof(~a);\n}" function type))])
       (let ([location (get-source-file type)])
         (call-with-exception-handler
          (λ (e) (delete-file location) (display (format "source was:\n~a\n" source)) e)
          (λ ()
            (when (not (file-exists? location))
              (with-output-to-file location
                (λ () (write-bytes (string->bytes/utf-8 source)))))
            (let* ([lib (ffi-lib (compile-and-link location))]
                   [obj (get-ffi-obj function lib (_fun -> _uint))]
                   [size (obj)])
              (set! size-cache (hash-set size-cache type size))
              size))))))))

(define (pick-an-integer type-name [signed? #f] [includes null]) 
  (case (apply sizeof type-name includes)
    [(1) (if signed? _int8 _uint8)]
    [(2) (if signed? _int16 _uint16)]
    [(4) (if signed? _int32 _uint32)]
    [(8) (if signed? _int64 _uint64)]
    [else (error "No integer of size ~s" (sizeof type-name))]))

(provide sizeof pick-an-integer)