#lang scheme

(require "c-compile.ss")
(require dynext/file)

(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-safe-name 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 (format "~a~a" (get-abi) type))))))

(define (get-source-file name)
  (let ([location (build-path (find-system-path 'pref-dir) "sizeof")])
    (when (not (directory-exists? location)) (make-directory location))
    (build-path location (append-c-suffix name))))
  
; first we check the cache for the type. If that doesn't exist, we try to load
; the appropriate function for that type. If that fails, then we create the source
; and file location of the type size finding function. If the source file doesn't
; exist we put the source into it. If the location hasn't been compiled and linked
; to a .so, we compile and link it. We load the linked library, and finally
; we try to load the appropriate function for that type.

(define (sizeof type . includes)
  (display (format "calculating size of ~s~n" type))
  (hash-ref 
   size-cache type
   (λ ()
     (let* ([name (get-safe-name type)]
            [function (format "get_sizeof_~a" name)])
       ((λ (compile-it)
          (let ([size
                 (with-handlers
                     [(exn:fail? compile-it)]
                   ((get-ffi-obj (ffi-lib #f) function (_fun -> _uint))))])
            (set! size-cache (hash-set size-cache type size))
            size))
        (λ (e)
          (let
              ([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))]
               [location (get-source-file name)])
            (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))])
                 (obj)))))))))))
        

(define (pick-an-integer size [signed? #f])
  (case size
    [(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" size)]))

(provide/contract
 [sizeof (->* (string?) () #:rest (listof string?) integer?)]
 [pick-an-integer (->* (integer?) (boolean?) ctype?)])