bootstrap.c 24.6 KB
Newer Older
1001

1002
1003
1004
1005
1006
1007
1008
}

// ----------------------------------------------------------------------------
// printing 
// ----------------------------------------------------------------------------

static void 
1009
cherry_write_tuple(FILE* out, struct value* value)
1010
1011
1012
1013
{
	struct value** p = TUPLE_DATA(value);
	struct value** e = TUPLE_DATA(value) + TUPLE_SIZE(value);

1014
	cherry_write(out, *p);
1015
1016
1017
1018
	p++;

	while(p < e) {
		fprintf(out, " ");
1019
		cherry_write(out, *p);
1020
1021
1022
1023
1024
		p++;
	}	
}

static void
1025
cherry_write_pair(FILE* out, struct value* value)
1026
1027
1028
1029
{
	struct value* head = HEAD(value);
	struct value* tail = TAIL(value);

1030
	cherry_write(out, head);
1031
1032
1033
	
	if(IS_PAIR(tail)) {
		fprintf(out, " ");
1034
		cherry_write_pair(out, tail);
1035
1036
1037
	} else if(IS_NULL(tail)) {
		return;
	} else if(IS_DOT(tail)) {
1038
		cherry_write_pair(out, tail);
1039
1040
1041
1042
1043
	} else
		failure("Unexpected value found in write");
}


1044
1045
1046
1047
1048
1049
1050
1051
void
cherry_writeln(FILE* out, struct value* value)
{
	cherry_write(out, value);
	fprintf(out, "\n");
	fflush(out);
}

1052
void
1053
cherry_write(FILE* out, struct value* value)
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
{
	const byte_t* p;

	switch(value->tag) {
		case EMPTYLIST:
			fprintf(out, "()");
			break;

		case BOOLEAN:
			fprintf(out, (value->fixnum_value) ? "true" : "false");
			break;

		case DOT:
			fprintf(out, " . ");
			break;

		case SYMBOL:
			fprintf(out, "%s", value->symbol_value);
			break;

		case FIXNUM:
			fprintf(out, "%ld", value->fixnum_value);
			break;

		case FLOAT:
			fprintf(out, "%lf", value->float_value);
			break;

1082
		case CHARACTER:
1083
			fprintf(out, "\\");
1084
			switch(value->character_value) {
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
				case '\0':
					fprintf(out, "null");
					break;
				case '\a':
					fprintf(out, "bell");
					break;
				case '\b':
					fprintf(out, "backspace");
					break;
				case '\f':
					fprintf(out, "formfeed");
					break;
				case '\n': 
					fprintf(out, "newline");
					break;
				case ' ':
					fprintf(out, "space");
					break;
				case '\r':
					fprintf(out, "return");
					break;
				case '\t':
					fprintf(out, "tab");
					break;
				case '\v':
					fprintf(out, "vtab");
					break;
				default:
1113
					fprintf(out, "%c", (char) value->character_value);
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
			}
			break;

		case STRING:
			p = value->string_value;
			fprintf(out, "\"");
			while(*p != '\0') {
				switch(*p) {
					case '\a':
						fprintf(out, "\\a");
						break;
					case '\b':
						fprintf(out, "\\b");
						break;
					case '\f':
						fprintf(out, "\\f");
						break;
					case '\n': 
						fprintf(out, "\\n");
						break;
					case '\r':
						fprintf(out, "\\r");
						break;
					case '\t':
						fprintf(out, "\\t");
						break;
					case '\v':
						fprintf(out, "\v");
					case '"':
						fprintf(out, "\\\"");
						break;
					case '\\':
						fprintf(out, "\\");
						break;
					default:
						fprintf(out, "%c", *p);
				}
				p++;
			}
			fprintf(out, "\"");
			break;

1156
1157
1158
1159
		case FOREIGN:
			fprintf(out, "#foreign");
			break;

1160
		case PRIMITIVE:
1161
			fprintf(out, "#primitive");
1162
1163
			break;

1164
1165
		case PROCEDURE:
			fprintf(out, "#procedure");
1166
1167
1168
1169
			break;

		case PAIR:
			fprintf(out, "(");
1170
			cherry_write_pair(out, value);
1171
1172
1173
1174
1175
			fprintf(out, ")");
			break;

		case TUPLE:
			fprintf(out, "[");
1176
			cherry_write_tuple(out, value);
1177
1178
1179
1180
1181
1182
			fprintf(out, "]");
			break;

		default:
			failure("cannot write an unknown value type");
	}
1183
1184
1185

	fprintf(out, "\n");
	fflush(out);
1186
}
1187
1188
1189
1190
1191
1192


// ----------------------------------------------------------------------------
// main
// ----------------------------------------------------------------------------

1193
1194
#define SCANNER_BUFFERSIZE 2048

1195
1196
void cherry_main(const char* filename, const byte_t* method, struct value* args)
{
1197
1198
1199
1200
1201
1202
1203
1204
	FILE* port = fopen(filename, "rb");
	byte_t buffer[SCANNER_BUFFERSIZE];

	if(!port)
		failure("could not load file %s", filename);

	byte_t* p = text(port);
	struct value* exp = cherry_read(&p, buffer, SCANNER_BUFFERSIZE);
1205
	struct value* env = core_environment();
1206
1207

	while(exp != 0) {
1208
		cherry_eval(env, exp);
1209
1210
		exp = cherry_read(&p, buffer, SCANNER_BUFFERSIZE);
	}
1211

1212
	exit(EXIT_SUCCESS);
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
}


static void 
print_usage(FILE* out, const char* prog) {
	fprintf(out, "Usage: %s [options] [file]\n");
	fprintf(out, 
		"   -h   --help			     Display this usage information.\n"
		"   -I   --loadpath=[PATH]   Specify loadpath for interpreter.\n"
		"   -M   --main=[method]	 Specify method that is executed automatically.\n");
}


int main(int argc, char** argv)
{
	static struct option options[] = {
		{"help", no_argument, 0, 'h'},
//		{"loadpath", optional_argument, 0, 'I'},
		{"main", optional_argument, 0, 'M'}
	};

	initialize();

	int ch;
	const char* filename = 0;
	const byte_t* method = 0;
	struct value* arguments = Emptylist;
	struct value* last = arguments;

	while( (ch = getopt_long(argc, argv, "hM:", options, 0)) != -1) {
		switch(ch) {
			case 'h':
				print_usage(stdout, argv[0]);
				exit(EXIT_SUCCESS);
//			case 'I':
//				cherry_ptrarray_append(load_path, optarg);
//				break;
			case 'M':
				method = optarg;
				break;
			case '?':
				print_usage(stderr, argv[0]);
				exit(EXIT_FAILURE);
			default:
				fprintf(stderr, "???");
				exit(EXIT_FAILURE);
		}
	}

	if(optind < argc)
		filename = argv[optind++];

	while(optind < argc) {
		last = TAIL(last) = cons(string(argv[optind++]), Emptylist);
	}

	if(filename)
		cherry_main(filename, method, TAIL(arguments));
	else
		failure("cherry: no input given");

	return EXIT_SUCCESS;
}

For faster browsing, not all history is shown. View entire blame