Add c-stdio library
This commit is contained in:
parent
9e49f417b5
commit
a2ac0c10b2
|
|
@ -0,0 +1,22 @@
|
||||||
|
(define-c-library libc '("stdio.h") #f '())
|
||||||
|
(define-c-procedure fopen libc 'fopen 'pointer '(pointer pointer))
|
||||||
|
(define-c-procedure fclose libc 'fclose 'int '(pointer))
|
||||||
|
(define-c-procedure feof 'feof 'int '(pointer))
|
||||||
|
(define-c-procedure ferror 'ferror 'int '(pointer))
|
||||||
|
(define-c-procedure fgetc 'fgetc 'int '(pointer))
|
||||||
|
(define-c-procedure fgetcs 'fgetcs 'pointer '(pointer int pointer))
|
||||||
|
(define-c-procedure fputc 'fputc 'int '(int pointer))
|
||||||
|
(define-c-procedure fputs 'fputs 'int '(pointer pointer))
|
||||||
|
(define-c-procedure fread 'fread 'int '(pointer int int pointer))
|
||||||
|
(define-c-procedure fseek 'fseek 'int '(pointer long int))
|
||||||
|
(define-c-procedure ftell 'ftell 'long '(pointer))
|
||||||
|
(define-c-procedure fwrite 'fwrite 'int '(pointer int int pointer))
|
||||||
|
(define-c-procedure getc 'fwrite 'int '(pointer))
|
||||||
|
(define-c-procedure getchar 'getchar 'int '())
|
||||||
|
(define-c-procedure putc 'putc 'int '(int pointer))
|
||||||
|
(define-c-procedure putchar 'putchar 'int '(int))
|
||||||
|
(define-c-procedure puts 'puts 'int '(pointer))
|
||||||
|
(define-c-procedure remove 'remove 'int '(pointer))
|
||||||
|
(define-c-procedure rename 'rename 'int '(pointer pointer))
|
||||||
|
(define-c-procedure rewind 'rewind 'int '(pointer))
|
||||||
|
|
||||||
|
|
@ -0,0 +1,35 @@
|
||||||
|
(define-library
|
||||||
|
(retropikzel c-stdio)
|
||||||
|
(import (scheme base)
|
||||||
|
(scheme write)
|
||||||
|
(foreign c))
|
||||||
|
(export fopen
|
||||||
|
fclose
|
||||||
|
feof
|
||||||
|
ferror
|
||||||
|
fgetc
|
||||||
|
fgets
|
||||||
|
;fprintf ;; TODO
|
||||||
|
fputc
|
||||||
|
fputs
|
||||||
|
fread
|
||||||
|
;fscanf ;; TODO
|
||||||
|
fseek
|
||||||
|
ftell
|
||||||
|
fwrite
|
||||||
|
getc
|
||||||
|
getchar
|
||||||
|
;printf ;; TODO
|
||||||
|
putc
|
||||||
|
putchar
|
||||||
|
puts
|
||||||
|
remove
|
||||||
|
rename
|
||||||
|
rewind
|
||||||
|
;scanf ;; TODO
|
||||||
|
;snprintf ;; TODO
|
||||||
|
;sprintf ;; TODO
|
||||||
|
;sscanf ;; TODO
|
||||||
|
)
|
||||||
|
(include "c-stdio.scm"))
|
||||||
|
|
||||||
|
|
@ -0,0 +1,18 @@
|
||||||
|
stdio.h bindings
|
||||||
|
|
||||||
|
|
||||||
|
Does not have:
|
||||||
|
- fprintf
|
||||||
|
- (foreign c) has no way to pass variable number of arguments
|
||||||
|
- fscanf
|
||||||
|
- (foreign c) has no way to pass variable number of arguments
|
||||||
|
- printf
|
||||||
|
- (foreign c) has no way to pass variable number of arguments
|
||||||
|
- scanf
|
||||||
|
- (foreign c) has no way to pass variable number of arguments
|
||||||
|
- snprintf
|
||||||
|
- (foreign c) has no way to pass variable number of arguments
|
||||||
|
- sprintf
|
||||||
|
- (foreign c) has no way to pass variable number of arguments
|
||||||
|
- sscanf
|
||||||
|
- (foreign c) has no way to pass variable number of arguments
|
||||||
|
|
@ -0,0 +1,3 @@
|
||||||
|
|
||||||
|
(test-begin "c-stdio")
|
||||||
|
(test-end "c-stdio")
|
||||||
|
|
@ -1,29 +0,0 @@
|
||||||
(define-c-library libc '("stdio.h") libc-name '((additional-versions ("0" "6"))))
|
|
||||||
(define-c-procedure internal-fopen libc 'fopen 'pointer '(pointer poiner))
|
|
||||||
(define-c-procedure internal-fclose libc 'fclose 'int '(pointer))
|
|
||||||
|
|
||||||
(define-record-type <stdio-file>
|
|
||||||
(make-stdio-file file)
|
|
||||||
stdio-file?
|
|
||||||
(file stdio-file))
|
|
||||||
|
|
||||||
(define modes `("r" "w" "a" "r+" "w+" "a+" "rb" "wb" "ab" "rb+" "wb+" "ab+"))
|
|
||||||
|
|
||||||
(define (fopen filename mode)
|
|
||||||
(when (not (string? filename)) (error "fopen: Filename must be string"))
|
|
||||||
(when (not (string? mode)) (error "fopen: Mode must be string"))
|
|
||||||
(when (not (member mode modes))
|
|
||||||
(error (string-append "fopen: Mode not in allowed modes of "
|
|
||||||
(apply (lambda (item) (string-append mode " "))
|
|
||||||
modes))))
|
|
||||||
(let* ((filename-pointer (string->c-utf8 filename))
|
|
||||||
(mode-pointer (string->c-utf8 mode))
|
|
||||||
(file (make-stdio-file (fopen filename mode))))
|
|
||||||
(c-free filename-pointer)
|
|
||||||
(c-free mode-pointer)
|
|
||||||
file))
|
|
||||||
|
|
||||||
(define (fclose file)
|
|
||||||
(when (not (stdio-file? file)) (error "fclose: File must be stdio-file"))
|
|
||||||
(internal-fclose (stdio-file file)))
|
|
||||||
|
|
||||||
|
|
@ -1,35 +0,0 @@
|
||||||
(define-library
|
|
||||||
(retropikzel stdio)
|
|
||||||
(import (scheme base)
|
|
||||||
(scheme write)
|
|
||||||
(foreign c))
|
|
||||||
(export fopen
|
|
||||||
fclose
|
|
||||||
;feof
|
|
||||||
;ferror
|
|
||||||
;fgetc
|
|
||||||
;fgets
|
|
||||||
;fprintf
|
|
||||||
;fputc
|
|
||||||
;fputs
|
|
||||||
;fread
|
|
||||||
;fscanf
|
|
||||||
;fseek
|
|
||||||
;ftell
|
|
||||||
;fwrite
|
|
||||||
;getc
|
|
||||||
;getchar
|
|
||||||
;printf
|
|
||||||
;putc
|
|
||||||
;putchar
|
|
||||||
;puts
|
|
||||||
;remove
|
|
||||||
;rename
|
|
||||||
;rewind
|
|
||||||
;scanf
|
|
||||||
;snprintf
|
|
||||||
;sprintf
|
|
||||||
;sscanf
|
|
||||||
)
|
|
||||||
(include "stiod.scm"))
|
|
||||||
|
|
||||||
|
|
@ -1,3 +0,0 @@
|
||||||
|
|
||||||
(test-begin "stdio")
|
|
||||||
(test-end "stdio")
|
|
||||||
Loading…
Reference in New Issue