(system-include "carp_io.h") (register-type FILE) (defmodule IO (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 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 get-char "gets a character from stdin (thin wrapper for getchar() from C standard library).") (register get-char (Fn [] Char) "getchar") (doc exit "exit the current program with a return code (thin wrapper for the C standard library).") (register exit (Fn [Int] ()) "exit") (doc EOF "the End-Of-File character as a literal (thin wrapper for the C standard library)") (register EOF Char) (doc fopen "opens a file for input/output/appending (thin wrapper for fopen(pathname, mode) from C standard library). Consider using the function [`open-file`](#open-file) instead.") (register fopen (Fn [&String &String] (Ptr FILE))) (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.fopen filename mode)] (if (null? ptr) (do (Result.Error System.errno)) (Result.Success ptr)))) (doc fclose "closes a file pointer (thin wrapper for the C standard library).") (register fclose (Fn [(Ptr FILE)] ())) (doc fgetc "gets a character from a file pointer (thin wrapper for the C standard library).") (register fgetc (Fn [(Ptr FILE)] Char)) (doc fwrite "writes a C-string to a file and returns the number of written items (thin wrapper for fwrite(cstr, item-size, items-count, file) from C standard library). Consider using [`write-file`](#write-file) instead.") (register fwrite (Fn [(Ptr CChar) Int Int (Ptr FILE)] Int) "fwrite") ; any reason to use 'a' instead of '(Ptr CChar)' here? (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.") (register fread (Fn [a Int Int (Ptr FILE)] Int) "fread") (doc fflush "flushes a file pointer, i.e. commits every write (thin wrapper for the C standard library).") (register fflush (Fn [(Ptr FILE)] ()) "fflush") (doc rewind "rewinds a file pointer, i.e. puts input and output stream to beginning (thin wrapper for the C standard library).") (register rewind (Fn [(Ptr FILE)] ()) "rewind") (doc unlink "unlinks a file, i.e. deletes it (thin wrapper for POSIX api in ).") (register unlink (Fn [String] ()) "unlink") (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] ()) "fseek") (doc ftell "gets the position indicator of a file (thin wrapper for the C standard library).") (register ftell (Fn [(Ptr FILE)] Int) "ftell") (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 read->EOF "reads a file given by name until the End-Of-File character is reached.") (defn read->EOF [filename] (let [maybe (IO.open-file filename "rb")] (match maybe (Result.Error x) (Result.Error x) (Result.Success f) (let [c (zero) r []] (do (while (do (set! c (IO.fgetc f)) (/= c IO.EOF)) (set! r (Array.push-back r c))) (IO.fclose f) (Result.Success (String.from-chars &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 [ finp? (open-file filename "rb") ] (if (Result.error? &finp?) (Result.Error (fmt "Failed to open file='%s', error-number=%d" filename (Result.unsafe-from-error finp?) )) (let [ finput (Result.unsafe-from-success finp?) length (do (fseek finput 0 SEEK-END) (let-do [ flength (ftell finput) ] (rewind finput) ; aka (fseek ofile 0 SEEK-SET) flength )) buffer (String.allocate length \0 ) ] (if (not (String.allocated? &buffer)) (do (fclose finput) (Result.Error (fmt "Failed to open buffer with size=%d from file='%s'" length filename)) ) (let [ bytes-read (fread (String.cstr &buffer) 1 length finput) nop1 (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=%d opening file='%s'" (Result.unsafe-from-error fOut?) file-name)) (let-do [ fOut (Result.unsafe-from-success fOut?) bytes-written (fwrite (String.cstr content) 1 bytes2write fOut) ] (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 [String] (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- s)] (if (null? e) (Maybe.Nothing) (Maybe.Just (from-cstr e))))) ) (defmacro println* [:rest forms] `(IO.println %(build-str* forms))) (defmacro print* [:rest forms] `(IO.print %(build-str* forms)))