mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 13:37:57 +03:00
171 lines
9.9 KiB
Plaintext
171 lines
9.9 KiB
Plaintext
(system-include "carp_io.h")
|
|
|
|
(register-type FILE)
|
|
|
|
(doc IO "is a module for performing I/O operations. Most functions found in this
|
|
module are wrappers around the C standard library.")
|
|
(defmodule IO
|
|
|
|
(doc Raw "wrappers for functions from the C standard library. Consider using a more carpesque function from IO when it exists. For detailed documentation please consult the documentation of your system (e.g. under Linux try man fprint).")
|
|
(defmodule Raw
|
|
(doc stdin "the standard input file (thin wrapper for the C standard library).")
|
|
(register stdin (Ptr FILE) "stdin")
|
|
(doc stdout "the standard output file (thin wrapper for the C standard library).")
|
|
(register stdout (Ptr FILE) "stdout")
|
|
(doc stderr "the standard error file (thin wrapper for the C standard library).")
|
|
(register stderr (Ptr FILE) "stderr")
|
|
(doc get-char "gets a character from stdin (thin wrapper for getchar() from C standard library).")
|
|
(register get-char (Fn [] Int) "getchar")
|
|
(doc fgetc "gets a character from file (thin wrapper for the from C standard library).")
|
|
(register fgetc (Fn [(Ptr FILE)] Int) "fgetc")
|
|
(doc EOF "the End-Of-File character as a literal (thin wrapper for the C standard library)")
|
|
(register EOF Int "EOF")
|
|
(private fopen-)
|
|
(hidden fopen-)
|
|
(register fopen- (Fn [(Ptr CChar) (Ptr CChar)] (Ptr FILE)) "fopen" )
|
|
(doc fopen "opens a file for input/output/appending (thin wrapper for the C standard library). Consider using the function IO.open-file instead.")
|
|
(defn fopen [pathname mode]
|
|
(fopen- (String.cstr pathname) (String.cstr mode)) )
|
|
(doc fclose "closes a file pointer (thin wrapper for the C standard library).")
|
|
(register fclose (Fn [(Ptr FILE)] Int) "fclose")
|
|
(doc fclose! "same as (fclose) but to be used as a side effect.")
|
|
(defn fclose! [file]
|
|
(ignore (fclose file)) )
|
|
(private fwrite-)
|
|
(hidden fwrite-)
|
|
(register fwrite- (Fn [(Ptr CChar) Int Int (Ptr FILE)] Int) "fwrite")
|
|
(doc fwrite "writes a C-string to a file and returns the number of written items (thin wrapper for the C standard library). Consider using [`write-file`](#write-file) instead.")
|
|
(defn fwrite [data item-size items-count file]
|
|
(fwrite- (String.cstr data) item-size items-count file) )
|
|
(doc fwrite! "like fwrite but returns no indicator whether writing to file succeeded. Consider using fwrite instead.")
|
|
(defn fwrite! [data item-size items-count file]
|
|
(ignore (fwrite data item-size items-count file)) )
|
|
(private fread-)
|
|
(hidden fread-)
|
|
(register fread- (Fn [a Int Int (Ptr FILE)] Int) "fread")
|
|
(doc fread "reads from a file into C-String (thin wrapper for fread(cstr, item-size, items-count, file) from C standard library). Consider using [`read-file`](#read-file) or [`unsafe-read-file`](#unsafe-read-file) instead.")
|
|
(defn fread [file-name item-size items-count file]
|
|
(fread- (String.cstr file-name) item-size items-count file) )
|
|
(doc fflush "flushes a file pointer, i.e. commits every write (thin wrapper for the C standard library).")
|
|
(register fflush (Fn [(Ptr FILE)] Int) "fflush")
|
|
(doc fflush! "same as (fflush) but to be used as a side effect.")
|
|
(defn fflush! [file]
|
|
(ignore (fflush file)) )
|
|
(doc rewind "rewinds a file pointer, i.e. puts input and output stream to beginning (thin wrapper for the C standard library). If you want to verify, that this succeeded, use (fseek stream 0, SEEK_SET) instead. ")
|
|
(register rewind (Fn [(Ptr FILE)] ()) "rewind")
|
|
(private unlink-)
|
|
(hidden unlink-)
|
|
(register unlink- (Fn [(Ptr CChar)] Int) "unlink")
|
|
(windows-only
|
|
; override unlink for windows
|
|
(register unlink- (Fn [(Ptr CChar)] Int) "_unlink"))
|
|
(doc unlink "unlinks a file, i.e. deletes it (thin wrapper for POSIX api in <unistd.h>).")
|
|
(defn unlink [file-name]
|
|
(unlink- (String.cstr file-name)) )
|
|
(doc unlink! "same as (unlink) but to be used as a side effect.")
|
|
(defn unlink! [file-name]
|
|
(ignore (unlink file-name)) )
|
|
(doc fseek "sets the position indicator of a file (thin wrapper for fseek(file, offset, whence) from C standard library).")
|
|
(register fseek (Fn [(Ptr FILE) Int Int] Int) "fseek")
|
|
(doc fseek! "same as (fseek) but to be used as a side effect.")
|
|
(register fseek! (Fn [(Ptr FILE) Int Int] ()) "fseek") ; note: (ignore (ffseek ...)) would also work
|
|
(doc SEEK-SET "to be used with fseek (thin wrapper for the C standard library).")
|
|
(register SEEK-SET Int "SEEK_SET")
|
|
(doc SEEK-CUR "to be used with fseek (thin wrapper for the C standard library).")
|
|
(register SEEK-CUR Int "SEEK_CUR")
|
|
(doc SEEK-END "to be used with fseek (thin wrapper for the C standard library).")
|
|
(register SEEK-END Int "SEEK_END")
|
|
(doc ftell "gets the position indicator of a file (thin wrapper for the C standard library).")
|
|
(register ftell (Fn [(Ptr FILE)] Int) "ftell")
|
|
)
|
|
|
|
(doc println "prints a string ref to stdout, appends a newline.")
|
|
(register println (Fn [(Ref String)] ()))
|
|
(doc print "prints a string ref to stdout, does not append a newline.")
|
|
(register print (Fn [(Ref String)] ()))
|
|
(doc errorln "prints a string ref to stderr, appends a newline.")
|
|
(register errorln (Fn [(Ref String)] ()))
|
|
(doc error "prints a string ref to stderr, does not append a newline.")
|
|
(register error (Fn [(Ref String)] ()))
|
|
(doc get-line "gets a line from stdin.")
|
|
(register get-line (Fn [] String))
|
|
(doc fgetc "gets a character from a file pointer (thin wrapper for the C standard library).")
|
|
(register fgetc (Fn [(Ptr FILE)] Char)) ; TODO: check EOF handling (see carp_io.h)!
|
|
|
|
(doc open-file "opens a file by name using a mode (e.g. [r]ead, [w]rite, [a]ppend), [rb] read binary...). See fopen() in the C standard library for a detailed description of valid parameters.")
|
|
(defn open-file [filename mode]
|
|
(let [ptr (IO.Raw.fopen filename mode)]
|
|
(if (null? ptr)
|
|
(Result.Error (System.error-text))
|
|
(Result.Success ptr) )))
|
|
|
|
(doc read->EOF "reads a file given by name until the End-Of-File character is reached. Please consider using read-file instead, even though this works fine for UTF-8 encoded input files.")
|
|
(defn read->EOF [filename]
|
|
(let [file? (IO.open-file filename "rb")]
|
|
(match file?
|
|
(Result.Error x) (Result.Error x)
|
|
(Result.Success f) (let [c (zero)
|
|
r []]
|
|
(do
|
|
(while (do
|
|
(set! c (IO.Raw.fgetc f))
|
|
(/= c IO.Raw.EOF))
|
|
(set! r (Array.push-back r (Byte.from-int c))))
|
|
(IO.Raw.fclose! f)
|
|
(Result.Success (String.from-bytes &r)))))))
|
|
|
|
(doc unsafe-read-file "returns the contents of a file passed as argument as a string. Note: there is no way to distinguish the output for an empty file and a missing file!")
|
|
(register unsafe-read-file (Fn [&String] String))
|
|
(doc read-file "Reads the content of a file into a (Result String String).\nIt is intended for text files, since the way to determine the length of a String is to use strlen() which probably will be inaccurate for binaries.")
|
|
(defn read-file [filename]
|
|
(let [ finput? (open-file filename "rb") ]
|
|
(if (Result.error? &finput?)
|
|
(Result.Error (fmt "Failed to open file='%s', error='%s'" filename &(Result.unsafe-from-error finput?) ))
|
|
(let [ finput (Result.unsafe-from-success finput?)
|
|
length (do
|
|
(IO.Raw.fseek! finput 0 IO.Raw.SEEK-END)
|
|
(let-do [flength (IO.Raw.ftell finput)]
|
|
(IO.Raw.rewind finput)
|
|
flength ))
|
|
buffer (String.allocate length \0 ) ]
|
|
(if (not (String.allocated? &buffer))
|
|
(do
|
|
(IO.Raw.fclose! finput)
|
|
(Result.Error (fmt "Failed to open buffer with size=%d from file='%s'" length filename)) )
|
|
(let [ bytes-read (IO.Raw.fread &buffer 1 length finput)
|
|
nop1 (IO.Raw.fclose! finput) ]
|
|
(if (not (Int.= bytes-read length))
|
|
(Result.Error (fmt "Error: file='%s' has length=%d but bytes-read=%d" filename length bytes-read))
|
|
(Result.Success buffer) )))))))
|
|
(doc write-file "Writes a string into a (text) file, overwriting it if it already exists.")
|
|
(defn write-file [content file-name]
|
|
(let [ fOut? (open-file file-name "wb") ; open as binary so line breaks don't multiply on Windows
|
|
bytes2write (String.length content) ]
|
|
(if (Result.error? &fOut?)
|
|
(Result.Error (fmt "error='%s' opening file='%s'" &(Result.unsafe-from-error fOut?) file-name))
|
|
(let-do [ fOut (Result.unsafe-from-success fOut?)
|
|
bytes-written (IO.Raw.fwrite content 1 bytes2write fOut) ]
|
|
(IO.Raw.fclose! fOut)
|
|
(if (Int.= bytes-written bytes2write)
|
|
(Result.Success true)
|
|
(Result.Error (fmt "only %d of %d bytes were written" bytes-written bytes2write)) )))))
|
|
|
|
(private getenv-)
|
|
(hidden getenv-)
|
|
(doc getenv- "gets the value of an environment variable (thin wrapper for the C standard library)")
|
|
(register getenv- (Fn [(Ptr CChar)] (Ptr CChar)) "getenv")
|
|
(doc getenv "gets the value of an environment variable (Carp-style wrapper for the C standard library)")
|
|
(defn getenv [s]
|
|
(let [e (getenv- (String.cstr s))]
|
|
(if (null? e)
|
|
(Maybe.Nothing)
|
|
(Maybe.Just (from-cstr e)))))
|
|
)
|
|
|
|
; TODO: document this cool stuff, possibly even include an example!
|
|
(defmacro println* [:rest forms]
|
|
`(IO.println %(build-str* forms)))
|
|
|
|
(defmacro print* [:rest forms]
|
|
`(IO.print %(build-str* forms)))
|