1 files changed, 270 insertions, 0 deletions
diff --git a/nim/ptmplsyn.pas b/nim/ptmplsyn.pas
new file mode 100644
index 000000000..2368b22c7
--- /dev/null
+++ b/nim/ptmplsyn.pas
@@ -0,0 +1,270 @@
+//
+//
+//           The Nimrod Compiler
+//        (c) Copyright 2008 Andreas Rumpf
+//
+//    See the file "copying.txt", included in this
+//    distribution, for details about the copyright.
+//
+unit ptmplsyn;
+
+// This module implements the parser of the Nimrod Template files.
+
+{$include config.inc}
+
+interface
+
+uses
+  nsystem, llstream, nos, charsets, wordrecg, strutils,
+  ast, astalgo, msgs, options, pnimsyn;
+
+function ParseTmplFile(const filename: string): PNode;
+
+
+type
+  TParseState = (psDirective, psMultiDir, psTempl);
+  TTmplParser = record
+    inp: PLLStream;
+    state: TParseState;
+    info: TLineInfo;
+    indent, par: int;
+    x: string; // the current input line
+    outp: PLLStream; // the ouput will be parsed by pnimsyn
+    subsChar: Char;
+  end;
+
+function ParseTmpl(var p: TTmplParser): PNode;
+
+procedure openTmplParser(var p: TTmplParser; const filename: string;
+                         inputStream: PLLStream);
+procedure closeTmplParser(var p: TTmplParser);
+
+implementation
+
+const
+  NimDirective = '#';
+  PatternChars = ['a'..'z', 'A'..'Z', '0'..'9', #128..#255, '.', '_'];
+
+procedure newLine(var p: TTmplParser);
+begin
+  LLStreamWrite(p.outp, repeatChar(p.par, ')'));
+  p.par := 0;
+  if p.info.line > int16(1) then LLStreamWrite(p.outp, nl);
+end;
+
+procedure parseLine(var p: TTmplParser);
+var
+  d, j, curly: int;
+  keyw: string;
+begin
+  j := strStart;
+  while p.x[j] = ' ' do inc(j);
+  if p.state = psMultiDir then begin
+    newLine(p);
+    if p.x[j] = '*' then begin
+      inc(j);
+      if p.x[j] = NimDirective then p.state := psTempl;
+      // ignore the rest of the line
+    end
+    else
+      LLStreamWrite(p.outp, p.x); // simply add the whole line
+  end
+  else if p.x[j] = NimDirective then begin
+    newLine(p);
+    inc(j);
+    while p.x[j] = ' ' do inc(j);
+    d := j;
+    if p.x[j] = '*' then begin
+      inc(j);
+      p.state := psMultiDir;
+      LLStreamWrite(p.outp, repeatChar(p.indent));
+      LLStreamWrite(p.outp, '#*');
+      LLStreamWrite(p.outp, ncopy(p.x, j)); // simply add the whole line
+    end
+    else begin
+      keyw := '';
+      while p.x[j] in PatternChars do begin
+        addChar(keyw, p.x[j]);
+        inc(j);
+      end;
+      case whichKeyword(keyw) of
+        wEnd: begin
+          if p.indent >= 2 then
+            dec(p.indent, 2)
+          else begin
+            p.info.col := int16(j);
+            liMessage(p.info, errXNotAllowedHere, 'end');
+          end;
+          LLStreamWrite(p.outp, repeatChar(p.indent));
+          LLStreamWrite(p.outp, '#end');
+        end;
+        wSubsChar: begin
+          LLStreamWrite(p.outp, repeatChar(p.indent));
+          LLStreamWrite(p.outp, '#subschar');
+          while p.x[j] = ' ' do inc(j);
+          if p.x[j] in ['+', '-', '*', '/', '<', '>', '!', '?', '^', '.',
+                 '|', '=', '%', '&', '$', '@', '~'] then p.subsChar := p.x[j]
+          else begin
+            p.info.col := int16(j);
+            liMessage(p.info, errXNotAllowedHere, p.x[j]+'');
+          end
+        end;
+        wIf, wWhen, wTry, wWhile, wFor, wBlock, wCase, wProc, wIterator,
+        wConverter, wMacro, wTemplate: begin
+          LLStreamWrite(p.outp, repeatChar(p.indent));
+          LLStreamWrite(p.outp, ncopy(p.x, d));
+          inc(p.indent, 2);
+        end;
+        wElif, wOf, wElse, wExcept, wFinally: begin
+          LLStreamWrite(p.outp, repeatChar(p.indent-2));
+          LLStreamWrite(p.outp, ncopy(p.x, d));
+        end
+        else begin
+          LLStreamWrite(p.outp, repeatChar(p.indent));
+          LLStreamWrite(p.outp, ncopy(p.x, d));
+        end
+      end;
+      p.state := psDirective;
+    end
+  end
+  else begin
+    // data line
+    j := strStart;
+    case p.state of
+      psTempl: begin
+        // next line of string literal:
+        LLStreamWrite(p.outp, ' &'+nl);
+        LLStreamWrite(p.outp, repeatChar(p.indent + 2));
+        LLStreamWrite(p.outp, '"'+'');
+      end;
+      psDirective: begin
+        newLine(p);
+        LLStreamWrite(p.outp, repeatChar(p.indent));
+        LLStreamWrite(p.outp, 'add(result, "');
+        inc(p.par);
+      end;
+      else InternalError(p.info, 'parser in invalid state');
+    end;
+    p.state := psTempl;
+    while true do begin
+      case p.x[j] of
+        #0: break;
+        #1..#31, #128..#255: begin
+          LLStreamWrite(p.outp, '\x');
+          LLStreamWrite(p.outp, toHex(ord(p.x[j]), 2));
+          inc(j);
+        end;
+        '\': begin LLStreamWrite(p.outp, '\\'); inc(j); end;
+        '''': begin LLStreamWrite(p.outp, '\'''); inc(j); end;
+        '"': begin LLStreamWrite(p.outp, '\"'); inc(j); end;
+        else if p.x[j] = p.subsChar then begin // parse Nimrod expression:
+          inc(j);
+          case p.x[j] of
+            '{': begin
+              p.info.col := int16(j);
+              LLStreamWrite(p.outp, '" & $(');
+              inc(j);
+              curly := 0;
+              while true do begin
+                case p.x[j] of
+                  #0: liMessage(p.info, errXExpected, '}'+'');
+                  '{': begin
+                    inc(j);
+                    inc(curly);
+                    LLStreamWrite(p.outp, '{'+'');
+                  end;
+                  '}': begin
+                    inc(j);
+                    if curly = 0 then break;
+                    if curly > 0 then dec(curly);
+                    LLStreamWrite(p.outp, '}'+'');
+                  end;
+                  else begin
+                    LLStreamWrite(p.outp, p.x[j]);
+                    inc(j)
+                  end
+                end
+              end;
+              LLStreamWrite(p.outp, ') & "')
+            end;
+            'A'..'Z', 'a'..'z', '_': begin
+              LLStreamWrite(p.outp, '" & $');
+              while p.x[j] in PatternChars do begin
+                LLStreamWrite(p.outp, p.x[j]);
+                inc(j)
+              end;
+              LLStreamWrite(p.outp, ' & "')
+            end;
+            else if p.x[j] = p.subsChar then begin
+              LLStreamWrite(p.outp, p.subsChar);
+              inc(j);
+            end
+            else begin
+              p.info.col := int16(j);
+              liMessage(p.info, errInvalidExpression, '$'+'');
+            end
+          end;
+        end
+        else begin
+          LLStreamWrite(p.outp, p.x[j]);
+          inc(j);
+        end
+      end
+    end;
+    LLStreamWrite(p.outp, '\n"');
+  end
+end;
+
+function ParseTmpl(var p: TTmplParser): PNode;
+var
+  q: TParser;
+begin
+  while not LLStreamAtEnd(p.inp) do begin
+    p.x := LLStreamReadLine(p.inp) {@ignore} + #0 {@emit};
+    p.info.line := p.info.line + int16(1);
+    parseLine(p);
+  end;
+  newLine(p);
+  if gVerbosity >= 2 then begin
+    rawMessage(hintCodeBegin);
+    messageOut(p.outp.s);
+    rawMessage(hintCodeEnd);
+  end;
+  openParser(q, toFilename(p.info), p.outp);
+  result := ParseModule(q);
+  closeParser(q);
+end;
+
+procedure openTmplParser(var p: TTmplParser; const filename: string;
+                         inputStream: PLLStream);
+begin
+{@ignore}
+  FillChar(p, sizeof(p), 0);
+{@emit}
+  p.info := newLineInfo(filename, 0, 0);
+  p.outp := LLStreamOpen('');
+  p.inp := inputStream;
+  p.subsChar := '$';
+end;
+
+procedure CloseTmplParser(var p: TTmplParser);
+begin
+  LLStreamClose(p.inp);
+end;
+
+function ParseTmplFile(const filename: string): PNode;
+var
+  p: TTmplParser;
+  f: TBinaryFile;
+begin
+  if not OpenFile(f, filename) then begin
+    rawMessage(errCannotOpenFile, filename);
+    result := nil;
+    exit
+  end;
+  OpenTmplParser(p, filename, LLStreamOpen(f));
+  result := ParseTmpl(p);
+  CloseTmplParser(p);
+end;
+
+end.