src/lexer.mll

   1 (* Goalfile lexer
   2  * Copyright (C) 2019 Richard W.M. Jones
   3  * Copyright (C) 2019 Red Hat Inc.
   4  *
   5  * This program is free software; you can redistribute it and/or modify
   6  * it under the terms of the GNU General Public License as published by
   7  * the Free Software Foundation; either version 2 of the License, or
   8  * (at your option) any later version.
   9  *
  10  * This program is distributed in the hope that it will be useful,
  11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13  * GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License along
  16  * with this program; if not, write to the Free Software Foundation, Inc.,
  17  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  18  *)
  19
  20 {
  21 open Lexing
  22 open Parser
  23
  24 open Printf
  25
  26 exception SyntaxError of string
  27
  28 let new_line lexbuf =
  29   let pos = lexbuf.lex_curr_p in
  30   lexbuf.lex_curr_p <-
  31     { pos with pos_bol = pos.pos_cnum; pos_lnum = pos.pos_lnum + 1 }
  32 }
  33
  34 let white = [' ' '\t']+
  35 let newline = '\r' | '\n' | "\r\n"
  36 let comment = '#' (_#'\n')*
  37 let id = ['a'-'z' 'A'-'Z' '_'] ['a'-'z' 'A'-'Z' '0'-'9' '_' '-']*
  38
  39 rule read =
  40     parse
  41     | white
  42     | comment { read lexbuf }
  43     | newline { new_line lexbuf; read lexbuf }
  44     | ","     { COMMA }
  45     | ":"     { COLON }
  46     | ";"     { SEMICOLON }
  47     | "="     { EQUALS }
  48     | "("     { LEFT_PAREN }
  49     | ")"     { RIGHT_PAREN }
  50     | "["     { LEFT_ARRAY }
  51     | "]"     { RIGHT_ARRAY }
  52     | '"'     { read_string (Ast.Substs.create ()) lexbuf }
  53     | "{"     { read_code false (Ast.Substs.create ()) (ref 1) lexbuf }
  54     | "@{"    { read_code true  (Ast.Substs.create ()) (ref 1) lexbuf }
  55     | "goal"  { GOAL }
  56     | "predicate"
  57               { PREDICATE }
  58     | "function"
  59               { FUNCTION }
  60     | "pure"  { PURE }
  61     | "let"   { LET }
  62     | "include"
  63               { INCLUDE }
  64     | "-include"
  65               { OPTINCLUDE }
  66     | "returning"
  67               { RETURNING }
  68     | "expression"
  69               { EXPRESSION }
  70     | "string"
  71               { STRING_KEYWORD }
  72     | "strings"
  73               { STRINGS }
  74     | "is-" id
  75               { (* NB: The initial 'is-' is part of the name. *)
  76                 PRED (Lexing.lexeme lexbuf) }
  77     | id      { ID (Lexing.lexeme lexbuf) }
  78     | _       { raise (SyntaxError ("unexpected character: " ^
  79                                     Lexing.lexeme lexbuf)) }
  80     | eof     { EOF }
  81
  82 (* Parse "STRING" literal with %-substitutions. *)
  83 and read_string buf =
  84     parse
  85     | '\\' '"'
  86               { Ast.Substs.add_char buf '"'; read_string buf lexbuf }
  87     | '\\' 'a'
  88               { Ast.Substs.add_char buf '\007'; read_string buf lexbuf }
  89     | '\\' 'b'
  90               { Ast.Substs.add_char buf '\008'; read_string buf lexbuf }
  91     | '\\' 't'
  92               { Ast.Substs.add_char buf '\009'; read_string buf lexbuf }
  93     | '\\' 'n'
  94               { Ast.Substs.add_char buf '\010'; read_string buf lexbuf }
  95     | '\\' 'v'
  96               { Ast.Substs.add_char buf '\011'; read_string buf lexbuf }
  97     | '\\' 'f'
  98               { Ast.Substs.add_char buf '\012'; read_string buf lexbuf }
  99     | '\\' 'r'
 100               { Ast.Substs.add_char buf '\013'; read_string buf lexbuf }
 101     | '\\' '\\'
 102               { Ast.Substs.add_char buf '\\'; read_string buf lexbuf }
 103     | '"'     { STRING (Ast.Substs.get buf) }
 104     | newline { Ast.Substs.add_char buf '\n';
 105                 new_line lexbuf; read_string buf lexbuf }
 106     | '%' '%' { Ast.Substs.add_char buf '%'; read_string buf lexbuf }
 107     | '%' id  { let id = Lexing.lexeme lexbuf in
 108                 let len = String.length id in
 109                 Ast.Substs.add_var buf (String.sub id 1 (len-1));
 110                 read_string buf lexbuf }
 111     | '%' _   { raise (SyntaxError ("illegal character in %-substitution: " ^
 112                                     Lexing.lexeme lexbuf)) }
 113     | [^ '"' '\\' '\r' '\n' '%' ]+
 114               { Ast.Substs.add_string buf (Lexing.lexeme lexbuf);
 115                 read_string buf lexbuf }
 116     | _       { raise (SyntaxError ("illegal character in string: " ^
 117                                       Lexing.lexeme lexbuf)) }
 118     | eof     { raise (SyntaxError ("unterminated string")) }
 119
 120 (* Parse { CODE } literal with %-substitutions.
 121  *
 122  * Note the range of %-substitutions possible is larger than
 123  * for strings.
 124  *)
 125 and read_code quiet buf level =
 126     parse
 127     | '{'     { Ast.Substs.add_char buf '{';
 128                 incr level; read_code quiet buf level lexbuf }
 129     | '}'     { decr level;
 130                 if !level = 0 then CODE (Ast.Substs.get buf, quiet)
 131                 else (
 132                   Ast.Substs.add_char buf '}';
 133                   read_code quiet buf level lexbuf
 134                 ) }
 135     | newline { Ast.Substs.add_char buf '\n';
 136                 new_line lexbuf; read_code quiet buf level lexbuf }
 137     | '%' '%' { Ast.Substs.add_char buf '%'; read_code quiet buf level lexbuf }
 138     | '%' '@' { Ast.Substs.add_var buf "@"; read_code quiet buf level lexbuf }
 139     | '%' '<' { Ast.Substs.add_var buf "<"; read_code quiet buf level lexbuf }
 140     | '%' '^' { Ast.Substs.add_var buf "^"; read_code quiet buf level lexbuf }
 141     | '%' id  { let id = Lexing.lexeme lexbuf in
 142                 let len = String.length id in
 143                 Ast.Substs.add_var buf (String.sub id 1 (len-1));
 144                 read_code quiet buf level lexbuf }
 145     | '%' _   { raise (SyntaxError ("illegal character in %-substitution: " ^
 146                                       Lexing.lexeme lexbuf)) }
 147     | [^ '{' '}' '\r' '\n' '%' ]+
 148               { Ast.Substs.add_string buf (Lexing.lexeme lexbuf);
 149                 read_code quiet buf level lexbuf }
 150     | _       { raise (SyntaxError ("illegal character in code section: " ^
 151                                       Lexing.lexeme lexbuf)) }
 152     | eof     { raise (SyntaxError ("unterminated code section")) }