+++ /dev/null
-#include <sclpl.h>
-
-#if 0
-static void lift_funcs(vec_t* fnlst, AST* tree) {
- if (tree_is_formtype(tree, "fn"))
- vec_push_back(fnlst, mem_retain(tree));
-
- if (tree->tag == TREE) {
- vec_t* p_vec = tree->ptr.vec;
- for(size_t idx = 0; idx < vec_size(p_vec); idx++) {
- lift_funcs(fnlst, (AST*)vec_at(p_vec, idx));
- }
- }
-}
-
-static vec_t* find_fn_literals(vec_t* prgrm) {
- vec_t* fnlst = vec_new(0);
- for (size_t idx = 0; idx < vec_size(prgrm); idx++) {
- AST* tree = (AST*)vec_at(prgrm, idx);
- if (!tree_is_formtype(tree, "require")) {
- lift_funcs(fnlst, tree);
- }
- }
- return fnlst;
-}
-
-static size_t get_fn_id(vec_t* funcs, AST* fn) {
- size_t idx;
- for (idx = 0; idx < vec_size(funcs); idx++) {
- if (fn == vec_at(funcs,idx)) {
- break;
- }
- }
- return idx;
-}
-
-/*****************************************************************************/
-
-static void print_indent(FILE* file, int depth) {
- for(int i = 0; i < (4 * depth); i++)
- fprintf(file, "%c", ' ');
-}
-
-static void print_char(FILE* file, char ch) {
- switch (ch) {
- case '\r': fprintf(file, "__char('\\r')"); break;
- case '\n': fprintf(file, "__char('\\n')"); break;
- case '\t': fprintf(file, "__char('\\t')"); break;
- case '\v': fprintf(file, "__char('\\v')"); break;
- default: fprintf(file, "__char('%c')", ch); break;
- }
-}
-
-static void print_string(FILE* file, const char* str) {
- fprintf(file, "__string(\"");
- while('\0' != str[0])
- {
- switch (str[0]) {
- case '\r': fprintf(file, "\\r"); break;
- case '\n': fprintf(file, "\\n"); break;
- case '\t': fprintf(file, "\\t"); break;
- case '\v': fprintf(file, "\\v"); break;
- default: fprintf(file, "%c", str[0]); break;
- }
- str++;
- }
- fprintf(file, "\")");
-}
-
-/*****************************************************************************/
-
-static void emit_header(FILE* file) {
- fputs("#include \"sclpl.h\"\n\n", file);
-}
-
-static void emit_fn_signature(FILE* file, char* name, AST* fnval) {
- fprintf(file, "_Value %s(", name);
- vec_t* params = tree_get_child(fnval, 1)->ptr.vec;
- for (size_t i = 0; i < vec_size(params); i++) {
- fprintf(file, "_Value %s", (char*)tree_get_val((AST*)vec_at(params,i)));
- if (i+1 < vec_size(params))
- fprintf(file, ", ");
- }
- fprintf(file, ")");
-}
-
-static void emit_def_placeholders(FILE* file, vec_t* prgrm) {
- for (size_t idx = 0; idx < vec_size(prgrm); idx++) {
- AST* p_tree = (AST*)vec_at(prgrm, idx);
- if (tree_is_formtype(p_tree, "def")) {
- fprintf(file, "_Value %s;\n", (char*)tree_get_child_val(p_tree,1));
- }
- }
- fputs("\n", file);
-}
-
-static void emit_expression(FILE* file, vec_t* fnlst, AST* p_tree, int depth) {
- if (p_tree->tag == ATOM) {
- Tok* tok = p_tree->ptr.tok;
- switch (tok->type) {
- case T_STRING: print_string(file, ((char*)tok->value.text)); break;
- case T_CHAR: print_char(file, ((char)(intptr_t)tok->value.character)); break;
- case T_INT: fprintf(file, "__int(%ld)", *((long int*)tok->value.integer)); break;
- case T_FLOAT: fprintf(file, "__float(%f)", ((double)tok->value.floating)); break;
- case T_BOOL: fprintf(file, "__bool(%s)", ((intptr_t)tok->value.boolean)?"true":"false"); break;
- case T_ID: fprintf(file, "%s", ((char*)tok->value.text)); break;
- default: break;
- }
- } else if (tree_is_formtype(p_tree, "if")) {
- fprintf(file, "IF (");
- emit_expression(file, fnlst, tree_get_child(p_tree, 1), depth);
- fprintf(file, ")\n");
- print_indent(file, depth+1);
- emit_expression(file, fnlst, tree_get_child(p_tree, 2), depth+1);
- fprintf(file, "\n");
- print_indent(file, depth);
- fprintf(file, "ELSE\n");
- print_indent(file, depth+1);
- if (vec_size(p_tree->ptr.vec) > 3) {
- emit_expression(file, fnlst, tree_get_child(p_tree, 4), depth+1);
- } else {
- fprintf(file, "__nil");
- }
-
- } else if (tree_is_formtype(p_tree, "fn")) {
- fprintf(file, "__func(&fn%d)", (int)get_fn_id(fnlst, p_tree));
- } else {
- vec_t* vec = p_tree->ptr.vec;
- int nargs = vec_size(vec)-1;
- /* Determine the calling convention based on number of args */
- if (0 == nargs)
- fprintf(file, "__call0(%s", (char*)tree_get_val(vec_at(vec,0)));
- else if (nargs < 16)
- fprintf(file, "__calln(%s, %d, ", (char*)tree_get_val(vec_at(vec,0)), (int)nargs);
- else
- fprintf(file, "__calln(%s, n, ", (char*)tree_get_val(vec_at(vec,0)));
- /* Print out the arguments */
- for (size_t idx = 1; idx < vec_size(vec); idx++) {
- emit_expression(file, fnlst, (AST*)vec_at(vec,idx), depth);
- if (idx+1 < vec_size(vec))
- fprintf(file, ", ");
- }
- fprintf(file, ")");
- }
-}
-
-static void emit_fn_declarations(FILE* file, vec_t* fnlst) {
- char name[64];
- for (size_t idx = 0; idx < vec_size(fnlst); idx++) {
- sprintf(name,"fn%d", (int)idx);
- fprintf(file, "static ");
- emit_fn_signature(file, name, (AST*)vec_at(fnlst,idx));
- fputs(";\n", file);
- }
- fputs("\n", file);
-}
-
-static void emit_fn_definitions(FILE* file, vec_t* fnlst) {
- char name[64];
- for (size_t idx = 0; idx < vec_size(fnlst); idx++) {
- AST* func = (AST*)vec_at(fnlst,idx);
- sprintf(name,"fn%d", (int)idx);
- fprintf(file, "static ");
- emit_fn_signature(file, name, func);
- fputs(" {\n", file);
-
- vec_t* body = (vec_t*)func->ptr.vec;
- for (size_t i = 2; i < vec_size(body); i++) {
- fprintf(file, " ");
- if (i+1 == vec_size(body))
- fprintf(file, "return ");
- emit_expression(file, fnlst, (AST*)vec_at(body,i), 1);
- fprintf(file, ";\n");
- }
- fputs("}\n\n", file);
- }
-}
-
-static void emit_toplevel(FILE* file, vec_t* fnlst, vec_t* prgrm) {
- fputs("void toplevel(void) {\n", file);
- for (size_t idx = 0; idx < vec_size(prgrm); idx++) {
- AST* p_tree = (AST*)vec_at(prgrm, idx);
- if (tree_is_formtype(p_tree, "require")) {
- fprintf(file, " extern void %s_toplevel(void);\n", (char*)tree_get_child_val(p_tree,1));
- fprintf(file, " %s_toplevel();\n", (char*)tree_get_child_val(p_tree,1));
- } else if (tree_is_formtype(p_tree, "def")) {
- fprintf(file, " %s = ", (char*)tree_get_child_val(p_tree,1));
- emit_expression(file, fnlst, tree_get_child(p_tree, 2), 0);
- fprintf(file, ";\n");
- } else {
- fprintf(file, " (void)(");
- emit_expression(file, fnlst, p_tree, 1);
- fprintf(file, ");\n");
- }
- }
- fputs("}\n", file);
-}
-
-static void emit_footer(FILE* file) {
- fputs(
- "\nint main(int argc, char** argv) {"
- "\n (void)argc;"
- "\n (void)argv;"
- "\n toplevel();"
- "\n return 0;"
- "\n}\n",
- file
- );
-}
-#endif
-void codegen_csource(FILE* file, vec_t* program) {
- (void)file;
- //emit_header(file);
- //emit_def_placeholders(file, program);
- //vec_t* funcs = find_fn_literals(program);
- //emit_fn_declarations(file, funcs);
- //emit_fn_definitions(file, funcs);
- //emit_toplevel(file, funcs, program);
- //mem_release(funcs);
- //emit_footer(file);
-}
-
+++ /dev/null
-/**
- @file log.c
- @brief See header for details
- $Revision$
- $HeadURL$
- */
-#include <sclpl.h>
-
-void log_error(const char msg[], ...) {
- va_list args;
- va_start(args, msg);
- fprintf(stderr, "Error: ");
- vfprintf(stderr, msg, args);
- va_end(args);
- fputs("\n",stderr);
-}
-
/* Driver Modes
*****************************************************************************/
static int emit_tokens(void) {
- (void)ops_token_file(NULL);
+ Tok* token;
+ Parser* ctx = parser_new(NULL, stdin);
+ while(NULL != (token = gettoken(ctx)))
+ pprint_token(stdout, token, true);
return 0;
}
static int emit_tree(void) {
- int ret = 0;
-#if 0
- list_t* files = input_files();
- size_t nfiles = list_size(files);
- if (0 == nfiles) {
- (void)ops_syntax_file(NULL);
- } else if (1 == nfiles) {
- str_t* fname = list_front(files)->contents;
- mem_release( ops_syntax_file(fname) );
- } else {
- log_error("too many files provided for target mode 'ast'");
- }
- mem_release(files);
-#endif
- return ret;
+ return 0;
}
static int emit_csource(void) {
- int ret = 0;
-#if 0
- list_t* files = input_files();
- size_t nfiles = list_size(files);
- if (0 == nfiles) {
- (void)ops_translate_file(NULL);
- } else if (1 == nfiles) {
- str_t* fname = list_front(files)->contents;
- mem_release( ops_translate_file(fname) );
- } else {
- log_error("too many files provided for target mode 'csource'");
- }
- mem_release(files);
-#endif
- return ret;
+ return 0;
}
static int exec_repl(void) {
-#if 0
- Parser* p_parser = parser_new(":> ", stdin);
- while(!parser_eof(p_parser)) {
- AST* p_tree = toplevel(p_parser);
- if (NULL != p_tree) {
- //AST* p_ast = tree_convert(p_tree);
- //pprint_tree(stdout, p_ast, 0);
- mem_release(p_tree);
- //mem_release(p_ast);
- puts("OK.");
- } else {
- parser_resume(p_parser);
- }
- }
- mem_release(p_parser);
-#endif
return 0;
}
static int emit_object(void) {
-#if 0
- list_t* files = input_files();
- size_t nfiles = list_size(files);
- if (0 == nfiles) {
- log_error("too few files provided for target mode 'object'");
- } else if (1 == nfiles) {
- str_t* fname = list_front(files)->contents;
- str_t* csrc = ops_translate_file(fname);
- str_t* obj = ops_compile_file(csrc);
- mem_release(csrc);
- mem_release(obj);
- } else {
- log_error("too many files provided for target mode 'object'");
- }
- mem_release(files);
-#endif
return 0;
}
*/
int main(int argc, char **argv) {
opts_parse( Options_Config, argc, argv );
-
if (!opts_is_set(NULL,"mode")) {
print_usage();
- } else if(opts_equal(NULL, "mode", "repl")) {
- return exec_repl();
} else if (opts_equal(NULL, "mode", "tokens")) {
return emit_tokens();
+ } else if(opts_equal(NULL, "mode", "repl")) {
+ return exec_repl();
} else if (opts_equal(NULL, "mode", "ast")) {
return emit_tree();
} else if (opts_equal(NULL, "mode", "csource")) {
} else {
print_usage();
}
-
opts_reset();
return 1;
}
+++ /dev/null
-/**
- @file opts.c
- @brief See header for details
- $Revision$
- $HeadURL$
- */
-#include <sclpl.h>
-
-#if 0
-vec_t* ops_parse_file(str_t* in) {
- //bool failed = false;
- //FILE* input = (NULL == in) ? stdin : fopen(str_cstr(in), "r");
- //Parser* p_parser = parser_new(NULL, input);
- //vec_t* p_vec = vec_new(0);
- //while(!parser_eof(p_parser)) {
- // AST* p_tree = toplevel(p_parser);
- // if (NULL != p_tree) {
- // AST* p_ast = tree_convert(p_tree);
- // mem_release(p_tree);
- // vec_push_back(p_vec, p_ast);
- // } else {
- // parser_resume(p_parser);
- // failed = true;
- // }
- //}
- //mem_release(p_parser);
- //if (failed) mem_release(p_vec);
- //return ((failed) ? NULL : p_vec);
- return NULL;
-}
-
-vec_t* ops_deps_file(vec_t* program) {
- vec_t* deps = vec_new(0);
- (void)program;
- return deps;
-}
-#endif
-
-char* ops_token_file(str_t* in) {
- FILE* input = (NULL == in) ? stdin : fopen(str_cstr(in), "r");
- FILE* output;
- if (NULL == in) {
- output = stdout;
- } else {
- ofname = sys_filename(TOKFILE, in);
- output = fopen(str_cstr(ofname), "w");
- }
-
- Parser* ctx = parser_new(NULL, input);
- Tok* token;
- while(NULL != (token = gettoken(ctx))) {
- pprint_token(output, token, true);
- mem_release(token);
- }
- mem_release(ctx);
-
- return NULL;
-}
-
-#if 0
-str_t* ops_syntax_file(str_t* in) {
- str_t* ofname = NULL;
- FILE* output;
- if (NULL == in) {
- output = stdout;
- } else {
- ofname = sys_filename(ASTFILE, in);
- output = fopen(str_cstr(ofname), "w");
- }
- vec_t* program = ops_parse_file(in);
- if (NULL != program) {
- for (size_t idx = 0; idx < vec_size(program); idx++) {
- //pprint_tree(output, (AST*)vec_at(program, idx), 0);
- }
- mem_release(program);
- fclose(output);
- } else {
- fclose(output);
- if (NULL != ofname)
- remove(str_cstr(ofname));
- mem_release(ofname);
- ofname = NULL;
- }
- return ofname;
-}
-
-str_t* ops_translate_file(str_t* in) {
- str_t* ofname = NULL;
- FILE* output;
- if (NULL == in) {
- output = stdout;
- } else {
- ofname = sys_filename(CSOURCE, in);
- output = fopen(str_cstr(ofname), "w");
- }
- vec_t* program = ops_parse_file(in);
- codegen_csource(output, program);
- fclose(output);
- mem_release(program);
- return ofname;
-}
-
-str_t* ops_compile_file(str_t* in) {
- str_t* ofname = sys_filename(OBJECT, in);
- vec_t* parts = vec_new(5, str_new("cc -c -o"), mem_retain(ofname), str_new("-I"), sys_inc_dir(), mem_retain(in));
- str_t* command = str_join(" ", parts);
- if (opts_is_set(NULL, "verbose"))
- puts(str_cstr(command));
- if (0 != system(str_cstr(command))) {
- remove(str_cstr(ofname));
- mem_swap((void**)&ofname, NULL);
- }
- remove(str_cstr(in));
- mem_release(parts);
- mem_release(command);
- return ofname;
-}
-#endif
+++ /dev/null
-/**
- @file ops.h
- @brief TODO: Describe this file
- $Revision$
- $HeadURL$
- */
-#ifndef OPS_H
-#define OPS_H
-
-
-#endif /* OPS_H */
#include <opts.h>
#include <libparse.h>
#include <stdio.h>
-#include <stdarg.h>
-#include "str.h"
-//#include "vec.h"
-#include "list.h"
-
-typedef enum {
- TOKFILE,
- ASTFILE,
- CSOURCE,
- OBJECT,
- PROGRAM,
- STATICLIB,
- SHAREDLIB
-} file_type_t;
-
-/* Filesystem Routines */
-str_t* sys_bin_dir(void);
-str_t* sys_inc_dir(void);
-str_t* sys_extension(file_type_t ftype);
-str_t* sys_filename(file_type_t ftype, str_t* infile);
/* Pretty Printing Data Structures */
void pprint_token_type(FILE* file, Tok* token);
void pprint_token(FILE* file, Tok* token, bool print_loc);
//void pprint_tree(FILE* file, AST* tree, int depth);
-/* Compiler Driver Operations */
-//vec_t* ops_parse_file(str_t* in);
-//vec_t* ops_deps_file(vec_t* program);
-str_t* ops_token_file(str_t* in);
-//str_t* ops_syntax_file(str_t* in);
-//str_t* ops_translate_file(str_t* in);
-//str_t* ops_compile_file(str_t* in);
-
-/* Error Logging */
-void log_error(const char msg[], ...);
-
-/* Code Generation */
-void codegen_csource(FILE* file, vec_t* program);
-
#endif /* SCLPL_H */
+++ /dev/null
-/**
- @file sys.c
- @brief See header for details
- $Revision$
- $HeadURL$
- */
-#include <sclpl.h>
-
-str_t* sys_bin_dir(void) {
- str_t* bindir = NULL;
- str_t* slash = str_new("/");
- str_t* progname = str_new(opts_prog_name());
- size_t index = str_rfind(progname, slash);
- str_t* path = (index == SIZE_MAX) ? NULL : str_substr(progname, 0, index+1);
- str_t* prog = (index == SIZE_MAX) ? str_new(str_cstr(progname)) : str_substr(progname, index+1, str_size(progname));
- if (NULL != path) {
- bindir = mem_retain(path);
- } else {
- log_error("Could not locate the bin directory");
- exit(1);
- // str_t* pathvar = str_new(getenv("PATH"));
- // str_t* sep = str_new(":");
- // vec_t* paths = str_split(pathvar, sep);
- // for (size_t idx = 0u; idx < vec_size(paths); idx++) {
- // str_t* currpath = (str_t*)vec_at(paths, idx);
- // str_t* binpath = str_concat(str_concat(currpath, slash), prog);
- // if (file_exists(str_cstr(binpath))) {
- // bindir = binpath;
- // mem_release(currpath);
- // break;
- // }
- // mem_release(currpath);
- // mem_release(binpath);
- // }
- // mem_release(sep);
- // mem_release(pathvar);
- // mem_release(paths);
- }
- mem_release(slash);
- mem_release(progname);
- mem_release(path);
- mem_release(prog);
- return bindir;
-}
-
-str_t* sys_inc_dir(void) {
- str_t* bindir = sys_bin_dir();
- str_t* pathmod = str_new("../include/");
- str_t* incdir = str_concat(bindir, pathmod);
- mem_release(bindir);
- mem_release(pathmod);
- return incdir;
-}
-
-str_t* sys_extension(file_type_t ftype) {
- str_t* ext = NULL;
- switch (ftype) {
- case TOKFILE: ext = str_new(".tok"); break;
- case ASTFILE: ext = str_new(".ast"); break;
- case CSOURCE: ext = str_new(".c"); break;
- case OBJECT: ext = str_new(".o"); break;
- case PROGRAM: ext = str_new(""); break;
- case STATICLIB: ext = str_new(".a"); break;
- case SHAREDLIB: ext = str_new(".lib"); break;
- default: ext = str_new(""); break;
- }
- return ext;
-}
-
-str_t* sys_filename(file_type_t ftype, str_t* infile) {
- str_t* ext_ind = str_new(".");
- size_t index = str_rfind(infile, ext_ind);
- str_t* rawname = str_substr(infile, 0, index);
- str_t* ext = sys_extension(ftype);
- str_t* fname = str_concat(rawname, ext);
- mem_release(ext_ind);
- mem_release(rawname);
- mem_release(ext);
- return fname;
-}
-
projects / proto / sclpl.git / commitdiff