Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
254 lines (216 sloc) 6.3 KB
(add-ns st (git-dependency "https://github.com/Toccata-Lang/stream.git"
"stream.toc"
:sha "c778079"))
(inline C "
typedef struct {
int open;
FILE *fd;} fileDescStruct;
void close_file(void *ptr) {
fileDescStruct *fileDesc = (fileDescStruct *)ptr;
if (fileDesc->open && fileDesc->fd) {
fclose(fileDesc->fd);
fileDesc->fd = NULL;
}
free(fileDesc);
#ifdef CHECK_MEM_LEAK
__atomic_fetch_add(&free_count, 1, __ATOMIC_ACQ_REL);
#endif
}
Value *makeFileStruct(FILE *fd) {
fileDescStruct *fdStruct = (fileDescStruct *)my_malloc(sizeof(fileDescStruct));
fdStruct->fd = fd;
fdStruct->open = 1;
Value *opaque = opaqueValue(fdStruct, close_file);
return(opaque);
}
")
(defn fopen-read [file-path]
(assert (instance? String file-path))
(inline C Maybe "
String *arg0Str;
arg0Str = nullTerm(file_path_0);
FILE* fd = fopen(arg0Str->buffer, \"r\");
dec_and_free((Value *)arg0Str, 1);
if (fd == NULL) {
return(nothing);
} else {
fseek(fd, 0, SEEK_SET);
Value *opaque = makeFileStruct(fd);
Value *mo = maybe((List *)0, (Value *)0, opaque);
return(mo);
}
"))
(defn read* [fileDesc]
;; private function. Use 'blocking-read' instead
(inline C String "
fileDescStruct *fileDesc = (fileDescStruct *)((Opaque *)fileDesc_0)->ptr;
if (feof(fileDesc->fd)) {
dec_and_free(fileDesc_0, 1);
return((Value *)malloc_string(0));
}
// TODO: Figure out how to have a new type of buffer to avoid extra copy operation
char buffer[5005];
if (feof(fileDesc->fd)) {
dec_and_free(fileDesc_0, 1);
return((Value *)malloc_string(0));
} else {
int64_t byte_count = fread(buffer, 1, 5000, fileDesc->fd);
String *strVal = malloc_string(byte_count);
strncpy(strVal->buffer, buffer, byte_count);
dec_and_free(fileDesc_0, 1);
return((Value *)strVal);
}
"))
(defn eof? [fileDesc]
(inline C Maybe "
fileDescStruct *fileDesc = (fileDescStruct *)((Opaque *)fileDesc_0)->ptr;
dec_and_free(fileDesc_0, 1);
if (!feof(fileDesc->fd)) {
return(nothing);
} else {
Value *mv = maybe((List *)0, (Value *)0, (Value *)nothing);
return(mv);
}
"))
(defn fopen-write [file-path]
(assert (instance? String file-path))
(inline C Maybe "
String *arg0Str;
arg0Str = nullTerm(file_path_0);
FILE* fd = fopen(arg0Str->buffer, \"wb\");
dec_and_free((Value *)arg0Str, 1);
if (fd == NULL) {
return(nothing);
} else {
fileDescStruct *fdStruct = (fileDescStruct *)my_malloc(sizeof(fileDescStruct));
fdStruct->open = 1;
fdStruct->fd = fd;
Value *opaque = opaqueValue(fdStruct, close_file);
Value *mo = maybe((List *)0, (Value *)0, opaque);
return(mo);
}
"))
(defn write* [file-desc str-buffer]
(assert (instance? String str-buffer))
;; private function. Use 'write' instead
(inline C Integer "
char *buffer;
int64_t len;
fileDescStruct *fileDesc = (fileDescStruct *)((Opaque *)file_desc_0)->ptr;
if (str_buffer_1->type == StringBufferType) {
buffer = ((String *)str_buffer_1)->buffer;
len = ((String *)str_buffer_1)->len;
} else if (str_buffer_1->type == SubStringType) {
buffer = ((SubString *)str_buffer_1)->buffer;
len = ((SubString *)str_buffer_1)->len;
}
Value *result = integerValue(fwrite(buffer, 1, len, fileDesc->fd));
dec_and_free(file_desc_0, 1);
dec_and_free(str_buffer_1, 1);
return(result);
"))
(defn close* [file-desc]
;; private function. Use 'close' instead
(inline C Integer "
fileDescStruct *fileDesc = (fileDescStruct *)((Opaque *)file_desc_0)->ptr;
fclose(fileDesc->fd);
dec_and_free(file_desc_0, 1);
return(integerValue(1));
"))
(defprotocol FileProto
(write [_ str-buffer])
(read [_])
(blocking-read [_])
(close [_]))
(deftype InputFile [file-desc path]
(assert (instance? Opaque file-desc))
Stringable
(string-list [_] (list "<InputFile " path ">"))
Collection
(empty? [_]
(eof? file-desc))
Container
(extract [_]
(read* file-desc))
Seqable
(first [x]
(either (and (empty? x)
(maybe nothing))
(extract x)))
(rest [x]
x)
st/AsStream
(st/stream [fd]
(st/stream (lazy-list fd)))
FileProto
(close [_]
(close* file-desc)))
(deftype OutputFile [file-desc path]
Stringable
(string-list [_] (list "<OutputFile " path ">"))
FileProto
(write [_ str-buffer] (write* file-desc str-buffer))
(close [_] (close* file-desc)))
(defn file-out [path]
(map (fopen-write path)
(fn [file-desc]
(OutputFile file-desc path))))
(defn file-in [path]
(map (fopen-read path)
(fn [file-desc]
(InputFile file-desc path))))
(defn file-sink [s path]
(map (file-out path)
(fn [out-file]
(st/sink s (fn [x]
(either (and (instance? st/StreamEnd x)
(maybe (close out-file)))
(write out-file x)))))))
(defn slurp [fileName]
(inline C String
"String *arg0Str = nullTerm(fileName_0);
FILE *file = fopen(arg0Str->buffer, \"r\");
if (file == NULL) {
dec_and_free((Value *)arg0Str, 1);
String *strVal = malloc_string(0);
return((Value *)strVal);
} else {
fseek(file, 0, SEEK_END);
int64_t buffSize = ftell(file);
fseek(file, 0, SEEK_SET);
String *strVal = malloc_string(buffSize);
fread(strVal->buffer, 1, buffSize, file);
fclose(file);
dec_and_free((Value *)arg0Str, 1);
return((Value *)strVal);
}\n"))
(inline C "char stdinBuffer[5005];\n")
(defn reset-stdin []
(inline C "
stdinBuffer[0] = 0;
return(nothing);\n"))
(def _ (reset-stdin))
(defn read-stdin []
(inline C String "
// TODO: Figure out how to have a new type of buffer to avoid extra copy operation
if (stdinBuffer[0] == 0) {
fgets(stdinBuffer, 5000, stdin);
int bytesRead = strlen(stdinBuffer);
if (bytesRead > 0)
stdinBuffer[bytesRead - 1] = 0;
}
return(stringValue(stdinBuffer));
"))
(def stdin
(st/Stream nothing
(fn [_]
(maybe (read-stdin)))
(fn [_]
(reset-stdin)
nothing)
(fn [_] nothing)))
(defn stdout [s]
(let [stdout-agent (agent 0)]
(st/sink s (fn [x]
(or (instance? st/StreamEnd x)
(send stdout-agent (fn [_] (pr* x))))))))
You can’t perform that action at this time.