From 6a9b9708cd5dd89bdd4eb8ca13f068b81e5a6890 Mon Sep 17 00:00:00 2001 From: simonmar Date: Thu, 3 Jun 1999 12:46:04 +0000 Subject: [PATCH] [project @ 1999-06-03 12:46:02 by simonmar] Remove ugen; we don't need it anymore. --- ghc/utils/ugen/Makefile | 27 --- ghc/utils/ugen/funs.h | 28 --- ghc/utils/ugen/gen.c | 522 ---------------------------------------------- ghc/utils/ugen/id.c | 49 ----- ghc/utils/ugen/id.h | 1 - ghc/utils/ugen/lex.flex | 53 ----- ghc/utils/ugen/main.c | 89 -------- ghc/utils/ugen/manual.mm | 226 -------------------- ghc/utils/ugen/syntax.y | 50 ----- ghc/utils/ugen/tree.c | 191 ----------------- ghc/utils/ugen/tree.h | 251 ---------------------- ghc/utils/ugen/tree.ugn | 28 --- ghc/utils/ugen/yyerror.c | 12 -- 13 files changed, 1527 deletions(-) delete mode 100644 ghc/utils/ugen/Makefile delete mode 100644 ghc/utils/ugen/funs.h delete mode 100644 ghc/utils/ugen/gen.c delete mode 100644 ghc/utils/ugen/id.c delete mode 100644 ghc/utils/ugen/id.h delete mode 100644 ghc/utils/ugen/lex.flex delete mode 100644 ghc/utils/ugen/main.c delete mode 100644 ghc/utils/ugen/manual.mm delete mode 100644 ghc/utils/ugen/syntax.y delete mode 100644 ghc/utils/ugen/tree.c delete mode 100644 ghc/utils/ugen/tree.h delete mode 100644 ghc/utils/ugen/tree.ugn delete mode 100644 ghc/utils/ugen/yyerror.c diff --git a/ghc/utils/ugen/Makefile b/ghc/utils/ugen/Makefile deleted file mode 100644 index c74bb50..0000000 --- a/ghc/utils/ugen/Makefile +++ /dev/null @@ -1,27 +0,0 @@ -#----------------------------------------------------------------------------- -# $Id: Makefile,v 1.7 1998/01/14 11:22:24 sof Exp $ - -TOP=../.. -include $(TOP)/mk/boilerplate.mk - -YACC_OPTS += -d -C_SRCS = syntax.tab.c lex.c id.c tree.c yyerror.c gen.c main.c -C_PROG = ugen -LIBS = $(FLEX_LIB) - -CLEAN_FILES += syntax.tab.c syntax.tab.h lex.c -SRC_CC_OPTS += -O -SRC_FLEX_OPTS += -s - -# -# Include flex & bison output in the source distribution. -# -SRC_DIST_FILES+= lex.c syntax.tab.c syntax.tab.h - -include $(TOP)/mk/target.mk - -# -# Needed quite early in the booting of the compiler, so -# build it right away. -# -boot :: all diff --git a/ghc/utils/ugen/funs.h b/ghc/utils/ugen/funs.h deleted file mode 100644 index 7ae2f29..0000000 --- a/ghc/utils/ugen/funs.h +++ /dev/null @@ -1,28 +0,0 @@ -/* fwd decls*/ -void g_consels PROTO((tree, id)); -void g_tagfun PROTO((id)); -void g_typconsel PROTO((tree, id)); -void ge_typdef PROTO((tree)); -void ge_typlist PROTO((tree)); -void gencons PROTO((id, tree)); -void genmkfillin PROTO((tree)); -void genmkparamdekl PROTO((tree)); -void genmkparamlist PROTO((tree)); -void genmkprotodekl PROTO((tree)); -void gensels PROTO((id, id, tree)); -void gentype PROTO((tree)); - -void gs_def PROTO((tree, id)); -void gs_itemlist PROTO((tree)); -void gs_typlist PROTO((tree, id)); - -void hs_def PROTO((tree)); -void hs_itemlist PROTO((tree)); -void hs_typlist PROTO((tree)); -void gen_hs_reader PROTO((id, tree)); -void gen_hs_rdalts PROTO((id, tree)); -void gen_hs_rdalt PROTO((id, tree)); -void gen_hs_rdcomponents PROTO((id, id, tree)); -void gen_hs_retcomponents PROTO((id, id, tree)); - -id installid PROTO((char *)); diff --git a/ghc/utils/ugen/gen.c b/ghc/utils/ugen/gen.c deleted file mode 100644 index 5dc76a4..0000000 --- a/ghc/utils/ugen/gen.c +++ /dev/null @@ -1,522 +0,0 @@ -#ifdef __STDC__ -#define PROTO(x) x -#else -#define PROTO(x) () -#endif - -#include -#include "id.h" -#include "tree.h" -#include "funs.h" -extern FILE *fh, *fc, *fhs; - -void -ge_typdef(t) - tree t; -{ - /* - ** Generate to the .h file: - ** - ** typdef enum { - ** constructor1, - ** constructor2, - ** ... - ** } *Ttypename; - */ - fprintf(fh, "#ifndef %s_defined\n", gtid(t)); - fprintf(fh, "#define %s_defined\n", gtid(t)); - fprintf(fh, "\n#include \n"); /* for stderr */ - fprintf(fh, "\n#ifndef PROTO\n"); - fprintf(fh, "#ifdef __STDC__\n"); - fprintf(fh, "#define PROTO(x) x\n"); - fprintf(fh, "#else\n"); - fprintf(fh, "#define PROTO(x) /**/\n"); - fprintf(fh, "#endif\n"); - fprintf(fh, "#endif\n\n"); - fprintf(fh, "#ifdef UGEN_DEBUG\n"); - fprintf(fh, "int\tfprintf PROTO((FILE *, const char *, ...));\n"); - fprintf(fh, "#endif /* UGEN_DEBUG */\n\n"); - fprintf(fh, "typedef enum {\n"); - ge_typlist(gtdeflist(t)); - fprintf(fh, "\n} T%s;\n\n", gtid(t)); - /* - ** Generate to the .hs file: - ** - ** data U_typename - ** = U_constructor1 | U_constructor2 | ... - */ - /* - ** Generate to the .h file: - ** - ** typedef struct { Ttypename tag; } *typename; - */ - fprintf(fh, "typedef struct { T%s tag; } *%s;\n\n", gtid(t), gtid(t)); - - g_tagfun(gtid(t)); /* generate the tag-grabbing function */ - - /* Generate the struct definitions (to the .h file). */ - gs_typlist(gtdeflist(t), gtid(t)); - - /* Generate a Haskell-equiv data type (to the .hs file) */ - fprintf(fhs, "data U_%s = ", gtid(t)); - hs_typlist(gtdeflist(t)); - fprintf(fhs, "\n\n"); - /* And a type with which to talk about the C-land parse tree */ -/* fprintf(fhs, "data U__%s = U__%s Addr#\n", gtid(t), gtid(t)); - fprintf(fhs, "instance _CCallable U__%s\n", gtid(t)); - fprintf(fhs, "instance _CReturnable U__%s\n\n", gtid(t)); -*/ -} - -void -ge_typlist(t) - tree t; -{ - switch(ttree(t)) { - case deflist: - ge_typlist(gdeflist(t)); - fprintf(fh, ",\n\t%s", gdid(gdef(t))); - break; - case def: - fprintf(fh, "\t%s", gdid(t)); - break; - default: - fprintf(stderr,"ge_typlist: funny abstract syntax.\n"); - break; - } -} - -void -gs_typlist(t, tid) - tree t; - id tid; -{ - switch(ttree(t)) { - case deflist: - gs_typlist(gdeflist(t), tid); - gs_def(gdef(t), tid); - break; - case def: - gs_def(t, tid); - break; - default: - fprintf(stderr,"gs_typlist: funny abstract syntax.\n"); - break; - } -} - -void -hs_typlist(t) - tree t; -{ - switch(ttree(t)) { - case deflist: - hs_typlist(gdeflist(t)); - fprintf(fhs, "| "); - hs_def(gdef(t)); - break; - case def: - hs_def(t); - break; - default: - fprintf(stderr,"hs_typlist: funny abstract syntax.\n"); - break; - } -} - -void -gs_def(t, tid) - tree t; - id tid; -{ - fprintf(fh, "struct S%s {\n", gdid(t)); - fprintf(fh, "\tT%s tag;\n", tid); - gs_itemlist(gditemlist(t)); - fprintf(fh, "};\n\n"); -} - -void -hs_def(t) - tree t; -{ - fprintf(fhs, "U_%s ", gdid(t)); - hs_itemlist(gditemlist(t)); -} - -void -gs_itemlist(t) - tree t; -{ - switch(ttree(t)) { - case emitemlist: - break; - case itemlist: - gs_itemlist(gitemlist(t)); - fprintf(fh, "\t%s X%s;\n", - gitemtypid(gitem(t)), gitemfunid(gitem(t)) ); - break; - case item: - fprintf(fh, "\t%s X%s;\n", - gitemtypid(t), gitemfunid(t)); - break; - default: - fprintf(stderr,"gs_itemlist: funny abs. syntax: %d\n.", ttree(t)); - break; - } -} - -void -hs_itemlist(t) - tree t; -{ - switch(ttree(t)) { - case emitemlist: - break; - case itemlist: - hs_itemlist(gitemlist(t)); - fprintf(fhs, "U_%s ", gitemtypid(gitem(t))); - break; - case item: - fprintf(fhs, "U_%s ", gitemtypid(t)); - break; - default: - fprintf(stderr,"hs_itemlist: funny abs. syntax: %d\n.", ttree(t)); - break; - } -} - -void -g_tagfun(typid) - id typid; -{ - fprintf(fh, "#ifdef __GNUC__\n"); - - /* to satisfy GCC when in really-picky mode: */ - fprintf(fh, "T%s t%s(%s t);\n", typid, typid, typid); - /* the real thing: */ - fprintf(fh, "extern __inline__ T%s t%s(%s t)\n{\n\treturn(t -> tag);\n}\n", - typid, typid, typid); - - fprintf(fh, "#else /* ! __GNUC__ */\n"); - - fprintf(fh, "extern T%s t%s PROTO((%s));\n", typid, typid, typid); - fprintf(fc, "\nT%s t%s(t)\n %s t;\n{\n\treturn(t -> tag);\n}\n\n", - typid, typid, typid); - - fprintf(fh, "#endif /* ! __GNUC__ */\n\n"); -} -/*******************************************************************/ - -void -g_consels(t, typid) - tree t; - id typid; -{ - switch(ttree(t)) { - case deflist: - g_consels(gdeflist(t), typid); - g_typconsel(gdef(t), typid); - break; - case def: - g_typconsel(t, typid); - break; - default: - fprintf(stderr,"g_consel: funny abstract syntax.\n"); - break; - } -} - -/***********************************************************************/ - -void -g_typconsel(t, typid) - tree t; - id typid; -{ - fprintf(fc, "\n/************** %s ******************/\n\n", gdid(t)); - gencons(typid, t); - gensels(typid, gdid(t), gditemlist(t)); - fprintf(fh, "\n"); -} - -void -gencons(typid, t) - id typid; - tree t; /* of kind 'def'. */ -{ - tree itemlist = gditemlist(t); - - fprintf(fh, "extern %s mk%s PROTO((", typid, gdid(t)); - switch (ttree(itemlist)) { - case emitemlist: /* empty list */ - fprintf(fh, "void"); - break; - default: - genmkprotodekl(itemlist); - break; - } - fprintf(fh, "));\n"); - - fprintf(fc, "%s mk%s(", typid, gdid(t)); - switch (ttree(itemlist)) { - case emitemlist: /* empty list */ - fprintf(fc, "void"); - break; - default: - genmkparamlist(itemlist); - break; - } - fprintf(fc, ")\n"); - - genmkparamdekl(itemlist); - - fprintf(fc, "{\n\tregister struct S%s *pp =\n", gdid(t)); - fprintf(fc, "\t\t(struct S%s *) malloc(sizeof(struct S%s));\n", - gdid(t), gdid(t)); - fprintf(fc, "\tpp -> tag = %s;\n", gdid(t)); - genmkfillin(itemlist); - fprintf(fc, "\treturn((%s)pp);\n", typid); - fprintf(fc, "}\n"); -} - -void -genmkparamlist(t) - tree t; -{ - switch(ttree(t)) { - case emitemlist: - break; - case itemlist: - genmkparamlist(gitemlist(t)); - fprintf(fc, ", "); - genmkparamlist(gitem(t)); - break; - case item: - fprintf(fc, "PP%s", gitemfunid(t)); - break; - default: - fprintf(stderr,"genparamlist: funny abs syntax.\n"); - break; - } -} - -void -genmkparamdekl(t) - tree t; /* of kind 'itemlist' or 'item' */ -{ - switch(ttree(t)) { - case emitemlist: - break; - case itemlist: - genmkparamdekl(gitemlist(t)); - genmkparamdekl(gitem(t)); - break; - case item: - fprintf(fc, " %s PP%s;\n", gitemtypid(t), gitemfunid(t)); - break; - default: - fprintf(stderr,"genmkparamdekl: funny abs syntax.\n"); - break; - } -} - -void -genmkprotodekl(t) - tree t; /* of kind 'itemlist' or 'item' */ -{ - switch(ttree(t)) { - case emitemlist: - break; - case itemlist: - genmkprotodekl(gitemlist(t)); - fprintf(fh, ", "); - genmkprotodekl(gitem(t)); - break; - case item: - fprintf(fh, "%s", gitemtypid(t)); - break; - default: - fprintf(stderr,"genmkprotodekl: funny abs syntax.\n"); - break; - } -} - -void -genmkfillin(t) - tree t; -{ - switch(ttree(t)) { - case emitemlist: - break; - case itemlist: - genmkfillin(gitemlist(t)); - genmkfillin(gitem(t)); - break; - case item: - fprintf(fc, "\tpp -> X%s = PP%s;\n", - gitemfunid(t), gitemfunid(t)); - break; - default: - fprintf(stderr,"genmkfillin: funny abs syntax.\n"); - break; - } -} - -void -gensels(typid, variantid, t) - id typid; - id variantid; - tree t; -{ - switch(ttree(t)) { - case emitemlist: - break; - case itemlist: - gensels(typid, variantid, gitemlist(t)); - gensels(typid, variantid, gitem(t)); - break; - case item: - fprintf(fh, "#ifdef __GNUC__\n"); - - /* to satisfy GCC when in extremely-picky mode: */ - fprintf(fh, "\n%s *R%s PROTO((struct S%s *));\n", - gitemtypid(t), gitemfunid(t), variantid); - /* the real thing: */ - fprintf(fh, "\nextern __inline__ %s *R%s(struct S%s *t)\n{\n", - gitemtypid(t), gitemfunid(t), variantid); - fprintf(fh, "#ifdef UGEN_DEBUG\n"); - fprintf(fh, "\tif(t -> tag != %s)\n", variantid); - fprintf(fh, "\t\tfprintf(stderr,\"%s: illegal selection; was %%d\\n\", t -> tag);\n", gitemfunid(t)); - fprintf(fh, "#endif /* UGEN_DEBUG */\n"); - fprintf(fh, "\treturn(& t -> X%s);\n}\n", gitemfunid(t)); - - fprintf(fh, "#else /* ! __GNUC__ */\n"); - - fprintf(fh, - "extern %s *R%s PROTO((struct S%s *));\n", - gitemtypid(t), gitemfunid(t), variantid); - - fprintf(fc, "\n%s *R%s(t)\n struct S%s *t;\n{\n", - gitemtypid(t), gitemfunid(t), variantid); - fprintf(fc, "#ifdef UGEN_DEBUG\n"); - fprintf(fc, "\tif(t -> tag != %s)\n", variantid); - fprintf(fc, "\t\tfprintf(stderr,\"%s: illegal selection; was %%d\\n\", t -> tag);\n", gitemfunid(t)); - fprintf(fc, "#endif /* UGEN_DEBUG */\n"); - fprintf(fc, "\treturn(& t -> X%s);\n}\n", gitemfunid(t)); - - fprintf(fh, "#endif /* ! __GNUC__ */\n\n"); - - fprintf(fh, - "#define %s(xyzxyz) (*R%s((struct S%s *) (xyzxyz)))\n", - gitemfunid(t), gitemfunid(t), variantid); - break; - default: - fprintf(stderr,"gensels: funny abs syntax.\n"); - break; - } - -} - -/***********************************************************************/ - -void -gen_hs_reader(typid, deflist) - id typid; - tree deflist; -{ - /* signature */ - fprintf(fhs, "rdU_%s :: _Addr -> UgnM U_%s\n", typid, typid); - - /* defn */ - fprintf(fhs, "rdU_%s t\n = ioToUgnM (_ccall_ t%s t) `thenUgn` \\ tag@(I# _) ->\n", typid, typid); - fprintf(fhs, " if "); - gen_hs_rdalts(typid, deflist); - fprintf(fhs, " else\n\terror (\"rdU_%s: bad tag selection:\"++show tag++\"\\n\")\n", typid); -} - -void -gen_hs_rdalts(typid, t) - id typid; - tree t; -{ - switch(ttree(t)) { - case deflist: - gen_hs_rdalts(typid, gdeflist(t)); - fprintf(fhs, " else if "); - gen_hs_rdalt (typid, gdef(t)); - break; - case def: - gen_hs_rdalt(typid, t); - break; - default: - fprintf(stderr,"gen_hs_rdalts: funny abstract syntax.\n"); - break; - } -} - -void -gen_hs_rdalt(typid, t) - id typid; - tree t; -{ - fprintf(fhs, "tag == ``%s'' then\n", gdid(t)); - gen_hs_rdcomponents (typid, gdid(t), gditemlist(t)); - fprintf(fhs, "\treturnUgn (U_%s ", gdid(t)); - gen_hs_retcomponents(typid, gdid(t), gditemlist(t)); - fprintf(fhs, ")\n"); /* end of alt */ -} - -void -gen_hs_rdcomponents(typid, variantid, t) - id typid; - id variantid; - tree t; -{ - switch(ttree(t)) { - case emitemlist: - break; - case itemlist: - gen_hs_rdcomponents(typid, variantid, gitemlist(t)); - gen_hs_rdcomponents(typid, variantid, gitem(t)); - break; - case item: - fprintf(fhs, "\tioToUgnM (_ccall_ %s t) `thenUgn` \\ x_%s ->\n", - gitemfunid(t), gitemfunid(t)); - - fprintf(fhs, "\trdU_%s x_%s `thenUgn` \\ y_%s ->\n", - gitemtypid(t), gitemfunid(t), gitemfunid(t)); - -/* fprintf(fhs, "\tif(t -> tag != %s)\n", variantid); - fprintf(fhs, "\t\tfprintf(stderr,\"%s: illegal selection; was %%d\\n\", t -> tag);\n", gitemfunid(t)); - fprintf(fhs, "\treturn(& t -> X%s);\n}\n", gitemfunid(t)); -*/ break; - - default: - fprintf(stderr,"gen_hs_rdcomponents: funny abs syntax.\n"); - break; - } -} - -void -gen_hs_retcomponents(typid, variantid, t) - id typid; - id variantid; - tree t; -{ - switch(ttree(t)) { - case emitemlist: - break; - case itemlist: - gen_hs_retcomponents(typid, variantid, gitemlist(t)); - fprintf(fhs, " "); - gen_hs_retcomponents(typid, variantid, gitem(t)); - break; - case item: - fprintf(fhs, "y_%s", gitemfunid(t)); - break; - - default: - fprintf(stderr,"gen_hs_retcomponents: funny abs syntax.\n"); - break; - } -} diff --git a/ghc/utils/ugen/id.c b/ghc/utils/ugen/id.c deleted file mode 100644 index f8c0203..0000000 --- a/ghc/utils/ugen/id.c +++ /dev/null @@ -1,49 +0,0 @@ -# include "id.h" - -#define bool int -#define true 1 -#define false 0 - -char id_area[10000]; -char *id_top = &id_area[0]; - - - -/* -** Equalid returns true if the two identifiers are the same, -** otherwise false. -*/ -bool equalid(i1, i2) - id i1, i2; -{ - return(i1 == i2); -} - -/* -** Installid installs an identifier into the id_area. -*/ -id installid(string) - char *string; -{ - char *startofid, *search, *s; - - for(search = id_area; search < id_top;) { - startofid = search; - s = string; - while(*search++ == *s++) { - if(*search == 0 && *s == 0) { - return(startofid); - } - } - while(*search != 0) - search++; - search++; - } - - startofid = id_top; - for(s = string; *s != 0;) { - *id_top++ = *s++; - } - *id_top++ = 0; - return(startofid); -} diff --git a/ghc/utils/ugen/id.h b/ghc/utils/ugen/id.h deleted file mode 100644 index 4c17446..0000000 --- a/ghc/utils/ugen/id.h +++ /dev/null @@ -1 +0,0 @@ -typedef char *id; diff --git a/ghc/utils/ugen/lex.flex b/ghc/utils/ugen/lex.flex deleted file mode 100644 index 4f2e9ad..0000000 --- a/ghc/utils/ugen/lex.flex +++ /dev/null @@ -1,53 +0,0 @@ -%{ -#define YYSTYPE long - -#ifdef __STDC__ -#define PROTO(x) x -#else -#define PROTO(x) () -#endif - -# include "syntax.tab.h" -# include -# include "id.h" -# include "tree.h" -# include "funs.h" -extern YYSTYPE yylval; -extern FILE *fc, *fhs; -int lineno; - -void countNewlines (char *s) -{ - while (*s) if (*s++ == '\n') lineno += 1; -} - -%} - -%% -";" { return(SEMICOL); } -":" { return(COLON); } -"<" { return(STDEF); } -">" { return(ENDDEF); } -"type" { return(TYPE); } -"end" { return(END); } -[A-Za-z][A-Za-z0-9_]* { yylval = (YYSTYPE) installid(yytext); return(ID); } -"\n" { lineno += 1; } -. { } -"/*"([^*]|"*"[^/]|\n)*"*/" { countNewlines(yytext); } -"%{{"([^%]|"%"[^}]|\n)*"%}}" { - /* For Haskell includes */ - countNewlines(yytext); - yytext[yyleng-3] = '\0'; - fprintf(fhs, "\n%s", yytext+3); - } -"%{"([^%]|"%"[^}]|\n)*"%}" { - countNewlines(yytext); - yytext[yyleng-2] = '\0'; - fprintf(fc, "\n%s", &yytext[2]); - } -%% -int -yywrap() -{ - return(1); -} diff --git a/ghc/utils/ugen/main.c b/ghc/utils/ugen/main.c deleted file mode 100644 index a22fcd2..0000000 --- a/ghc/utils/ugen/main.c +++ /dev/null @@ -1,89 +0,0 @@ -#ifdef __STDC__ -#define PROTO(x) x -#else -#define PROTO(x) () -#endif - -#include -#include "id.h" -#include "tree.h" - -#include "funs.h" - -FILE *fh, *fc, *fhs; -extern int lineno; - -tree root; /* The root of the built syntax tree. */ - -main(argc, argv) - int argc; - char **argv; -{ - int i = 0; - - if(argc != 2) { - printf("Missing input file.\n"); - exit(1); - } - - if(freopen(argv[1], "r", stdin) == NULL) { - fprintf(stderr, "Cannot open %s.\n", argv[1]); - exit(1); - } - - while(argv[1][i+1] != 0) - i++; - if(! (argv[1][i-3] == '.' && - argv[1][i-2] == 'u' && - argv[1][i-1] == 'g' && - argv[1][i] == 'n')) { - fprintf(stderr, "Not a .ugn file\n"); - exit(1); - } - - argv[1][i-2] = 'c'; - argv[1][i-1] = '\0'; - fc = fopen(argv[1], "w"); /* .c file */ - argv[1][i-2] = 'h'; - fh = fopen(argv[1], "w"); /* .h file */ - argv[1][i-1] = 's'; - argv[1][i] = '\0'; - fhs = fopen(argv[1], "w"); /* .hs file */ - argv[1][i-1] = '\0'; - - lineno = 1; - if(yyparse() == 0) { - /* No syntax errors. */ - - fprintf(fc, "#include \"%s\"\n", argv[1]); - gentype(root); - exit(0); - - } else { - /* There was a syntax error. */ -/* ToDo: this stuff is now *WWRROONNGG* (WDP 94/10) */ - unlink(argv[1][i]); - argv[i][i] = 'c'; - unlink(argv[1][i]); - fprintf(stderr, "Nothing generated.\n"); - exit(1); - } -} - -void -gentype(t) - tree t; -{ - ge_typdef(t); /* Generate the .h - file. */ - - /* Generate the struct definitions. */ -/*partain:moved gs_typlist(gtdeflist(t), gtid(t)); -*/ - /* Generate constructors and selectors. */ - g_consels(gtdeflist(t), gtid(t)); - - fprintf(fh, "#endif\n"); /* for .h multi-slurp protector */ - - /* Generate Haskell reader */ - gen_hs_reader(gtid(t), gtdeflist(t)); -} diff --git a/ghc/utils/ugen/manual.mm b/ghc/utils/ugen/manual.mm deleted file mode 100644 index 7c64fdc..0000000 --- a/ghc/utils/ugen/manual.mm +++ /dev/null @@ -1,226 +0,0 @@ -.nr N 1 -.nr L 72 -.so /usr/lib/tmac/tmac.m -.SA 1 -.ce -\fIRecursive Data Types Made Simple with Ugen\fR -.sp -.ce -Thomas Johnsson -.sp 2 -.ce -\*(DT -.sp 2 -.H 1 "Introduction" -Recursive datatypes in an important class of data structures -we often use in, for instance, abstract syntax trees in compilers. -An example of a recursive data type is shown below -(written in some hypothetical language): -.DS - \fItype\fR bintree = - \fIunion\fR - interior: (bintree, bintree); - leaf: (int ); - \fIend union\fR; -.DE -The type bintree is a union of two variants: 'interior' which consists -of two bintrees, and 'leaf' which has an integer value associated to it. -.P -The program \fIugen\fR is yet another tool which relieves the -the C-programmer from the burden of implementing the -constructor-, selector- and variant test functions associated to -such a type. -.H 1 "How to use ugen" -Suppose the specification below is in a file called 'treedef.u'. -.DS - type bintree; - interior : < getleft: bintree; getright: bintree; >; - leaf : < getint: int; >; - end; -.DE -The command -.DS - ugen treedef.u -.DE -creates two files: 'treedef.c' and 'treedef.h'. -The file 'treedef.h' will contain the following definitions: -.DS - typedef enum{ interior, leaf } Tbintree; - typedef .... *bintree; -.DE -The type 'Tbintree' is an enumerated type with the same identifiers as -the variants of the recursive data type, -the type 'bintree' is implemented as a pointer to something. -This file must be included in all files where the type 'bintree' -is used. -Furthermore, the file treedef.h also contains macro definitions for -the selector functions; these macroes simply use the corresponding function -in treedefs.c that returns a pointer to that intended field. -In this manner, updating of a field can be done by simple assignment, -by for example -.DS - getleft(x) = ..... -.DE -The file 'treedef.c' will contain the following definitions. -.sp -.nf -.in +4 -#include "treedef.h" -/* The function tbintree returns the variant of the - * bintree parameter. - */ -Tbintree tbintree(t) bintree t; { ... } - -/* Constructor function for variant interior. - */ -bintree mkinterior(t1, t2) bintree t1, t2; { ... } - -/* Its selector functions, returns pointers to a field in the node. - */ -bintree *Xgetleft(t) bintree t; { ... } -bintree *Xgetright(t) bintree t; { ... } - - -/* Constructor function for variant leaf. - */ -bintree mkleaf(i) int i; { ... } - -/* Its selector function. - */ -int getint(t) bintree t; { ... } -.in -4 -.sp -.fi -The pointers returned by the constructor functions are -returned by the memory allocation function \fImalloc\fR, -so one may use \fIfree\fR to reclaim storage, if that is desired. -.P -The appendix contains the file listings of a complete program -that reads an expression on normal infix form and prints -it in prefix form, eg: -.DS - input: 12 + 3 * 5 - output: +(12, *(3, 5)) -.DE -Lex and yacc has been used for lexical- and syntax analysis, -ugen for the intermediate tree form, and make maintains it all. -.HU "Appendix - Example of use of ugen" -.nf -.sp -syntax.y: -.in +4 -.sp -%{ -#include "tree.h" -extern tree root; -%} -%token PLUS TIMES LPAR RPAR INT -%left PLUS -%right TIMES -%start top -%% -top : expr { root = $1; } - -expr : expr PLUS expr { $$ = mkplus($1, $3); } | - expr TIMES expr { $$ = mktimes($1, $3); } | - LPAR expr RPAR { $$ = $2; } | - INT { $$ = mkinteger($1);} -%% -yyerror(s) char *s; { - printf("%s\n", s); -} -.sp -.in -4 -lexicals.l: -.in +4 -.sp -%{ -#include -#include "y.tab.h" -extern int yylval; -%} -%% -"*" return(TIMES); -"+" return(PLUS); -"(" return(LPAR); -")" return(RPAR); -[0-9]+ { sscanf(yytext, "%d", &yylval); - return(INT); - } -. ; -"\\n" ; -%% -int yywrap(){ return(1); } -.sp -.in -4 -main.c: -.in +4 -.sp -#include "tree.h" -tree root; - -main() { - if(! yyparse()) /* if no syntax errors .. */ - prefixprint(root); -} - -prefixprint(t) - tree t; -{ - switch(ttree(t)) { - case plus: - printf("+("); - prefixprint(gplusleft(t)); - printf(", "); - prefixprint(gplusright(t)); - printf(")"); - break; - case times: - printf("*("); - prefixprint(gtimesleft(t)); - printf(", "); - prefixprint(gtimesright(t)); - printf(")"); - break; - case integer: - printf("%d", getint(t)); - break; - } -} -.sp -.in -4 -.SK -tree.u: -.sp -.in +4 -type tree; - plus :< gplusleft : tree; - gplusright : tree; - >; - times :< gtimesleft : tree; - gtimesright : tree; - >; - integer :< getint : int; - >; -end; -.sp -.in -4 -makefile: -.sp -.in +4 -pre : main.o y.tab.o lex.yy.o tree.o - cc main.o y.tab.o lex.yy.o tree.o -o pre -main.o : main.c tree.h - cc -c main.c -y.tab.o : y.tab.c - cc -c y.tab.c -lex.yy.o: lex.yy.c y.tab.h - cc -c lex.yy.c -tree.o : tree.c tree.h - cc -c tree.c -y.tab.c : syntax.y - yacc -d syntax.y -lex.yy.c: lexicals.l - lex lexicals.l -tree.c tree.h : tree.u - ugen tree.u diff --git a/ghc/utils/ugen/syntax.y b/ghc/utils/ugen/syntax.y deleted file mode 100644 index 25f3081..0000000 --- a/ghc/utils/ugen/syntax.y +++ /dev/null @@ -1,50 +0,0 @@ -%{ -#define YYSTYPE long -# include "id.h" -# include "tree.h" -extern tree root; -%} -%token ID TYPE SEMICOL COLON END STDEF ENDDEF -%% - -typdef : - TYPE ID SEMICOL deflist END SEMICOL = - { - root = mktypdef((id)$2,(tree)$4); - }; - -deflist : - def = - { - $$ = $1; - } | - deflist def = - { - $$ = (long)mkdeflist((tree)$1,(tree)$2); - }; - -def : - ID COLON STDEF itemlist ENDDEF SEMICOL = - { - $$ = (long)mkdef((id)$1,(tree)$4); - } | - ID COLON STDEF ENDDEF SEMICOL = - { - $$ = (long)mkdef((id)$1,mkemitemlist()); - }; - -itemlist: - item = - { - $$ = $1; - } | - itemlist item = - { - $$ = (long)mkitemlist((tree)$1,(tree)$2); - }; - -item : - ID COLON ID SEMICOL = - { - $$ = (long)mkitem((id)$1,(id)$3); - }; diff --git a/ghc/utils/ugen/tree.c b/ghc/utils/ugen/tree.c deleted file mode 100644 index 093e18d..0000000 --- a/ghc/utils/ugen/tree.c +++ /dev/null @@ -1,191 +0,0 @@ -#include "id.h" -#include "tree.h" - -extern char *malloc (); - -Ttree ttree(t) - tree t; -{ - return(t -> tag); -} - - -/************** typdef ******************/ - -tree mktypdef(PPgtid, PPgtdeflist) - id PPgtid; - tree PPgtdeflist; -{ - register struct Stypdef *pp = - (struct Stypdef *) malloc(sizeof(struct Stypdef)); - pp -> tag = typdef; - pp -> Xgtid = PPgtid; - pp -> Xgtdeflist = PPgtdeflist; - return((tree)pp); -} - -id *Rgtid(t) - struct Stypdef *t; -{ -#ifdef UGEN_DEBUG - if(t -> tag != typdef) - fprintf(stderr,"gtid: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgtid); -} - -tree *Rgtdeflist(t) - struct Stypdef *t; -{ -#ifdef UGEN_DEBUG - if(t -> tag != typdef) - fprintf(stderr,"gtdeflist: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgtdeflist); -} - -/************** deflist ******************/ - -tree mkdeflist(PPgdeflist, PPgdef) - tree PPgdeflist; - tree PPgdef; -{ - register struct Sdeflist *pp = - (struct Sdeflist *) malloc(sizeof(struct Sdeflist)); - pp -> tag = deflist; - pp -> Xgdeflist = PPgdeflist; - pp -> Xgdef = PPgdef; - return((tree)pp); -} - -tree *Rgdeflist(t) - struct Sdeflist *t; -{ -#ifdef UGEN_DEBUG - if(t -> tag != deflist) - fprintf(stderr,"gdeflist: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgdeflist); -} - -tree *Rgdef(t) - struct Sdeflist *t; -{ -#ifdef UGEN_DEBUG - if(t -> tag != deflist) - fprintf(stderr,"gdef: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgdef); -} - -/************** def ******************/ - -tree mkdef(PPgdid, PPgditemlist) - id PPgdid; - tree PPgditemlist; -{ - register struct Sdef *pp = - (struct Sdef *) malloc(sizeof(struct Sdef)); - pp -> tag = def; - pp -> Xgdid = PPgdid; - pp -> Xgditemlist = PPgditemlist; - return((tree)pp); -} - -id *Rgdid(t) - struct Sdef *t; -{ -#ifdef UGEN_DEBUG - if(t -> tag != def) - fprintf(stderr,"gdid: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgdid); -} - -tree *Rgditemlist(t) - struct Sdef *t; -{ -#ifdef UGEN_DEBUG - if(t -> tag != def) - fprintf(stderr,"gditemlist: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgditemlist); -} - -/************** itemlist ******************/ - -tree mkitemlist(PPgitemlist, PPgitem) - tree PPgitemlist; - tree PPgitem; -{ - register struct Sitemlist *pp = - (struct Sitemlist *) malloc(sizeof(struct Sitemlist)); - pp -> tag = itemlist; - pp -> Xgitemlist = PPgitemlist; - pp -> Xgitem = PPgitem; - return((tree)pp); -} - -tree *Rgitemlist(t) - struct Sitemlist *t; -{ -#ifdef UGEN_DEBUG - if(t -> tag != itemlist) - fprintf(stderr,"gitemlist: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgitemlist); -} - -tree *Rgitem(t) - struct Sitemlist *t; -{ -#ifdef UGEN_DEBUG - if(t -> tag != itemlist) - fprintf(stderr,"gitem: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgitem); -} - -/************** emitemlist ******************/ - -tree mkemitemlist(void) -{ - register struct Semitemlist *pp = - (struct Semitemlist *) malloc(sizeof(struct Semitemlist)); - pp -> tag = emitemlist; - return((tree)pp); -} - -/************** item ******************/ - -tree mkitem(PPgitemfunid, PPgitemtypid) - id PPgitemfunid; - id PPgitemtypid; -{ - register struct Sitem *pp = - (struct Sitem *) malloc(sizeof(struct Sitem)); - pp -> tag = item; - pp -> Xgitemfunid = PPgitemfunid; - pp -> Xgitemtypid = PPgitemtypid; - return((tree)pp); -} - -id *Rgitemfunid(t) - struct Sitem *t; -{ -#ifdef UGEN_DEBUG - if(t -> tag != item) - fprintf(stderr,"gitemfunid: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgitemfunid); -} - -id *Rgitemtypid(t) - struct Sitem *t; -{ -#ifdef UGEN_DEBUG - if(t -> tag != item) - fprintf(stderr,"gitemtypid: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgitemtypid); -} diff --git a/ghc/utils/ugen/tree.h b/ghc/utils/ugen/tree.h deleted file mode 100644 index 83bab36..0000000 --- a/ghc/utils/ugen/tree.h +++ /dev/null @@ -1,251 +0,0 @@ -#ifndef tree_defined -#define tree_defined - -#include - -#ifndef PROTO -#ifdef __STDC__ -#define PROTO(x) x -#else -#define PROTO(x) /**/ -#endif -#endif - -typedef enum { - typdef, - deflist, - def, - itemlist, - emitemlist, - item -} Ttree; - -typedef struct { Ttree tag; } *tree; - -#ifdef __GNUC__ -Ttree ttree(tree t); -extern __inline__ Ttree ttree(tree t) -{ - return(t -> tag); -} -#else /* ! __GNUC__ */ -extern Ttree ttree PROTO((tree)); -#endif /* ! __GNUC__ */ - -struct Stypdef { - Ttree tag; - id Xgtid; - tree Xgtdeflist; -}; - -struct Sdeflist { - Ttree tag; - tree Xgdeflist; - tree Xgdef; -}; - -struct Sdef { - Ttree tag; - id Xgdid; - tree Xgditemlist; -}; - -struct Sitemlist { - Ttree tag; - tree Xgitemlist; - tree Xgitem; -}; - -struct Semitemlist { - Ttree tag; -}; - -struct Sitem { - Ttree tag; - id Xgitemfunid; - id Xgitemtypid; -}; - -extern tree mktypdef PROTO((id, tree)); -#ifdef __GNUC__ - -id *Rgtid PROTO((struct Stypdef *)); - -extern __inline__ id *Rgtid(struct Stypdef *t) -{ -#ifdef UGEN_DEBUG - if(t -> tag != typdef) - fprintf(stderr,"gtid: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgtid); -} -#else /* ! __GNUC__ */ -extern id *Rgtid PROTO((struct Stypdef *)); -#endif /* ! __GNUC__ */ - -#define gtid(xyzxyz) (*Rgtid((struct Stypdef *) (xyzxyz))) -#ifdef __GNUC__ - -tree *Rgtdeflist PROTO((struct Stypdef *)); - -extern __inline__ tree *Rgtdeflist(struct Stypdef *t) -{ -#ifdef UGEN_DEBUG - if(t -> tag != typdef) - fprintf(stderr,"gtdeflist: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgtdeflist); -} -#else /* ! __GNUC__ */ -extern tree *Rgtdeflist PROTO((struct Stypdef *)); -#endif /* ! __GNUC__ */ - -#define gtdeflist(xyzxyz) (*Rgtdeflist((struct Stypdef *) (xyzxyz))) - -extern tree mkdeflist PROTO((tree, tree)); -#ifdef __GNUC__ - -tree *Rgdeflist PROTO((struct Sdeflist *)); - -extern __inline__ tree *Rgdeflist(struct Sdeflist *t) -{ -#ifdef UGEN_DEBUG - if(t -> tag != deflist) - fprintf(stderr,"gdeflist: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgdeflist); -} -#else /* ! __GNUC__ */ -extern tree *Rgdeflist PROTO((struct Sdeflist *)); -#endif /* ! __GNUC__ */ - -#define gdeflist(xyzxyz) (*Rgdeflist((struct Sdeflist *) (xyzxyz))) -#ifdef __GNUC__ - -tree *Rgdef PROTO((struct Sdeflist *)); - -extern __inline__ tree *Rgdef(struct Sdeflist *t) -{ -#ifdef UGEN_DEBUG - if(t -> tag != deflist) - fprintf(stderr,"gdef: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgdef); -} -#else /* ! __GNUC__ */ -extern tree *Rgdef PROTO((struct Sdeflist *)); -#endif /* ! __GNUC__ */ - -#define gdef(xyzxyz) (*Rgdef((struct Sdeflist *) (xyzxyz))) - -extern tree mkdef PROTO((id, tree)); -#ifdef __GNUC__ - -id *Rgdid PROTO((struct Sdef *)); - -extern __inline__ id *Rgdid(struct Sdef *t) -{ -#ifdef UGEN_DEBUG - if(t -> tag != def) - fprintf(stderr,"gdid: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgdid); -} -#else /* ! __GNUC__ */ -extern id *Rgdid PROTO((struct Sdef *)); -#endif /* ! __GNUC__ */ - -#define gdid(xyzxyz) (*Rgdid((struct Sdef *) (xyzxyz))) -#ifdef __GNUC__ - -tree *Rgditemlist PROTO((struct Sdef *)); - -extern __inline__ tree *Rgditemlist(struct Sdef *t) -{ -#ifdef UGEN_DEBUG - if(t -> tag != def) - fprintf(stderr,"gditemlist: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgditemlist); -} -#else /* ! __GNUC__ */ -extern tree *Rgditemlist PROTO((struct Sdef *)); -#endif /* ! __GNUC__ */ - -#define gditemlist(xyzxyz) (*Rgditemlist((struct Sdef *) (xyzxyz))) - -extern tree mkitemlist PROTO((tree, tree)); -#ifdef __GNUC__ - -tree *Rgitemlist PROTO((struct Sitemlist *)); - -extern __inline__ tree *Rgitemlist(struct Sitemlist *t) -{ -#ifdef UGEN_DEBUG - if(t -> tag != itemlist) - fprintf(stderr,"gitemlist: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgitemlist); -} -#else /* ! __GNUC__ */ -extern tree *Rgitemlist PROTO((struct Sitemlist *)); -#endif /* ! __GNUC__ */ - -#define gitemlist(xyzxyz) (*Rgitemlist((struct Sitemlist *) (xyzxyz))) -#ifdef __GNUC__ - -tree *Rgitem PROTO((struct Sitemlist *)); - -extern __inline__ tree *Rgitem(struct Sitemlist *t) -{ -#ifdef UGEN_DEBUG - if(t -> tag != itemlist) - fprintf(stderr,"gitem: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgitem); -} -#else /* ! __GNUC__ */ -extern tree *Rgitem PROTO((struct Sitemlist *)); -#endif /* ! __GNUC__ */ - -#define gitem(xyzxyz) (*Rgitem((struct Sitemlist *) (xyzxyz))) - -extern tree mkemitemlist PROTO((void)); - -extern tree mkitem PROTO((id, id)); -#ifdef __GNUC__ - -id *Rgitemfunid PROTO((struct Sitem *)); - -extern __inline__ id *Rgitemfunid(struct Sitem *t) -{ -#ifdef UGEN_DEBUG - if(t -> tag != item) - fprintf(stderr,"gitemfunid: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgitemfunid); -} -#else /* ! __GNUC__ */ -extern id *Rgitemfunid PROTO((struct Sitem *)); -#endif /* ! __GNUC__ */ - -#define gitemfunid(xyzxyz) (*Rgitemfunid((struct Sitem *) (xyzxyz))) -#ifdef __GNUC__ - -id *Rgitemtypid PROTO((struct Sitem *)); - -extern __inline__ id *Rgitemtypid(struct Sitem *t) -{ -#ifdef UGEN_DEBUG - if(t -> tag != item) - fprintf(stderr,"gitemtypid: illegal selection; was %d\n", t -> tag); -#endif /* UGEN_DEBUG */ - return(& t -> Xgitemtypid); -} -#else /* ! __GNUC__ */ -extern id *Rgitemtypid PROTO((struct Sitem *)); -#endif /* ! __GNUC__ */ - -#define gitemtypid(xyzxyz) (*Rgitemtypid((struct Sitem *) (xyzxyz))) - -#endif diff --git a/ghc/utils/ugen/tree.ugn b/ghc/utils/ugen/tree.ugn deleted file mode 100644 index d76e137..0000000 --- a/ghc/utils/ugen/tree.ugn +++ /dev/null @@ -1,28 +0,0 @@ -%{ -extern char *malloc (); -#include "id.h" -%} -type tree; - - typdef : < - gtid : id; - gtdeflist : tree; - >; - deflist : < - gdeflist : tree; - gdef : tree; - >; - def : < - gdid : id; - gditemlist : tree; - >; - itemlist : < - gitemlist : tree; - gitem : tree; - >; - emitemlist: < >; - item : < - gitemfunid : id; - gitemtypid : id; - >; -end; diff --git a/ghc/utils/ugen/yyerror.c b/ghc/utils/ugen/yyerror.c deleted file mode 100644 index c7314f5..0000000 --- a/ghc/utils/ugen/yyerror.c +++ /dev/null @@ -1,12 +0,0 @@ -#include -extern int lineno; -extern char *yytext; - -void yyerror(s) - char *s; -{ - fprintf(stderr, "\n%s", s); - if (lineno) fprintf(stderr, ", line %d, ", lineno); - fprintf(stderr, "on input: "); - fprintf(stderr, "%s\n", yytext); -} -- 1.7.10.4