summaryrefslogtreecommitdiff
path: root/ghc/utils
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/utils')
-rw-r--r--ghc/utils/ugen/Makefile27
-rw-r--r--ghc/utils/ugen/funs.h28
-rw-r--r--ghc/utils/ugen/gen.c522
-rw-r--r--ghc/utils/ugen/id.c49
-rw-r--r--ghc/utils/ugen/id.h1
-rw-r--r--ghc/utils/ugen/lex.flex53
-rw-r--r--ghc/utils/ugen/main.c89
-rw-r--r--ghc/utils/ugen/manual.mm226
-rw-r--r--ghc/utils/ugen/syntax.y50
-rw-r--r--ghc/utils/ugen/tree.c191
-rw-r--r--ghc/utils/ugen/tree.h251
-rw-r--r--ghc/utils/ugen/tree.ugn28
-rw-r--r--ghc/utils/ugen/yyerror.c12
13 files changed, 0 insertions, 1527 deletions
diff --git a/ghc/utils/ugen/Makefile b/ghc/utils/ugen/Makefile
deleted file mode 100644
index c74bb504ce..0000000000
--- 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 7ae2f29cb0..0000000000
--- 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 5dc76a489f..0000000000
--- a/ghc/utils/ugen/gen.c
+++ /dev/null
@@ -1,522 +0,0 @@
-#ifdef __STDC__
-#define PROTO(x) x
-#else
-#define PROTO(x) ()
-#endif
-
-#include <stdio.h>
-#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 <stdio.h>\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 f8c02034c1..0000000000
--- 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 4c17446194..0000000000
--- 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 4f2e9ad0e3..0000000000
--- 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 <stdio.h>
-# 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 a22fcd2618..0000000000
--- a/ghc/utils/ugen/main.c
+++ /dev/null
@@ -1,89 +0,0 @@
-#ifdef __STDC__
-#define PROTO(x) x
-#else
-#define PROTO(x) ()
-#endif
-
-#include <stdio.h>
-#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 7c64fdcb6a..0000000000
--- 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 <stdio.h>
-#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 25f3081de6..0000000000
--- 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 093e18d112..0000000000
--- 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 83bab360d2..0000000000
--- a/ghc/utils/ugen/tree.h
+++ /dev/null
@@ -1,251 +0,0 @@
-#ifndef tree_defined
-#define tree_defined
-
-#include <stdio.h>
-
-#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 d76e137365..0000000000
--- 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 c7314f59ea..0000000000
--- a/ghc/utils/ugen/yyerror.c
+++ /dev/null
@@ -1,12 +0,0 @@
-#include <stdio.h>
-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);
-}
View Lorry Controller Status