src/parser.y

   1 %{
   2
   3 #include <config.h>
   4
   5 #include "internal.h"
   6 #include "syntax.h"
   7 #include "list.h"
   8 #include "errcode.h"
   9 #include <stdio.h>
  10
  11 /* Work around a problem on FreeBSD where Bison looks for _STDLIB_H
  12  * to see if stdlib.h has been included, but the system includes
  13  * use _STDLIB_H_
  14  */
  15 #if HAVE_STDLIB_H && ! defined _STDLIB_H
  16 #  include <stdlib.h>
  17 #  define _STDLIB_H 1
  18 #endif
  19
  20 #define YYDEBUG 1
  21
  22 int augl_parse_file(struct augeas *aug, const char *name, struct term **term);
  23
  24 typedef void *yyscan_t;
  25 typedef struct info YYLTYPE;
  26 #define YYLTYPE_IS_DECLARED 1
  27 /* The lack of reference counting on filename is intentional */
  28 # define YYLLOC_DEFAULT(Current, Rhs, N)                                \
  29   do {                                                                  \
  30     (Current).filename = augl_get_info(scanner)->filename;              \
  31     (Current).error = augl_get_info(scanner)->error;                    \
  32     if (N) {                                                            \
  33         (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;          \
  34         (Current).first_column = YYRHSLOC (Rhs, 1).first_column;        \
  35         (Current).last_line    = YYRHSLOC (Rhs, N).last_line;           \
  36         (Current).last_column  = YYRHSLOC (Rhs, N).last_column;         \
  37     } else {                                                            \
  38       (Current).first_line   = (Current).last_line   =                  \
  39             YYRHSLOC (Rhs, 0).last_line;                                    \
  40           (Current).first_column = (Current).last_column =                  \
  41             YYRHSLOC (Rhs, 0).last_column;                                  \
  42     }                                                                   \
  43   } while (0)
  44 %}
  45
  46 %code provides {
  47 #include "info.h"
  48
  49 /* Track custom scanner state */
  50 struct state {
  51   struct info *info;
  52   unsigned int comment_depth;
  53 };
  54
  55 }
  56
  57 %locations
  58 %error-verbose
  59 %name-prefix "augl_"
  60 %defines
  61 %pure-parser
  62 %parse-param    {struct term **term}
  63 %parse-param    {yyscan_t scanner}
  64 %lex-param      {yyscan_t scanner}
  65
  66 %initial-action {
  67   @$.first_line   = 1;
  68   @$.first_column = 0;
  69   @$.last_line    = 1;
  70   @$.last_column  = 0;
  71   @$.filename     = augl_get_info(scanner)->filename;
  72   @$.error        = augl_get_info(scanner)->error;
  73 };
  74
  75 %token <string> DQUOTED   /* "foo" */
  76 %token <regexp> REGEXP    /* /[ \t]+/ */
  77 %token <string> LIDENT UIDENT QIDENT
  78 %token          ARROW
  79
  80 /* Keywords */
  81 %token          KW_MODULE
  82 %token          KW_AUTOLOAD
  83 %token          KW_LET KW_LET_REC KW_IN
  84 %token          KW_STRING
  85 %token          KW_REGEXP
  86 %token          KW_LENS
  87 %token          KW_TEST KW_GET KW_PUT KW_AFTER
  88
  89 %union {
  90   struct term    *term;
  91   struct type    *type;
  92   struct ident   *ident;
  93   struct tree    *tree;
  94   char           *string;
  95   struct {
  96     int             nocase;
  97     char           *pattern;
  98   } regexp;
  99   int            intval;
 100   enum quant_tag quant;
 101 }
 102
 103 %type<term>   start decls
 104 %type<term>   exp composeexp unionexp minusexp catexp appexp rexp aexp
 105 %type<term>   param param_list
 106 %type<string> qid id autoload
 107 %type<type>  type atype
 108 %type<quant> rep
 109 %type<term>  test_exp
 110 %type<intval> test_special_res
 111 %type<tree>  tree_const tree_const2 tree_branch
 112 %type<string> tree_label
 113
 114 %{
 115 /* Lexer */
 116 extern int augl_lex (YYSTYPE * yylval_param,struct info * yylloc_param ,yyscan_t yyscanner);
 117 int augl_init_lexer(struct state *state, yyscan_t * scanner);
 118 void augl_close_lexer(yyscan_t *scanner);
 119 int augl_lex_destroy (yyscan_t yyscanner );
 120 int augl_get_lineno (yyscan_t yyscanner );
 121 int augl_get_column  (yyscan_t yyscanner);
 122 struct info *augl_get_info(yyscan_t yyscanner);
 123 char *augl_get_text (yyscan_t yyscanner );
 124
 125 static void augl_error(struct info *locp, struct term **term,
 126                        yyscan_t scanner, const char *s);
 127
 128 /* TERM construction */
 129  static struct info *clone_info(struct info *locp);
 130  static struct term *make_module(char *ident, char *autoload,
 131                                  struct term *decls,
 132                                  struct info *locp);
 133
 134  static struct term *make_bind(char *ident, struct term *params,
 135                              struct term *exp, struct term *decls,
 136                              struct info *locp);
 137  static struct term *make_bind_rec(char *ident, struct term *exp,
 138                                    struct term *decls, struct info *locp);
 139  static struct term *make_let(char *ident, struct term *params,
 140                               struct term *exp, struct term *body,
 141                               struct info *locp);
 142  static struct term *make_binop(enum term_tag tag,
 143                                struct term *left, struct term *right,
 144                                struct info *locp);
 145  static struct term *make_unop(enum term_tag tag,
 146                               struct term *exp, struct info *locp);
 147  static struct term *make_ident(char *qname, struct info *locp);
 148  static struct term *make_unit_term(struct info *locp);
 149  static struct term *make_string_term(char *value, struct info *locp);
 150  static struct term *make_regexp_term(char *pattern,
 151                                       int nocase, struct info *locp);
 152  static struct term *make_rep(struct term *exp, enum quant_tag quant,
 153                              struct info *locp);
 154
 155  static struct term *make_get_test(struct term *lens, struct term *arg,
 156                                    struct info *info);
 157  static struct term *make_put_test(struct term *lens, struct term *arg,
 158                                    struct term *cmds, struct info *info);
 159  static struct term *make_test(struct term *test, struct term *result,
 160                                enum test_result_tag tr_tag,
 161                                struct term *decls, struct info *locp);
 162  static struct term *make_tree_value(struct tree *, struct info*);
 163  static struct tree *tree_concat(struct tree *, struct tree *);
 164
 165 #define LOC_MERGE(a, b, c)                                              \
 166  do {                                                                   \
 167    (a).filename     = (b).filename;                                     \
 168    (a).first_line   = (b).first_line;                                   \
 169    (a).first_column = (b).first_column;                                 \
 170    (a).last_line    = (c).last_line;                                    \
 171    (a).last_column  = (c).last_column;                                  \
 172    (a).error        = (b).error;                                        \
 173  } while(0);
 174
 175 %}
 176
 177 %%
 178
 179 start: KW_MODULE UIDENT '=' autoload decls
 180        { (*term) = make_module($2, $4, $5, &@1); }
 181
 182 autoload: KW_AUTOLOAD LIDENT
 183           { $$ = $2; }
 184         | /* empty */
 185           { $$ = NULL; }
 186
 187 decls: KW_LET LIDENT param_list '=' exp decls
 188        {
 189          LOC_MERGE(@1, @1, @5);
 190          $$ = make_bind($2, $3, $5, $6, &@1);
 191        }
 192      | KW_LET_REC LIDENT '=' exp decls
 193        {
 194          LOC_MERGE(@1, @1, @4);
 195          $$ = make_bind_rec($2, $4, $5, &@1);
 196        }
 197      | KW_TEST test_exp '=' exp decls
 198        {
 199          LOC_MERGE(@1, @1, @4);
 200          $$ = make_test($2, $4, TR_CHECK, $5, &@1);
 201        }
 202      | KW_TEST test_exp '=' test_special_res decls
 203        {
 204          LOC_MERGE(@1, @1, @4);
 205          $$ = make_test($2, NULL, $4, $5, &@1);
 206        }
 207      | /* epsilon */
 208        { $$ = NULL; }
 209
 210 /* Test expressions and results */
 211
 212 test_exp: aexp KW_GET exp
 213           { $$ = make_get_test($1, $3, &@$); }
 214         | aexp KW_PUT aexp KW_AFTER exp
 215           { $$ = make_put_test($1, $3, $5, &@$); }
 216
 217 test_special_res: '?'
 218                   { $$ = TR_PRINT; }
 219                 | '*'
 220                   { $$ = TR_EXN; }
 221
 222 /* General expressions */
 223 exp: KW_LET LIDENT param_list '=' exp KW_IN  exp
 224      {
 225        LOC_MERGE(@1, @1, @6);
 226        $$ = make_let($2, $3, $5, $7, &@1);
 227      }
 228    | composeexp
 229
 230 composeexp: composeexp ';' unionexp
 231      { $$ = make_binop(A_COMPOSE, $1, $3, &@$); }
 232    | unionexp
 233      { $$ = $1; }
 234
 235 unionexp: unionexp '|' minusexp
 236      { $$ = make_binop(A_UNION, $1, $3, &@$); }
 237    | minusexp
 238      { $$ = $1; }
 239    | tree_const
 240      { $$ = make_tree_value($1, &@1); }
 241
 242 minusexp: minusexp '-' catexp
 243      { $$ = make_binop(A_MINUS, $1, $3, &@$); }
 244    | catexp
 245      { $$ = $1; }
 246
 247 catexp: catexp '.' appexp
 248 { $$ = make_binop(A_CONCAT, $1, $3, &@$); }
 249       | appexp
 250 { $$ = $1; }
 251
 252 appexp: appexp rexp
 253         { $$ = make_binop(A_APP, $1, $2, &@$); }
 254       | rexp
 255         { $$ = $1; }
 256
 257 aexp: qid
 258       { $$ = make_ident($1, &@1); }
 259     | DQUOTED
 260       { $$ = make_string_term($1, &@1); }
 261     | REGEXP
 262       { $$ = make_regexp_term($1.pattern, $1.nocase, &@1); }
 263     | '(' exp ')'
 264       { $$ = $2; }
 265     | '[' exp ']'
 266       { $$ = make_unop(A_BRACKET, $2, &@$); }
 267     | '(' ')'
 268       { $$ = make_unit_term(&@$); }
 269
 270 rexp: aexp rep
 271       { $$ = make_rep($1, $2, &@$); }
 272     | aexp
 273       { $$ = $1; }
 274
 275 rep: '*'
 276      { $$ = Q_STAR; }
 277    | '+'
 278      { $$ = Q_PLUS; }
 279    | '?'
 280      { $$ = Q_MAYBE; }
 281
 282 qid: LIDENT
 283      { $$ = $1; }
 284    | QIDENT
 285      { $$ = $1; }
 286    | KW_GET
 287      { $$ = strdup("get"); }
 288    | KW_PUT
 289      { $$ = strdup("put"); }
 290
 291 param_list: param param_list
 292             { $$ = $2; list_cons($$, $1); }
 293           | /* epsilon */
 294             { $$ = NULL; }
 295
 296 param: '(' id ':' type ')'
 297        { $$ = make_param($2, $4, clone_info(&@1)); }
 298
 299 id: LIDENT
 300     { $$ = $1; }
 301   | KW_GET
 302     { $$ = strdup("get"); }
 303   | KW_PUT
 304     { $$ = strdup("put"); }
 305
 306 type: atype ARROW type
 307       { $$ = make_arrow_type($1, $3); }
 308     | atype
 309       { $$ = $1; }
 310
 311 atype: KW_STRING
 312        { $$ = make_base_type(T_STRING); }
 313      | KW_REGEXP
 314        { $$ = make_base_type(T_REGEXP); }
 315      | KW_LENS
 316        { $$ = make_base_type(T_LENS); }
 317      | '(' type ')'
 318        { $$ = $2; }
 319
 320 tree_const: tree_const '{' tree_branch '}'
 321             { $$ = tree_concat($1, $3); }
 322           | '{' tree_branch '}'
 323             { $$ = tree_concat($2, NULL); }
 324
 325 tree_const2: tree_const2 '{' tree_branch '}'
 326             {
 327               $$ = tree_concat($1, $3);
 328             }
 329           | /* empty */
 330             { $$ = NULL; }
 331
 332 tree_branch: tree_label tree_const2
 333              {
 334                $$ = make_tree($1, NULL, NULL, $2);
 335              }
 336            | tree_label '=' DQUOTED tree_const2
 337              {
 338                $$ = make_tree($1, $3, NULL, $4);
 339              }
 340 tree_label: DQUOTED
 341           | /* empty */
 342             { $$ = NULL; }
 343 %%
 344
 345 int augl_parse_file(struct augeas *aug, const char *name,
 346                     struct term **term) {
 347   yyscan_t          scanner;
 348   struct state      state;
 349   struct string  *sname = NULL;
 350   struct info    info;
 351   int result = -1;
 352   int r;
 353
 354   *term = NULL;
 355
 356   r = make_ref(sname);
 357   ERR_NOMEM(r < 0, aug);
 358
 359   sname->str = strdup(name);
 360   ERR_NOMEM(sname->str == NULL, aug);
 361
 362   MEMZERO(&info, 1);
 363   info.ref = UINT_MAX;
 364   info.filename = sname;
 365   info.error = aug->error;
 366
 367   MEMZERO(&state, 1);
 368   state.info = &info;
 369   state.comment_depth = 0;
 370
 371   if (augl_init_lexer(&state, &scanner) < 0) {
 372     augl_error(&info, term, NULL, "file not found");
 373     goto error;
 374   }
 375
 376   yydebug = getenv("YYDEBUG") != NULL;
 377   r = augl_parse(term, scanner);
 378   augl_close_lexer(scanner);
 379   augl_lex_destroy(scanner);
 380   if (r == 1) {
 381     augl_error(&info, term, NULL, "syntax error");
 382     goto error;
 383   } else if (r == 2) {
 384     augl_error(&info, term, NULL, "parser ran out of memory");
 385     ERR_NOMEM(1, aug);
 386   }
 387   result = 0;
 388
 389  error:
 390   unref(sname, string);
 391   // free TERM
 392   return result;
 393 }
 394
 395 // FIXME: Nothing here checks for alloc errors.
 396 static struct info *clone_info(struct info *locp) {
 397   struct info *info;
 398   make_ref(info);
 399   info->filename     = ref(locp->filename);
 400   info->first_line   = locp->first_line;
 401   info->first_column = locp->first_column;
 402   info->last_line    = locp->last_line;
 403   info->last_column  = locp->last_column;
 404   info->error        = locp->error;
 405   return info;
 406 }
 407
 408 static struct term *make_term_locp(enum term_tag tag, struct info *locp) {
 409   struct info *info = clone_info(locp);
 410   return make_term(tag, info);
 411 }
 412
 413 static struct term *make_module(char *ident, char *autoload,
 414                                 struct term *decls,
 415                                 struct info *locp) {
 416   struct term *term = make_term_locp(A_MODULE, locp);
 417   term->mname = ident;
 418   term->autoload = autoload;
 419   term->decls = decls;
 420   return term;
 421 }
 422
 423 static struct term *make_bind(char *ident, struct term *params,
 424                               struct term *exp, struct term *decls,
 425                               struct info *locp) {
 426   struct term *term = make_term_locp(A_BIND, locp);
 427   if (params != NULL)
 428     exp = build_func(params, exp);
 429
 430   term->bname = ident;
 431   term->exp = exp;
 432   list_cons(decls, term);
 433   return decls;
 434 }
 435
 436 static struct term *make_bind_rec(char *ident, struct term *exp,
 437                                   struct term *decls, struct info *locp) {
 438   /* Desugar let rec IDENT = EXP as
 439    *  let IDENT =
 440    *    let RLENS = (lns_make_rec) in
 441    *    lns_check_rec ((lambda IDENT: EXP) RLENS) RLENS
 442    * where RLENS is a brandnew recursive lens.
 443    *
 444    * That only works since we know that 'let rec' is only defined for lenses,
 445    * not general purposes functions, i.e. we know that IDENT has type 'lens'
 446    *
 447    * The point of all this is that we make it possible to put a recursive
 448    * lens (which is a placeholder for the actual recursion) into arbitrary
 449    * places in some bigger lens and then have LNS_CHECK_REC rattle through
 450    * to do the special-purpose typechecking.
 451    */
 452   char *id;
 453   struct info *info = exp->info;
 454   struct term *lambda = NULL, *rlens = NULL;
 455   struct term *app1 = NULL, *app2 = NULL, *app3 = NULL;
 456
 457   id = strdup(ident);
 458   if (id == NULL) goto error;
 459
 460   lambda = make_param(id, make_base_type(T_LENS), ref(info));
 461   if (lambda == NULL) goto error;
 462   id = NULL;
 463
 464   build_func(lambda, exp);
 465
 466   rlens = make_term(A_VALUE, ref(exp->info));
 467   if (rlens == NULL) goto error;
 468   rlens->value = lns_make_rec(ref(exp->info));
 469   if (rlens->value == NULL) goto error;
 470   rlens->type = make_base_type(T_LENS);
 471
 472   app1 = make_app_term(lambda, rlens, ref(info));
 473   if (app1 == NULL) goto error;
 474
 475   id = strdup(LNS_CHECK_REC_NAME);
 476   if (id == NULL) goto error;
 477   app2 = make_app_ident(id, app1, ref(info));
 478   if (app2 == NULL) goto error;
 479   id = NULL;
 480
 481   app3 = make_app_term(app2, ref(rlens), ref(info));
 482   if (app3 == NULL) goto error;
 483
 484   return make_bind(ident, NULL, app3, decls, locp);
 485
 486  error:
 487   free(id);
 488   unref(lambda, term);
 489   unref(rlens, term);
 490   unref(app1, term);
 491   unref(app2, term);
 492   unref(app3, term);
 493   return NULL;
 494 }
 495
 496 static struct term *make_let(char *ident, struct term *params,
 497                              struct term *exp, struct term *body,
 498                              struct info *locp) {
 499   /* let f (x:string) = "f " . x in
 500      f "a" . f "b" */
 501   /* (lambda f: f "a" . f "b") (lambda x: "f " . x) */
 502   /* (lambda IDENT: BODY) (lambda PARAMS: EXP) */
 503   /* Desugar as (lambda IDENT: BODY) (lambda PARAMS: EXP) */
 504   struct term *term = make_term_locp(A_LET, locp);
 505   struct term *p = make_param(ident, NULL, ref(term->info));
 506   term->left = build_func(p, body);
 507   if (params != NULL)
 508     term->right = build_func(params, exp);
 509   else
 510     term->right = exp;
 511   return term;
 512 }
 513
 514 static struct term *make_binop(enum term_tag tag,
 515                               struct term *left, struct term *right,
 516                               struct info *locp) {
 517   assert(tag == A_COMPOSE || tag == A_CONCAT
 518          || tag == A_UNION || tag == A_APP || tag == A_MINUS);
 519   struct term *term = make_term_locp(tag, locp);
 520   term->left = left;
 521   term->right = right;
 522   return term;
 523 }
 524
 525 static struct term *make_unop(enum term_tag tag, struct term *exp,
 526                              struct info *locp) {
 527   assert(tag == A_BRACKET);
 528   struct term *term = make_term_locp(tag, locp);
 529   term->brexp = exp;
 530   return term;
 531 }
 532
 533 static struct term *make_ident(char *qname, struct info *locp) {
 534   struct term *term = make_term_locp(A_IDENT, locp);
 535   term->ident = make_string(qname);
 536   return term;
 537 }
 538
 539 static struct term *make_unit_term(struct info *locp) {
 540   struct term *term = make_term_locp(A_VALUE, locp);
 541   term->value = make_unit(ref(term->info));
 542   return term;
 543 }
 544
 545 static struct term *make_string_term(char *value, struct info *locp) {
 546   struct term *term = make_term_locp(A_VALUE, locp);
 547   term->value = make_value(V_STRING, ref(term->info));
 548   term->value->string = make_string(value);
 549   return term;
 550 }
 551
 552 static struct term *make_regexp_term(char *pattern, int nocase,
 553                                      struct info *locp) {
 554   struct term *term = make_term_locp(A_VALUE, locp);
 555   term->value = make_value(V_REGEXP, ref(term->info));
 556   term->value->regexp = make_regexp(term->info, pattern, nocase);
 557   return term;
 558 }
 559
 560 static struct term *make_rep(struct term *exp, enum quant_tag quant,
 561                             struct info *locp) {
 562   struct term *term = make_term_locp(A_REP, locp);
 563   term->quant = quant;
 564   term->exp = exp;
 565   return term;
 566 }
 567
 568 static struct term *make_get_test(struct term *lens, struct term *arg,
 569                                   struct info *locp) {
 570   /* Return a term for "get" LENS ARG */
 571   struct info *info = clone_info(locp);
 572   struct term *term = make_app_ident(strdup("get"), lens, info);
 573   term = make_app_term(term, arg, ref(info));
 574   return term;
 575 }
 576
 577 static struct term *make_put_test(struct term *lens, struct term *arg,
 578                                   struct term *cmds, struct info *locp) {
 579   /* Return a term for "put" LENS (CMDS ("get" LENS ARG)) ARG */
 580   struct term *term = make_get_test(lens, arg, locp);
 581   term = make_app_term(cmds, term, ref(term->info));
 582   struct term *put = make_app_ident(strdup("put"), ref(lens), ref(term->info));
 583   put = make_app_term(put, term, ref(term->info));
 584   put = make_app_term(put, ref(arg), ref(term->info));
 585   return put;
 586 }
 587
 588 static struct term *make_test(struct term *test, struct term *result,
 589                               enum test_result_tag tr_tag,
 590                               struct term *decls, struct info *locp) {
 591   struct term *term = make_term_locp(A_TEST, locp);
 592   term->tr_tag = tr_tag;
 593   term->test = test;
 594   term->result = result;
 595   term->next = decls;
 596   return term;
 597 }
 598
 599 static struct term *make_tree_value(struct tree *tree, struct info *locp) {
 600   struct term *term = make_term_locp(A_VALUE, locp);
 601   struct value *value = make_value(V_TREE, ref(term->info));
 602   value->origin = make_tree_origin(tree);
 603   term->value = value;
 604   return term;
 605 }
 606
 607 static struct tree *tree_concat(struct tree *t1, struct tree *t2) {
 608   if (t2 != NULL)
 609     list_append(t1, t2);
 610   return t1;
 611 }
 612
 613 void augl_error(struct info *locp,
 614                 struct term **term,
 615                 yyscan_t scanner,
 616                 const char *s) {
 617   struct info info;
 618   struct string string;
 619   MEMZERO(&info, 1);
 620   info.ref = string.ref = UINT_MAX;
 621   info.filename = &string;
 622
 623   if (locp != NULL) {
 624     info.first_line   = locp->first_line;
 625     info.first_column = locp->first_column;
 626     info.last_line    = locp->last_line;
 627     info.last_column  = locp->last_column;
 628     info.filename->str = locp->filename->str;
 629     info.error = locp->error;
 630   } else if (scanner != NULL) {
 631     info.first_line   = augl_get_lineno(scanner);
 632     info.first_column = augl_get_column(scanner);
 633     info.last_line    = augl_get_lineno(scanner);
 634     info.last_column  = augl_get_column(scanner);
 635     info.filename     = augl_get_info(scanner)->filename;
 636     info.error        = augl_get_info(scanner)->error;
 637   } else if (*term != NULL && (*term)->info != NULL) {
 638     memcpy(&info, (*term)->info, sizeof(info));
 639   } else {
 640     info.first_line = info.last_line = 0;
 641     info.first_column = info.last_column = 0;
 642   }
 643   syntax_error(&info, "%s", s);
 644 }