lambda.y

   1 %define parse.error verbose
   2 %{
   3 #include "lambda.h"
   4 #include "lambda.tab.h"
   5 #include "lambda.yy.h"
   6 #include "mem.h"
   7 #include "print.h"
   8 #include "reduce.h"
   9
  10 struct decllist *decls = NULL;
  11 extern int yylex();
  12
  13 int yydebug=1;
  14 void yyerror(const char *str)
  15 {
  16         fprintf(stderr, "parse error: %s\n", str);
  17 }
  18
  19 int yywrap()
  20 {
  21         struct decllist *t;
  22         while(decls != NULL){
  23                 free(decls->ident);
  24                 lambda_free(decls->value);
  25                 t = decls->next;
  26                 free(decls);
  27                 decls = t;
  28         }
  29         return 1;
  30 }
  31
  32 struct lambda *make_lambda()
  33 {
  34         struct lambda *t = malloc(sizeof (struct lambda));
  35         t->refcount = 1;
  36         return t;
  37 }
  38
  39 struct lambda *make_ident(char *i)
  40 {
  41         struct lambda *r = make_lambda();
  42         r->which = lambda_ident;
  43         r->data.identifier.ident = strdup(i);
  44         r->data.identifier.binding = NULL;
  45         return r;
  46 }
  47
  48 void lambda_bind(struct lambda *tob, struct lambda *binding, char *ident)
  49 {
  50         switch(tob->which){
  51         case lambda_ident:
  52                 if(strcmp(ident, tob->data.identifier.ident) == 0 && tob->data.identifier.binding == NULL)
  53                         tob->data.identifier.binding = binding;
  54                 break;
  55         case lambda_abs:
  56                 lambda_bind(tob->data.abstraction.expr, binding, ident);
  57                 break;
  58         case lambda_app:
  59                 lambda_bind(tob->data.application.expr1, binding, ident);
  60                 lambda_bind(tob->data.application.expr2, binding, ident);
  61                 break;
  62         }
  63 }
  64
  65 struct lambda *make_abstraction(char *i, bool strict, struct lambda *t)
  66 {
  67         struct lambda *r = make_lambda();
  68         r->which = lambda_abs;
  69         r->data.abstraction.ident = strdup(i);
  70         r->data.abstraction.strict = strict;
  71         r->data.abstraction.expr = t;
  72         lambda_bind(t, r, i);
  73         return r;
  74 }
  75
  76 struct lambda *make_application(struct lambda *t1, struct lambda *t2)
  77 {
  78         struct lambda *r = make_lambda();
  79         r->which = lambda_app;
  80         r->data.application.expr1 = t1;
  81         r->data.application.expr2 = t2;
  82         return r;
  83 }
  84
  85 struct lambda *make_numeral(unsigned int i)
  86 {
  87         struct lambda *body = make_ident("x");
  88         while(i-- > 0)
  89                 body = make_application(make_ident("f"), body);
  90         return make_abstraction("f", false, make_abstraction("x", false, body));
  91 }
  92
  93 struct lambda *make_bool(bool b)
  94 {
  95         return b
  96                 ? make_abstraction("a", false, make_abstraction("b", false, make_ident("a")))
  97                 : make_abstraction("a", false, make_abstraction("b", false, make_ident("b")));
  98 }
  99
 100 void decls_prepend(char *ident, struct lambda *value)
 101 {
 102         struct decllist *head = malloc(sizeof (struct decllist));
 103         head->next = decls;
 104         head->ident = strdup(ident);
 105         head->value = value;
 106         decls = head;
 107 }
 108
 109 struct lambda *decls_lookup(char *ident)
 110 {
 111         struct decllist *c = decls;
 112         while(c != NULL){
 113                 if(strcmp(c->ident, ident) == 0)
 114                         return copy(c->value);
 115                 c = c->next;
 116         }
 117         return make_ident(ident);
 118 }
 119
 120 int main()
 121 {
 122         setbuf(stdout, NULL);
 123         int r = yyparse();
 124         yylex_destroy();
 125         return r;
 126 }
 127
 128 %}
 129
 130 %token LAMBDA DOT OBRACE CBRACE IDENT FUNC SEMICOLON ASSIGN LITERAL BANG
 131
 132 %%
 133
 134 program
 135         :
 136         | lambda SEMICOLON program
 137 lambda
 138         : FUNC func
 139                 {
 140                         decls_prepend($1->data.identifier.ident, $2);
 141                         printf("%s = ", $1->data.identifier.ident);
 142                         lambda_print($2, NULL);
 143                         putchar('\n');
 144                         lambda_free($1);
 145                 }
 146         | term
 147                 {
 148                         struct lambda *t = $1;
 149                         printf("     ");
 150                         for(unsigned int i = 0; i<999; i++)
 151                                 if(!lambda_reduce(&t, &t, false))
 152                                         break;
 153                         lambda_print(t, NULL);
 154                         putchar('\n');
 155                         lambda_free(t);
 156                 }
 157 func
 158         : ASSIGN term
 159                 { $$ = $2; }
 160         | BANG IDENT func
 161                 {
 162                         $$ = make_abstraction($2->data.identifier.ident, true, $3);
 163                         lambda_free($2);
 164                 }
 165         | IDENT func
 166                 {
 167                         $$ = make_abstraction($1->data.identifier.ident, false, $2);
 168                         lambda_free($1);
 169                 }
 170 term
 171         : term appterm
 172                 { $$ = make_application($1, $2); }
 173         | appterm
 174                 { $$ = $1; }
 175 appterm
 176         : LITERAL
 177                 { $$ = $1; }
 178         | FUNC
 179                 {
 180                         $$ = decls_lookup($1->data.identifier.ident);
 181                         lambda_free($1);
 182                 }
 183         | IDENT
 184                 { $$ = $1; }
 185         | LAMBDA abstraction
 186                 { $$ = $2; }
 187         | OBRACE term CBRACE
 188                 { $$ = $2; }
 189 abstraction
 190         : BANG IDENT abstraction
 191                 {
 192                         $$ = make_abstraction($2->data.identifier.ident, true, $3);
 193                         lambda_free($2);
 194                 }
 195         | IDENT abstraction
 196                 {
 197                         $$ = make_abstraction($1->data.identifier.ident, false, $2);
 198                         lambda_free($1);
 199                 }
 200         | DOT term
 201                 { $$ = $2; }