Commit f2deb41ba224944d7f54946a96a203e85db53bcb

  • avatar
  • Antti-Juhani Kaijanaho <antti-juhani @kaij…aho.fi> (Committer)
  • Thu Nov 15 12:33:14 EET 2012
  • avatar
  • Antti-Juhani Kaijanaho <antti-juhani @kaij…aho.fi> (Author)
  • Thu Nov 15 12:33:14 EET 2012
General cleanup.

Signed-off-by: Antti-Juhani Kaijanaho <antti-juhani@kaijanaho.fi>
hm.y
(65 / 61)
  
5454#include <stdlib.h>
5555#include <string.h>
5656
57/* NEW(x) allocates a single (unititialized) object in x. If
58 allocation fails, enomem() will be called. Note that x must be
57/* NEW(x) allocates a single (unititialized) object in x using malloc.
58 If allocation fails, enomem() will be called. Note that x must be
5959 free of side-effects (most commonly, x will be a variable) and have
60 a pointer type. */
60 a pointer type. The invoker acquires ownership of the allocated
61 object. */
6162#define NEW(x) do { (x) = malloc(sizeof *(x)); if (!(x)) enomem(); } while (0)
6263
63/* Make a newly malloced duplicate of the given string. */
64/* Makes a newly malloced duplicate of the given string; the caller
65 acquires ownership of the returned string */
6466static char *dup_str(const char *);
6567
6668/* Prints an out-of-memory message and terminates the program. */
6769static void enomem(void);
6870
6971struct srcloc {
70 const char *fname;
72 const char *fname; // not owned by the struct
7173 int line;
7274};
7375
7476struct str_with_loc {
75 char *str;
77 char *str; // owned by the struct
7678 struct srcloc loc;
7779};
7880
8282 ABSTRACT SYNTAX DECLARATIONS
8383***************************************************************************/
8484
85/* Ownership should not be tracked for struct term and struct type.
86 There will eventually be a garbage collector for them. */
87
8588enum term_kind { TE_VAR,
8689 TE_APP,
8790 TE_ABS,
146146};
147147struct type;
148148
149// Never returns TY_REPLACED
150149static enum type_kind type_kind(const struct type *);
151150
152151static void for_every_component_type(struct type *,
184184
185185/* Defines the named symbol, and returns the previous definition of
186186 that same symbol (or 0 if there was none). If memory is exhausted,
187 calls enomem(). */
188static struct typed_term *define_symbol(const char *, struct typed_term *);
187 calls enomem().
189188
189 Caller relinquishes ownership of tt and aquires ownership of the
190 return value. The ownership of s is not affected. */
191static struct typed_term *define_symbol(const char *s, struct typed_term *tt);
192
190193/* Looks up the current definition of the named symbol, and returns it
191 (or 0 if the symbol is currently not defined). */
192static struct typed_term *lookup_symbol(const char *);
194 (or 0 if the symbol is currently not defined).
193195
196 The caller does not acquire or relinguish any ownerships. */
197static struct typed_term *lookup_symbol(const char *s);
198
194199%}
195200
201/**************************************************************************
202 PARSER
203***************************************************************************/
204
196205%union {
197206 struct srcloc loc;
198207 struct str_with_loc str;
199208 struct term *term;
200209}
201210
202/**************************************************************************
203 PARSER
204***************************************************************************/
205
206211%token<loc> FST LAMBDA LET IN MU SND '(' ')'
207212
208213%token<str> ID
252252}
253253
254254term :
255 apterm
256{ $$ = $1; }
257| MU ID '.' term
258{
259 $$ = make_te_mu($2.str, $4, $1, term_end($4));
260}
261| LAMBDA ID '.' term
262{
263 $$ = make_te_abs($2.str, $4, $1, term_end($4));
264}
265| LET ID '=' term IN term
266{
267 $$ = make_te_let($2.str, $4, $6, $1, term_end($6));
268}
255 apterm { $$ = $1; }
256| MU ID '.' term { $$ = make_te_mu($2.str, $4, $1, term_end($4)); }
257| LAMBDA ID '.' term { $$ = make_te_abs($2.str, $4, $1, term_end($4)); }
258| LET ID '=' term IN term { $$ = make_te_let($2.str, $4, $6,
259 $1, term_end($6)); }
269260;
270261
271262apterm :
272 pterm
273{ $$ = $1; }
274| apterm pterm
275{
276 $$ = make_te_app($1, $2, term_start($1), term_end($2));
277}
263 pterm { $$ = $1; }
264| apterm pterm { $$ = make_te_app($1, $2,
265 term_start($1), term_end($2)); }
278266;
279267
280268pterm :
281 ID
282{
283 $$ = make_te_var($1.str, $1.loc, $1.loc);
284}
285| FST
286{
287 $$ = make_te_fst($1);
288}
289| SND
290{
291 $$ = make_te_snd($1);
292}
293| '(' term ',' term ')'
294{
295 $$ = make_te_pair($2, $4, $1, $5);
296}
297| '(' term ')'
298{
299 $$ = $2;
300}
269 ID { $$ = make_te_var($1.str, $1.loc, $1.loc); }
270| FST { $$ = make_te_fst($1); }
271| SND { $$ = make_te_snd($1); }
272| '(' term ',' term ')' { $$ = make_te_pair($2, $4, $1, $5); }
273| '(' term ')' { $$ = $2; }
301274;
302275
303276%%
409409 TERM PRETTY PRINTER
410410***************************************************************************/
411411
412/* There's a printer function for every nonterminal in the term language,
413 each based on the productions of that nonterminal. */
414
412415static void print_pterm(struct term *t, FILE *fp)
413416{
414417 switch (term_kind(t)) {
487487 TYPE PRETTY PRINTER
488488***************************************************************************/
489489
490/* There's no grammar in the parser for types, but the pretty printer
491 follows the following grammar:
492
493 type ::= type_2 | type_2 "->" type
494 type_2 ::= TY_VAR | '(' type ',' type ')' | '(' type ')'
495
496 */
497
490498static void print_type_2(struct type *ty, FILE *fp)
491499{
492500 switch (type_kind(ty)) {
551551 struct typed_term *tt;
552552 struct sym_entry *next;
553553};
554//static const size_t symtab_size = 1024*1024;
554
555555enum { symtab_size = 1024*1024 };
556556static struct sym_entry *symtab[symtab_size];
557557
558/* Caller relinquishes ownership of tt, retains ownership of s, and
559 aquires ownership of the return value. */
560558static struct typed_term *define_symbol(const char *s, struct typed_term *tt)
561559{
562560 size_t hash = hash_string(s) % symtab_size;
587587 return 0;
588588}
589589
590/* Caller retains ownership of s, and does not acquire the return value. */
591590static struct typed_term *lookup_symbol(const char *s)
592591{
593592 size_t hash = hash_string(s) % symtab_size;
600600 HINDLEY-MILNER TYPE INFERENCE
601601***************************************************************************/
602602
603/* Basically, we follow Milner's Algorithm J, with the global
604 substitution being implemented by rewriting all the actual terms.
605 To make the rewriting practical, we are careful to maintain a
606 structure that allows us to easily discover all instances of a
607 given variable in all the existing types. */
608
609/* Generally, functions named with a trailing underscore (such as
610 generalize_) are meant to be helpers, implementing only a part of
611 the functionality of the sans-undersecore function. It is usually
612 a good idea not to call them directly. */
613
603614static void generalize_(struct type *ty)
604615{
605616 if (type_kind(ty) == TY_VAR && !ty_var_get_poly(ty)) {
631631 for_every_component_type(ty, clear_polyvar_redir_);
632632}
633633
634/* Do not call this directly; use instantiate_type instead. */
635634static struct type *instantiate_type_(struct type *ty)
636635{
637636 switch (type_kind(ty)) {
10661066 enum type_kind kind;
10671067 union {
10681068 struct {
1069 char *name;
1069 char *name; /* The name of a type variable is
1070 chosen the first time it is
1071 requested. It is used solely
1072 for pretty-printing and is
1073 ignored otherwise. */
10701074 struct type *redir;
10711075 struct type *alias; /* A circular list (ring)
10721076 of aliases of this