io.c (4328B)
1 /* zlib License 2 * 3 * Copyright (c) 2017-2022 Ed van Bruggen 4 * 5 * This software is provided 'as-is', without any express or implied 6 * warranty. In no event will the authors be held liable for any damages 7 * arising from the use of this software. 8 * 9 * Permission is granted to anyone to use this software for any purpose, 10 * including commercial applications, and to alter it and redistribute it 11 * freely, subject to the following restrictions: 12 * 13 * 1. The origin of this software must not be misrepresented; you must not 14 * claim that you wrote the original software. If you use this software 15 * in a product, an acknowledgment in the product documentation would be 16 * appreciated but is not required. 17 * 2. Altered source versions must be plainly marked as such, and must not be 18 * misrepresented as being the original software. 19 * 3. This notice may not be removed or altered from any source distribution. 20 */ 21 #include <string.h> 22 #include <stdio.h> 23 #include <stdlib.h> 24 #include <fcntl.h> 25 26 #include "../tisp.h" 27 28 /* write all arguemnts to given file, or stdout/stderr, without newline */ 29 /* first argument is file name, second is option to append file */ 30 static Val 31 prim_write(Tsp st, Hash env, Val args) 32 { 33 FILE *f; 34 const char *mode = "w"; 35 tsp_arg_min(args, "write", 2); 36 37 /* if second argument is true, append file don't write over */ 38 if (!nilp(cadr(args))) 39 mode = "a"; 40 /* first argument can either be the symbol stdout or stderr, 41 * or the file as a string */ 42 if (car(args)->t == TSP_SYM) 43 f = !strncmp(car(args)->v.s, "stdout", 7) ? stdout : stderr; 44 else if (car(args)->t != TSP_STR) 45 tsp_warnf("write: expected file name as string, received %s", 46 type_str(car(args)->t)); 47 else if (!(f = fopen(car(args)->v.s, mode))) 48 tsp_warnf("write: could not load file '%s'", car(args)->v.s); 49 if (f == stderr && strncmp(car(args)->v.s, "stderr", 7)) 50 tsp_warn("write: expected file name as string, " 51 "or symbol stdout/stderr"); 52 53 for (args = cddr(args); !nilp(args); args = cdr(args)) 54 tisp_print(f, car(args)); 55 if (f == stdout || f == stderr) 56 fflush(f); 57 else 58 fclose(f); 59 return st->none; 60 } 61 62 /* return string of given file or read from stdin */ 63 static Val 64 prim_read(Tsp st, Hash env, Val args) 65 { 66 char *file, *fname = NULL; /* read from stdin by default */ 67 tsp_arg_max(args, "read", 1); 68 if (list_len(args) == 1) { /* if file name given as string, read it */ 69 tsp_arg_type(car(args), "read", TSP_STR); 70 fname = car(args)->v.s; 71 } 72 if (!(file = tisp_read_file(fname))) 73 return st->nil; 74 return mk_str(st, file); 75 } 76 77 /* parse string as tisp expression, return (quit) if given nil */ 78 /* TODO parse more than 1 expression */ 79 static Val 80 prim_parse(Tsp st, Hash env, Val args) 81 { 82 Val expr; 83 char *file = st->file; 84 size_t filec = st->filec; 85 tsp_arg_num(args, "parse", 1); 86 expr = car(args); 87 if (nilp(expr)) 88 return mk_pair(mk_sym(st, "quit"), st->nil); 89 tsp_arg_type(expr, "parse", TSP_STR); 90 st->file = expr->v.s; 91 st->filec = 0; 92 expr = tisp_read(st); 93 /* for (; tsp_fget(st) && (expr = tisp_read(st));) ; */ 94 st->file = file; 95 st->filec = filec; 96 return expr ? expr : st->none; 97 /* return tisp_parse_file(st, expr->v.s); */ 98 } 99 100 /* save value as binary file to be quickly read again */ 101 static Val 102 prim_save(Tsp st, Hash env, Val args) 103 { 104 char *fname; 105 FILE *f; 106 tsp_arg_min(args, "save", 2); 107 tsp_arg_type(cadr(args), "save", TSP_STR); 108 fname = cadr(args)->v.s; 109 if (!(f = fopen(fname, "wb"))) 110 tsp_warnf("save: could not load file '%s'", fname); 111 if (!(fwrite(&*car(args), sizeof(struct Val), 1, f))) { 112 fclose(f); 113 tsp_warnf("save: could not save file '%s'", fname); 114 } 115 fclose(f); 116 return car(args); 117 } 118 119 /* return read binary value previously saved */ 120 static Val 121 prim_open(Tsp st, Hash env, Val args) 122 { 123 FILE *f; 124 char *fname; 125 struct Val v; 126 Val ret; 127 if (!(ret = malloc(sizeof(struct Val)))) 128 perror("; malloc"), exit(1); 129 tsp_arg_min(args, "open", 1); 130 tsp_arg_type(car(args), "open", TSP_STR); 131 fname = car(args)->v.s; 132 if (!(f = fopen(fname, "rb"))) 133 tsp_warnf("save: could not load file '%s'", fname); 134 while (fread(&v, sizeof(struct Val), 1, f)) ; 135 fclose(f); 136 memcpy(ret, &v, sizeof(struct Val)); 137 return ret; 138 } 139 140 void 141 tib_env_io(Tsp st) 142 { 143 tsp_env_prim(write); 144 tsp_env_prim(read); 145 tsp_env_prim(parse); 146 tsp_env_prim(save); 147 tsp_env_prim(open); 148 }