Domain aliases support for Apache

[hcoop/domtool2.git] / src / domtool.lex

(* HCoop Domtool (http://hcoop.sourceforge.net/)
 * Copyright (c) 2006, Adam Chlipala
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License
 * as published by the Free Software Foundation; either version 2
 * of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 *)

(* Lexer for Domtool configuration files *)

type pos = int
type svalue = Tokens.svalue
type ('a,'b) token = ('a,'b) Tokens.token
type lexresult = (svalue,pos) Tokens.token

val lineNum = ErrorMsg.lineNum
val linePos = ErrorMsg.linePos

local
  val commentLevel = ref 0
  val commentPos = ref 0
in
  fun enterComment yypos = (commentLevel := !commentLevel + 1; commentPos := yypos)
    
  fun exitComment () =
   let val _ = commentLevel := !commentLevel - 1 in
     !commentLevel = 0
   end

  fun eof () = 
    let 
      val pos = hd (!linePos)
    in
      if (!commentLevel > 0) then
          (ErrorMsg.error (SOME (!commentPos,!commentPos)) "Unterminated comment")
      else ();
      Tokens.EOF (pos,pos) 
    end
end

val str = ref ([] : char list)
val strStart = ref 0

%%
%header (functor DomtoolLexFn(structure Tokens : Domtool_TOKENS));
%full
%s COMMENT STRING DOC;

id = [a-z_][A-Za-z0-9_]*;
cid = [A-Z][A-Za-z0-9_]*;
intconst = [0-9]+;
ws = [\ \t\012];
lineComment = #[^\n]*\n;

%%

<INITIAL> \n          => (lineNum := !lineNum + 1;
                          linePos := yypos :: ! linePos;
                          continue ());
<COMMENT> \n          => (lineNum := !lineNum + 1;
                          linePos := yypos :: ! linePos;
                          continue ());

<INITIAL> {ws}+       => (lex ());

<INITIAL> lineComment => (lex ());

<INITIAL> "(*"        => (YYBEGIN COMMENT; enterComment yypos; continue());
<INITIAL> "*)"        => (ErrorMsg.error (SOME (yypos, yypos)) "Unbalanced comments";
			  continue());

<COMMENT> "(*"        => (enterComment yypos; continue());
<COMMENT> "*)"        => (if exitComment () then YYBEGIN INITIAL else ();
			  continue());

<INITIAL> "\""        => (YYBEGIN STRING; strStart := yypos; str := []; continue());
<STRING> "\\\""       => (str := #"\"" :: !str; continue());
<STRING> "\""         => (YYBEGIN INITIAL;
			  Tokens.STRING (String.implode (List.rev (!str)), !strStart, yypos + 1));
<STRING> "\n"         => (lineNum := !lineNum + 1;
			  linePos := yypos :: ! linePos;
			  str := #"\n" :: !str; continue());
<STRING> .            => (str := String.sub (yytext, 0) :: !str; continue());

<INITIAL> "{{"        => (YYBEGIN DOC; strStart := yypos; str := []; continue());
<DOC> "}}"            => (YYBEGIN INITIAL;
			  Tokens.DOC (String.implode (List.rev (!str)), !strStart, yypos + 1));
<DOC> "\n"            => (lineNum := !lineNum + 1;
			  linePos := yypos :: ! linePos;
			  str := #"\n" :: !str; continue());
<DOC> .               => (str := String.sub (yytext, 0) :: !str; continue());

<INITIAL> "("         => (Tokens.LPAREN (yypos, yypos + size yytext));
<INITIAL> ")"         => (Tokens.RPAREN (yypos, yypos + size yytext));

<INITIAL> "["         => (Tokens.LBRACK (yypos, yypos + size yytext));
<INITIAL> "]"         => (Tokens.RBRACK (yypos, yypos + size yytext));

<INITIAL> "{"         => (Tokens.LBRACE (yypos, yypos + size yytext));
<INITIAL> "}"         => (Tokens.RBRACE (yypos, yypos + size yytext));

<INITIAL> "->"        => (Tokens.ARROW (yypos, yypos + size yytext));
<INITIAL> "=>"        => (Tokens.DARROW (yypos, yypos + size yytext));
<INITIAL> "<-"        => (Tokens.LARROW (yypos, yypos + size yytext));

<INITIAL> "="         => (Tokens.EQ (yypos, yypos + size yytext));
<INITIAL> ","         => (Tokens.COMMA (yypos, yypos + size yytext));
<INITIAL> "\\\\"      => (Tokens.BSLASHBSLASH (yypos, yypos + size yytext));
<INITIAL> "\\"        => (Tokens.BSLASH (yypos, yypos + size yytext));
<INITIAL> ":"         => (Tokens.COLON (yypos, yypos + size yytext));
<INITIAL> ";"         => (Tokens.SEMI (yypos, yypos + size yytext));
<INITIAL> "^"         => (Tokens.CARET (yypos, yypos + size yytext));
<INITIAL> "!"         => (Tokens.BANG (yypos, yypos + size yytext));
<INITIAL> "&"         => (Tokens.AND (yypos, yypos + size yytext));

<INITIAL> "let"       => (Tokens.LET (yypos, yypos + size yytext));
<INITIAL> "in"        => (Tokens.IN (yypos, yypos + size yytext));
<INITIAL> "end"       => (Tokens.END (yypos, yypos + size yytext));
<INITIAL> "with"      => (Tokens.WITH (yypos, yypos + size yytext));
<INITIAL> "where"     => (Tokens.WHERE (yypos, yypos + size yytext));

<INITIAL> "extern"    => (Tokens.EXTERN (yypos, yypos + size yytext));
<INITIAL> "type"      => (Tokens.TYPE (yypos, yypos + size yytext));
<INITIAL> "val"       => (Tokens.VAL (yypos, yypos + size yytext));
<INITIAL> "context"   => (Tokens.CONTEXT (yypos, yypos + size yytext));

<INITIAL> "Root"      => (Tokens.ROOT (yypos, yypos + size yytext));

<INITIAL> {id}        => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext));
<INITIAL> {cid}       => (Tokens.CSYMBOL (yytext, yypos, yypos + size yytext));
<INITIAL> {intconst}  => (case Int.fromString yytext of
                            SOME x => Tokens.INT (x, yypos, yypos + size yytext)
                          | NONE   => (ErrorMsg.error (SOME (yypos, yypos))
                                       ("Expected int, received: " ^ yytext);
                                       continue ()));

<COMMENT> .           => (continue());

<INITIAL> .           => (ErrorMsg.error (SOME (yypos,yypos))
                          ("illegal character: \"" ^ yytext ^ "\"");
                          continue ());