io.c (4520B)
1 /* zlib License 2 * 3 * Copyright (c) 2017-2020 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 Val v; 34 FILE *f; 35 const char *mode = "w"; 36 tsp_arg_min(args, "write", 2); 37 if (!(v = tisp_eval_list(st, env, args))) 38 return NULL; 39 40 /* if second argument is true, append file don't write over */ 41 if (!nilp(cadr(v))) 42 mode = "a"; 43 /* first argument can either be the symbol stdout or stderr, 44 * or the file as a string */ 45 if (car(v)->t == SYMBOL) 46 f = !strncmp(car(v)->v.s, "stdout", 7) ? stdout : stderr; 47 else if (car(v)->t != STRING) 48 tsp_warnf("write: expected file name as string, received %s", 49 type_str(car(v)->t)); 50 else if (!(f = fopen(car(v)->v.s, mode))) 51 tsp_warnf("write: could not load file '%s'", car(v)->v.s); 52 if (f == stderr && strncmp(car(v)->v.s, "stderr", 7)) 53 tsp_warn("write: expected file name as string, " 54 "or symbol stdout/stderr"); 55 56 for (v = cddr(v); !nilp(v); v = cdr(v)) 57 tisp_print(f, car(v)); 58 if (f == stdout || f == stderr) 59 fflush(f); 60 else 61 fclose(f); 62 return st->none; 63 } 64 65 /* return string of given file or read from stdin */ 66 static Val 67 prim_read(Tsp st, Hash env, Val args) 68 { 69 Val v; 70 char *file, *fname = NULL; /* read from stdin by default */ 71 if (list_len(args) > 1) 72 tsp_warnf("read: expected 0 or 1 argument, received %d", list_len(args)); 73 if (list_len(args) == 1) { /* if file name given as string, read it */ 74 if (!(v = tisp_eval(st, env, car(args)))) 75 return NULL; 76 tsp_arg_type(v, "read", STRING); 77 fname = v->v.s; 78 } 79 if (!(file = tisp_read_file(fname))) 80 return st->nil; 81 return mk_str(st, file); 82 } 83 84 /* parse string as tisp expression, return (quit) if given nil */ 85 /* TODO parse more than 1 expression */ 86 static Val 87 prim_parse(Tsp st, Hash env, Val args) 88 { 89 Val v; 90 char *file = st->file; 91 size_t filec = st->filec; 92 tsp_arg_num(args, "parse", 1); 93 if (!(v = tisp_eval(st, env, car(args)))) 94 return NULL; 95 if (nilp(v)) 96 return mk_pair(mk_sym(st, "quit"), st->nil); 97 tsp_arg_type(v, "parse", STRING); 98 st->file = v->v.s; 99 st->filec = 0; 100 v = tisp_read(st); 101 st->file = file; 102 st->filec = filec; 103 return v ? v : st->none; 104 } 105 106 /* save value as binary file to be quickly read again */ 107 static Val 108 prim_save(Tsp st, Hash env, Val args) 109 { 110 Val v; 111 char *fname; 112 FILE *f; 113 tsp_arg_min(args, "save", 2); 114 if (!(v = tisp_eval_list(st, env, args))) 115 return NULL; 116 tsp_arg_type(cadr(v), "save", STRING); 117 fname = cadr(v)->v.s; 118 if (!(f = fopen(fname, "wb"))) 119 tsp_warnf("save: could not load file '%s'", fname); 120 if (!(fwrite(&*car(v), sizeof(struct Val), 1, f))) { 121 fclose(f); 122 tsp_warnf("save: could not save file '%s'", fname); 123 } 124 fclose(f); 125 return car(v); 126 } 127 128 /* return read binary value previously saved */ 129 static Val 130 prim_open(Tsp st, Hash env, Val args) 131 { 132 FILE *f; 133 char *fname; 134 struct Val v; 135 Val ret; 136 if (!(ret = malloc(sizeof(struct Val)))) { 137 fprintf(stderr, "malloc: "); 138 perror(NULL); 139 exit(1); 140 } 141 tsp_arg_min(args, "open", 1); 142 if (!(args = tisp_eval_list(st, env, args))) 143 return NULL; 144 tsp_arg_type(car(args), "save", STRING); 145 fname = car(args)->v.s; 146 if (!(f = fopen(fname, "rb"))) 147 tsp_warnf("save: could not load file '%s'", fname); 148 while (fread(&v, sizeof(struct Val), 1, f)) ; 149 fclose(f); 150 memcpy(ret, &v, sizeof(struct Val)); 151 return ret; 152 } 153 154 void 155 tib_env_io(Tsp st) 156 { 157 tsp_env_fn(write); 158 tsp_env_fn(read); 159 tsp_env_fn(parse); 160 tsp_env_fn(save); 161 tsp_env_fn(open); 162 }