diff options
Diffstat (limited to 'rod/pas2nim')
-rwxr-xr-x | rod/pas2nim/pas2nim.nim | 67 | ||||
-rwxr-xr-x | rod/pas2nim/paslex.nim | 544 | ||||
-rwxr-xr-x | rod/pas2nim/pasparse.nim | 1507 |
3 files changed, 2118 insertions, 0 deletions
diff --git a/rod/pas2nim/pas2nim.nim b/rod/pas2nim/pas2nim.nim new file mode 100755 index 000000000..54e4784c8 --- /dev/null +++ b/rod/pas2nim/pas2nim.nim @@ -0,0 +1,67 @@ +# +# +# Pas2nim - Pascal to Nimrod source converter +# (c) Copyright 2010 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +# + +import + llstream, strutils, os, ast, rnimsyn, options, msgs, + paslex, pasparse + +proc exSymbols(n: PNode) = + case n.kind + of nkEmpty..nkNilLit: nil + of nkProcDef..nkIteratorDef: exSymbol(n.sons[namePos]) + of nkWhenStmt, nkStmtList: + for i in countup(0, sonsLen(n) - 1): exSymbols(n.sons[i]) + of nkVarSection, nkConstSection: + for i in countup(0, sonsLen(n) - 1): exSymbol(n.sons[i].sons[0]) + of nkTypeSection: + for i in countup(0, sonsLen(n) - 1): + exSymbol(n.sons[i].sons[0]) + if (n.sons[i].sons[2] != nil) and + (n.sons[i].sons[2].kind == nkObjectTy): + fixRecordDef(n.sons[i].sons[2]) + else: nil + +proc CommandExportSymbols(filename: string) = + # now unused! + var module = parseFile(addFileExt(filename, NimExt)) + if module != nil: + exSymbols(module) + renderModule(module, getOutFile(filename, "pretty." & NimExt)) + +proc CommandLexPas(filename: string) = + var f = addFileExt(filename, "pas") + var stream = LLStreamOpen(f, fmRead) + if stream != nil: + var + L: TPasLex + tok: TPasTok + OpenLexer(L, f, stream) + getPasTok(L, tok) + while tok.xkind != pxEof: + printPasTok(tok) + getPasTok(L, tok) + closeLexer(L) + else: rawMessage(errCannotOpenFile, f) + +proc CommandPas(filename: string) = + var f = addFileExt(filename, "pas") + var stream = LLStreamOpen(f, fmRead) + if stream != nil: + var p: TPasParser + OpenPasParser(p, f, stream) + var module = parseUnit(p) + closePasParser(p) + renderModule(module, getOutFile(filename, NimExt)) + else: + rawMessage(errCannotOpenFile, f) + + + diff --git a/rod/pas2nim/paslex.nim b/rod/pas2nim/paslex.nim new file mode 100755 index 000000000..9159c5de7 --- /dev/null +++ b/rod/pas2nim/paslex.nim @@ -0,0 +1,544 @@ +# +# +# Pas2nim - Pascal to Nimrod source converter +# (c) Copyright 2010 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +# This module implements a FreePascal scanner. This is an adaption from +# the scanner module. + +import + nhashes, options, msgs, strutils, platform, idents, lexbase + +const + MaxLineLength* = 80 # lines longer than this lead to a warning + numChars*: TCharSet = {'0'..'9', 'a'..'z', 'A'..'Z'} + SymChars*: TCharSet = {'a'..'z', 'A'..'Z', '0'..'9', '\x80'..'\xFF'} + SymStartChars*: TCharSet = {'a'..'z', 'A'..'Z', '\x80'..'\xFF'} + OpChars*: TCharSet = {'+', '-', '*', '/', '<', '>', '!', '?', '^', '.', '|', + '=', ':', '%', '&', '$', '@', '~', '\x80'..'\xFF'} + +# keywords are sorted! + +type + TPasTokKind* = enum + pxInvalid, pxEof, + pxAnd, pxArray, pxAs, pxAsm, pxBegin, pxCase, pxClass, pxConst, + pxConstructor, pxDestructor, pxDiv, pxDo, pxDownto, pxElse, pxEnd, pxExcept, + pxExports, pxFinalization, pxFinally, pxFor, pxFunction, pxGoto, pxIf, + pxImplementation, pxIn, pxInherited, pxInitialization, pxInline, + pxInterface, pxIs, pxLabel, pxLibrary, pxMod, pxNil, pxNot, pxObject, pxOf, + pxOr, pxOut, pxPacked, pxProcedure, pxProgram, pxProperty, pxRaise, + pxRecord, pxRepeat, pxResourcestring, pxSet, pxShl, pxShr, pxThen, + pxThreadvar, pxTo, pxTry, pxType, pxUnit, pxUntil, pxUses, pxVar, pxWhile, + pxWith, pxXor, + pxComment, # ordinary comment + pxCommand, # {@} + pxAmp, # {&} + pxPer, # {%} + pxStrLit, pxSymbol, # a symbol + pxIntLit, pxInt64Lit, # long constant like 0x70fffffff or out of int range + pxFloatLit, pxParLe, pxParRi, pxBracketLe, pxBracketRi, pxComma, + pxSemiColon, pxColon, # operators + pxAsgn, pxEquals, pxDot, pxDotDot, pxHat, pxPlus, pxMinus, pxStar, pxSlash, + pxLe, pxLt, pxGe, pxGt, pxNeq, pxAt, pxStarDirLe, pxStarDirRi, pxCurlyDirLe, + pxCurlyDirRi + TPasTokKinds* = set[TPasTokKind] + +const + Keywords = ["and", "array", "as", "asm", "begin", "case", "class", "const", + "constructor", "destructor", "div", "do", "downto", "else", "end", "except", + "exports", "finalization", "finally", "for", "function", "goto", "if", + "implementation", "in", "inherited", "initialization", "inline", + "interface", "is", "label", "library", "mod", "nil", "not", "object", "of", + "or", "out", "packed", "procedure", "program", "property", "raise", + "record", "repeat", "resourcestring", "set", "shl", "shr", "then", + "threadvar", "to", "try", "type", "unit", "until", "uses", "var", "while", + "with", "xor"] + + firstKeyword = pxAnd + lastKeyword = pxXor + +type + TPasTok* = object + xkind*: TPasTokKind # the type of the token + ident*: PIdent # the parsed identifier + iNumber*: BiggestInt # the parsed integer literal + fNumber*: BiggestFloat # the parsed floating point literal + base*: TNumericalBase # the numerical base; only valid for int + # or float literals + literal*: string # the parsed (string) literal + + TPasLex* = object + filename*: string + + +proc getPasTok*(L: var TPasLex, tok: var TPasTok) +proc PrintPasTok*(tok: TPasTok) +proc pasTokToStr*(tok: TPasTok): string +# implementation + +var dummyIdent: PIdent + +proc fillToken(L: var TToken) = + L.TokType = tkInvalid + L.iNumber = 0 + L.Indent = 0 + L.literal = "" + L.fNumber = 0.0 + L.base = base10 + L.ident = dummyIdent # this prevents many bugs! + +proc openLexer(lex: var TLexer, filename: string, inputstream: PLLStream) = + openBaseLexer(lex, inputstream) + lex.indentStack = @[0] + lex.filename = filename + lex.indentAhead = - 1 + +proc closeLexer(lex: var TLexer) = + inc(gLinesCompiled, lex.LineNumber) + closeBaseLexer(lex) + +proc getColumn(L: TLexer): int = + result = getColNumber(L, L.bufPos) + +proc getLineInfo(L: TLexer): TLineInfo = + result = newLineInfo(L.filename, L.linenumber, getColNumber(L, L.bufpos)) + +proc lexMessage(L: TLexer, msg: TMsgKind, arg = "") = + msgs.liMessage(getLineInfo(L), msg, arg) + +proc lexMessagePos(L: var TLexer, msg: TMsgKind, pos: int, arg = "") = + var info = newLineInfo(L.filename, L.linenumber, pos - L.lineStart) + msgs.liMessage(info, msg, arg) + +proc binaryStrSearch(x: openarray[string], y: string): int = + var a = 0 + var b = len(x) + while a < b: + var mid = (a + b) div 2 + if x[mid] < y: a = mid + 1 + else: b = mid + if a < len(x) and x[a] == y: result = a + else: result = -1 + +proc pastokToStr(tok: TPasTok): string = + case tok.xkind + of pxIntLit, pxInt64Lit: result = $(tok.iNumber) + of pxFloatLit: result = $(tok.fNumber) + of pxInvalid, pxComment..pxStrLit: result = tok.literal + else: + if (tok.ident.s != ""): result = tok.ident.s + else: result = pasTokKindToStr[tok.xkind] + +proc PrintPasTok(tok: TPasTok) = + write(stdout, pasTokKindToStr[tok.xkind]) + write(stdout, ' ') + writeln(stdout, pastokToStr(tok)) + +proc setKeyword(L: var TPasLex, tok: var TPasTok) = + var x = binaryStrSearch(keywords, toLower(tok.ident.s)) + if x < 0: tok.xkind = pxSymbol + else: tok.xKind = TPasTokKind(x + ord(firstKeyword)) + +proc matchUnderscoreChars(L: var TPasLex, tok: var TPasTok, chars: TCharSet) = + # matches ([chars]_)* + var pos = L.bufpos # use registers for pos, buf + var buf = L.buf + while true: + if buf[pos] in chars: + add(tok.literal, buf[pos]) + Inc(pos) + else: + break + if buf[pos] == '_': + add(tok.literal, '_') + Inc(pos) + L.bufPos = pos + +proc isFloatLiteral(s: string): bool = + for i in countup(0, len(s)-1): + if s[i] in {'.', 'e', 'E'}: + return true + +proc getNumber2(L: var TPasLex, tok: var TPasTok) = + var pos = L.bufpos + 1 # skip % + if not (L.buf[pos] in {'0'..'1'}): + # BUGFIX for %date% + tok.xkind = pxInvalid + add(tok.literal, '%') + inc(L.bufpos) + return + tok.base = base2 + var xi: biggestInt = 0 + var bits = 0 + while true: + case L.buf[pos] + of 'A'..'Z', 'a'..'z', '2'..'9', '.': + lexMessage(L, errInvalidNumber) + inc(pos) + of '_': + inc(pos) + of '0', '1': + xi = `shl`(xi, 1) or (ord(L.buf[pos]) - ord('0')) + inc(pos) + inc(bits) + else: break + tok.iNumber = xi + if (bits > 32): tok.xkind = pxInt64Lit + else: tok.xkind = pxIntLit + L.bufpos = pos + +proc getNumber16(L: var TPasLex, tok: var TPasTok) = + var pos = L.bufpos + 1 # skip $ + tok.base = base16 + var xi: biggestInt = 0 + var bits = 0 + while true: + case L.buf[pos] + of 'G'..'Z', 'g'..'z', '.': + lexMessage(L, errInvalidNumber) + inc(pos) + of '_': inc(pos) + of '0'..'9': + xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('0')) + inc(pos) + inc(bits, 4) + of 'a'..'f': + xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('a') + 10) + inc(pos) + inc(bits, 4) + of 'A'..'F': + xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('A') + 10) + inc(pos) + inc(bits, 4) + else: break + tok.iNumber = xi + if (bits > 32): + tok.xkind = pxInt64Lit + else: + tok.xkind = pxIntLit + L.bufpos = pos + +proc getNumber10(L: var TPasLex, tok: var TPasTok) = + tok.base = base10 + matchUnderscoreChars(L, tok, {'0'..'9'}) + if (L.buf[L.bufpos] == '.') and (L.buf[L.bufpos + 1] in {'0'..'9'}): + add(tok.literal, '.') + inc(L.bufpos) + matchUnderscoreChars(L, tok, {'e', 'E', '+', '-', '0'..'9'}) + try: + if isFloatLiteral(tok.literal): + tok.fnumber = parseFloat(tok.literal) + tok.xkind = pxFloatLit + else: + tok.iNumber = ParseInt(tok.literal) + if (tok.iNumber < low(int32)) or (tok.iNumber > high(int32)): + tok.xkind = pxInt64Lit + else: + tok.xkind = pxIntLit + except EInvalidValue: + lexMessage(L, errInvalidNumber, tok.literal) + except EOverflow: + lexMessage(L, errNumberOutOfRange, tok.literal) + +proc HandleCRLF(L: var TLexer, pos: int): int = + case L.buf[pos] + of CR: result = lexbase.HandleCR(L, pos) + of LF: result = lexbase.HandleLF(L, pos) + else: result = pos + +proc getString(L: var TPasLex, tok: var TPasTok) = + var xi: int + var pos = L.bufPos + var buf = L.buf + while true: + if buf[pos] == '\'': + inc(pos) + while true: + case buf[pos] + of CR, LF, lexbase.EndOfFile: + lexMessage(L, errClosingQuoteExpected) + break + of '\'': + inc(pos) + if buf[pos] == '\'': + inc(pos) + add(tok.literal, '\'') + else: + break + else: + add(tok.literal, buf[pos]) + inc(pos) + elif buf[pos] == '#': + inc(pos) + xi = 0 + case buf[pos] + of '$': + inc(pos) + xi = 0 + while true: + case buf[pos] + of '0'..'9': xi = (xi shl 4) or (ord(buf[pos]) - ord('0')) + of 'a'..'f': xi = (xi shl 4) or (ord(buf[pos]) - ord('a') + 10) + of 'A'..'F': xi = (xi shl 4) or (ord(buf[pos]) - ord('A') + 10) + else: break + inc(pos) + of '0'..'9': + xi = 0 + while buf[pos] in {'0'..'9'}: + xi = (xi * 10) + (ord(buf[pos]) - ord('0')) + inc(pos) + else: lexMessage(L, errInvalidCharacterConstant) + if (xi <= 255): add(tok.literal, Chr(xi)) + else: lexMessage(L, errInvalidCharacterConstant) + else: + break + tok.xkind = pxStrLit + L.bufpos = pos + +proc getSymbol(L: var TPasLex, tok: var TPasTok) = + var h: THash = 0 + var pos = L.bufpos + var buf = L.buf + while true: + var c = buf[pos] + case c + of 'a'..'z', '0'..'9', '\x80'..'\xFF': + h = h +% Ord(c) + h = h +% h shl 10 + h = h xor (h shr 6) + of 'A'..'Z': + c = chr(ord(c) + (ord('a') - ord('A'))) # toLower() + h = h +% Ord(c) + h = h +% h shl 10 + h = h xor (h shr 6) + of '_': nil + else: break + Inc(pos) + h = h +% h shl 3 + h = h xor (h shr 11) + h = h +% h shl 15 + tok.ident = getIdent(addr(L.buf[L.bufpos]), pos - L.bufpos, h) + L.bufpos = pos + setKeyword(L, tok) + +proc scanLineComment(L: var TPasLex, tok: var TPasTok) = + var pos = L.bufpos + var buf = L.buf + # a comment ends if the next line does not start with the // on the same + # column after only whitespace + tok.xkind = pxComment + var col = getColNumber(L, pos) + while true: + inc(pos, 2) # skip // + add(tok.literal, '#') + while not (buf[pos] in {CR, LF, lexbase.EndOfFile}): + add(tok.literal, buf[pos]) + inc(pos) + pos = handleCRLF(L, pos) + buf = L.buf + var indent = 0 + while buf[pos] == ' ': + inc(pos) + inc(indent) + if (col == indent) and (buf[pos] == '/') and (buf[pos + 1] == '/'): + tok.literal = tok.literal & "\n" + else: + break + L.bufpos = pos + +proc scanCurlyComment(L: var TPasLex, tok: var TPasTok) = + var pos = L.bufpos + var buf = L.buf + tok.literal = "#" + tok.xkind = pxComment + while true: + case buf[pos] + of CR, LF: + pos = HandleCRLF(L, pos) + buf = L.buf + add(tok.literal, "\n#") + of '}': + inc(pos) + break + of lexbase.EndOfFile: lexMessage(L, errTokenExpected, "}") + else: + add(tok.literal, buf[pos]) + inc(pos) + L.bufpos = pos + +proc scanStarComment(L: var TPasLex, tok: var TPasTok) = + var pos = L.bufpos + var buf = L.buf + tok.literal = "#" + tok.xkind = pxComment + while true: + case buf[pos] + of CR, LF: + pos = HandleCRLF(L, pos) + buf = L.buf + add(tok.literal, "\n#") + of '*': + inc(pos) + if buf[pos] == ')': + inc(pos) + break + else: + add(tok.literal, '*') + of lexbase.EndOfFile: + lexMessage(L, errTokenExpected, "*)") + else: + add(tok.literal, buf[pos]) + inc(pos) + L.bufpos = pos + +proc skip(L: var TPasLex, tok: var TPasTok) = + var pos = L.bufpos + var buf = L.buf + while true: + case buf[pos] + of ' ', Tabulator: + Inc(pos) # newline is special: + of CR, LF: + pos = HandleCRLF(L, pos) + buf = L.buf + else: + break # EndOfFile also leaves the loop + L.bufpos = pos + +proc getPasTok(L: var TPasLex, tok: var TPasTok) = + tok.xkind = pxInvalid + fillToken(tok) + skip(L, tok) + var c = L.buf[L.bufpos] + if c in SymStartChars: + getSymbol(L, tok) + elif c in {'0'..'9'}: + getNumber10(L, tok) + else: + case c + of ';': + tok.xkind = pxSemicolon + Inc(L.bufpos) + of '/': + if L.buf[L.bufpos + 1] == '/': + scanLineComment(L, tok) + else: + tok.xkind = pxSlash + inc(L.bufpos) + of ',': + tok.xkind = pxComma + Inc(L.bufpos) + of '(': + Inc(L.bufpos) + if (L.buf[L.bufPos] == '*'): + if (L.buf[L.bufPos + 1] == '$'): + Inc(L.bufpos, 2) + skip(L, tok) + getSymbol(L, tok) + tok.xkind = pxStarDirLe + else: + inc(L.bufpos) + scanStarComment(L, tok) + else: + tok.xkind = pxParLe + of '*': + inc(L.bufpos) + if L.buf[L.bufpos] == ')': + inc(L.bufpos) + tok.xkind = pxStarDirRi + else: + tok.xkind = pxStar + of ')': + tok.xkind = pxParRi + Inc(L.bufpos) + of '[': + Inc(L.bufpos) + tok.xkind = pxBracketLe + of ']': + Inc(L.bufpos) + tok.xkind = pxBracketRi + of '.': + inc(L.bufpos) + if L.buf[L.bufpos] == '.': + tok.xkind = pxDotDot + inc(L.bufpos) + else: + tok.xkind = pxDot + of '{': + Inc(L.bufpos) + case L.buf[L.bufpos] + of '$': + Inc(L.bufpos) + skip(L, tok) + getSymbol(L, tok) + tok.xkind = pxCurlyDirLe + of '&': + Inc(L.bufpos) + tok.xkind = pxAmp + of '%': + Inc(L.bufpos) + tok.xkind = pxPer + of '@': + Inc(L.bufpos) + tok.xkind = pxCommand + else: scanCurlyComment(L, tok) + of '+': + tok.xkind = pxPlus + inc(L.bufpos) + of '-': + tok.xkind = pxMinus + inc(L.bufpos) + of ':': + inc(L.bufpos) + if L.buf[L.bufpos] == '=': + inc(L.bufpos) + tok.xkind = pxAsgn + else: + tok.xkind = pxColon + of '<': + inc(L.bufpos) + if L.buf[L.bufpos] == '>': + inc(L.bufpos) + tok.xkind = pxNeq + elif L.buf[L.bufpos] == '=': + inc(L.bufpos) + tok.xkind = pxLe + else: + tok.xkind = pxLt + of '>': + inc(L.bufpos) + if L.buf[L.bufpos] == '=': + inc(L.bufpos) + tok.xkind = pxGe + else: + tok.xkind = pxGt + of '=': + tok.xkind = pxEquals + inc(L.bufpos) + of '@': + tok.xkind = pxAt + inc(L.bufpos) + of '^': + tok.xkind = pxHat + inc(L.bufpos) + of '}': + tok.xkind = pxCurlyDirRi + Inc(L.bufpos) + of '\'', '#': + getString(L, tok) + of '$': + getNumber16(L, tok) + of '%': + getNumber2(L, tok) + of lexbase.EndOfFile: + tok.xkind = pxEof + else: + tok.literal = c & "" + tok.xkind = pxInvalid + lexMessage(L, errInvalidToken, c & " (\\" & $(ord(c)) & ')') + Inc(L.bufpos) diff --git a/rod/pas2nim/pasparse.nim b/rod/pas2nim/pasparse.nim new file mode 100755 index 000000000..79d5620e7 --- /dev/null +++ b/rod/pas2nim/pasparse.nim @@ -0,0 +1,1507 @@ +# +# +# Pas2nim - Pascal to Nimrod source converter +# (c) Copyright 2010 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +# This module implements the parser of the Pascal variant Nimrod is written in. +# It transfers a Pascal module into a Nimrod AST. Then the renderer can be +# used to convert the AST to its text representation. + +import + os, llstream, paslex, idents, strutils, ast, astalgo, msgs, options + +type + TPasSection* = enum + seImplementation, seInterface + TPasContext* = enum + conExpr, conStmt, conTypeDesc + TPasParser*{.final.} = object + section*: TPasSection + inParamList*: bool + context*: TPasContext # needed for the @emit command + lastVarSection*: PNode + lex*: TPasLex + tok*: TPasTok + repl*: TIdTable # replacements + + TReplaceTuple* = array[0..1, string] + +const + ImportBlackList*: array[1..3, string] = ["nsystem", "sysutils", "charsets"] + stdReplacements*: array[1..19, TReplaceTuple] = [["include", "incl"], + ["exclude", "excl"], ["pchar", "cstring"], ["assignfile", "open"], + ["integer", "int"], ["longword", "int32"], ["cardinal", "int"], + ["boolean", "bool"], ["shortint", "int8"], ["smallint", "int16"], + ["longint", "int32"], ["byte", "int8"], ["word", "int16"], + ["single", "float32"], ["double", "float64"], ["real", "float"], + ["length", "len"], ["len", "length"], ["setlength", "setlen"]] + nimReplacements*: array[1..35, TReplaceTuple] = [["nimread", "read"], + ["nimwrite", "write"], ["nimclosefile", "close"], ["closefile", "close"], + ["openfile", "open"], ["nsystem", "system"], ["ntime", "times"], + ["nos", "os"], ["nmath", "math"], ["ncopy", "copy"], ["addChar", "add"], + ["halt", "quit"], ["nobject", "TObject"], ["eof", "EndOfFile"], + ["input", "stdin"], ["output", "stdout"], ["addu", "`+%`"], + ["subu", "`-%`"], ["mulu", "`*%`"], ["divu", "`/%`"], ["modu", "`%%`"], + ["ltu", "`<%`"], ["leu", "`<=%`"], ["shlu", "`shl`"], ["shru", "`shr`"], + ["assigned", "not isNil"], ["eintoverflow", "EOverflow"], ["format", "`%`"], + ["snil", "nil"], ["tostringf", "$"], ["ttextfile", "tfile"], + ["tbinaryfile", "tfile"], ["strstart", "0"], ["nl", "\"\\n\""], ["tostring", + "$"]] #, + # ('NL', '"\n"'), + # ('tabulator', '''\t'''), + # ('esc', '''\e'''), + # ('cr', '''\r'''), + # ('lf', '''\l'''), + # ('ff', '''\f'''), + # ('bel', '''\a'''), + # ('backspace', '''\b'''), + # ('vt', '''\v''') + +proc ParseUnit*(p: var TPasParser): PNode +proc openPasParser*(p: var TPasParser, filename: string, inputStream: PLLStream) +proc closePasParser*(p: var TPasParser) +proc exSymbol*(n: var PNode) +proc fixRecordDef*(n: var PNode) + # XXX: move these two to an auxiliary module + +# implementation + +proc OpenPasParser(p: var TPasParser, filename: string, + inputStream: PLLStream) = + OpenLexer(p.lex, filename, inputStream) + initIdTable(p.repl) + for i in countup(low(stdReplacements), high(stdReplacements)): + IdTablePut(p.repl, getIdent(stdReplacements[i][0]), + getIdent(stdReplacements[i][1])) + if gCmd == cmdBoot: + for i in countup(low(nimReplacements), high(nimReplacements)): + IdTablePut(p.repl, getIdent(nimReplacements[i][0]), + getIdent(nimReplacements[i][1])) + +proc ClosePasParser(p: var TPasParser) = CloseLexer(p.lex) +proc getTok(p: var TPasParser) = getPasTok(p.lex, p.tok) + +proc parMessage(p: TPasParser, msg: TMsgKind, arg = "") = + lexMessage(p.lex, msg, arg) + +proc parLineInfo(p: TPasParser): TLineInfo = + result = getLineInfo(p.lex) + +proc skipCom(p: var TPasParser, n: PNode) = + while p.tok.xkind == pxComment: + if (n != nil): + if n.comment == nil: n.comment = p.tok.literal + else: add(n.comment, "\n" & p.tok.literal) + else: + parMessage(p, warnCommentXIgnored, p.tok.literal) + getTok(p) + +proc ExpectIdent(p: TPasParser) = + if p.tok.xkind != pxSymbol: + lexMessage(p.lex, errIdentifierExpected, pasTokToStr(p.tok)) + +proc Eat(p: var TPasParser, xkind: TPasTokKind) = + if p.tok.xkind == xkind: getTok(p) + else: lexMessage(p.lex, errTokenExpected, PasTokKindToStr[xkind]) + +proc Opt(p: var TPasParser, xkind: TPasTokKind) = + if p.tok.xkind == xkind: getTok(p) + +proc newNodeP(kind: TNodeKind, p: TPasParser): PNode = + result = newNodeI(kind, getLineInfo(p.lex)) + +proc newIntNodeP(kind: TNodeKind, intVal: BiggestInt, p: TPasParser): PNode = + result = newNodeP(kind, p) + result.intVal = intVal + +proc newFloatNodeP(kind: TNodeKind, floatVal: BiggestFloat, + p: TPasParser): PNode = + result = newNodeP(kind, p) + result.floatVal = floatVal + +proc newStrNodeP(kind: TNodeKind, strVal: string, p: TPasParser): PNode = + result = newNodeP(kind, p) + result.strVal = strVal + +proc newIdentNodeP(ident: PIdent, p: TPasParser): PNode = + result = newNodeP(nkIdent, p) + result.ident = ident + +proc createIdentNodeP(ident: PIdent, p: TPasParser): PNode = + result = newNodeP(nkIdent, p) + var x = PIdent(IdTableGet(p.repl, ident)) + if x != nil: result.ident = x + else: result.ident = ident + +proc parseExpr(p: var TPasParser): PNode +proc parseStmt(p: var TPasParser): PNode +proc parseTypeDesc(p: var TPasParser, definition: PNode = nil): PNode + +proc parseEmit(p: var TPasParser, definition: PNode): PNode = + getTok(p) # skip 'emit' + result = nil + if p.tok.xkind != pxCurlyDirRi: + case p.context + of conExpr: + result = parseExpr(p) + of conStmt: + result = parseStmt(p) + if p.tok.xkind != pxCurlyDirRi: + var a = result + result = newNodeP(nkStmtList, p) + addSon(result, a) + while p.tok.xkind != pxCurlyDirRi: + addSon(result, parseStmt(p)) + of conTypeDesc: + result = parseTypeDesc(p, definition) + eat(p, pxCurlyDirRi) + +proc parseCommand(p: var TPasParser, definition: PNode = nil): PNode = + result = nil + getTok(p) + if p.tok.ident.id == getIdent("discard").id: + result = newNodeP(nkDiscardStmt, p) + getTok(p) + eat(p, pxCurlyDirRi) + addSon(result, parseExpr(p)) + elif p.tok.ident.id == getIdent("set").id: + getTok(p) + eat(p, pxCurlyDirRi) + result = parseExpr(p) + result.kind = nkCurly + assert(sonsNotNil(result)) + elif p.tok.ident.id == getIdent("cast").id: + getTok(p) + eat(p, pxCurlyDirRi) + var a = parseExpr(p) + if (a.kind == nkCall) and (sonsLen(a) == 2): + result = newNodeP(nkCast, p) + addSon(result, a.sons[0]) + addSon(result, a.sons[1]) + else: + parMessage(p, errInvalidDirectiveX, pasTokToStr(p.tok)) + result = a + elif p.tok.ident.id == getIdent("emit").id: + result = parseEmit(p, definition) + elif p.tok.ident.id == getIdent("ignore").id: + getTok(p) + eat(p, pxCurlyDirRi) + while true: + case p.tok.xkind + of pxEof: + parMessage(p, errTokenExpected, "{@emit}") + of pxCommand: + getTok(p) + if p.tok.ident.id == getIdent("emit").id: + result = parseEmit(p, definition) + break + else: + while (p.tok.xkind != pxCurlyDirRi) and (p.tok.xkind != pxEof): + getTok(p) + eat(p, pxCurlyDirRi) + else: + getTok(p) # skip token + elif p.tok.ident.id == getIdent("ptr").id: + result = newNodeP(nkPtrTy, p) + getTok(p) + eat(p, pxCurlyDirRi) + elif p.tok.ident.id == getIdent("tuple").id: + result = newNodeP(nkTupleTy, p) + getTok(p) + eat(p, pxCurlyDirRi) + elif p.tok.ident.id == getIdent("acyclic").id: + result = newIdentNodeP(p.tok.ident, p) + getTok(p) + eat(p, pxCurlyDirRi) + else: + parMessage(p, errInvalidDirectiveX, pasTokToStr(p.tok)) + while true: + getTok(p) + if (p.tok.xkind == pxCurlyDirRi) or (p.tok.xkind == pxEof): break + eat(p, pxCurlyDirRi) + result = nil + +proc getPrecedence(kind: TPasTokKind): int = + case kind + of pxDiv, pxMod, pxStar, pxSlash, pxShl, pxShr, pxAnd: + result = 5 + of pxPlus, pxMinus, pxOr, pxXor: + result = 4 + of pxIn, pxEquals, pxLe, pxLt, pxGe, pxGt, pxNeq, pxIs: + result = 3 + else: result = -1 + +proc rangeExpr(p: var TPasParser): PNode = + var a = parseExpr(p) + if p.tok.xkind == pxDotDot: + result = newNodeP(nkRange, p) + addSon(result, a) + getTok(p) + skipCom(p, result) + addSon(result, parseExpr(p)) + else: + result = a + +proc bracketExprList(p: var TPasParser, first: PNode): PNode = + result = newNodeP(nkBracketExpr, p) + addSon(result, first) + getTok(p) + skipCom(p, result) + while true: + if p.tok.xkind == pxBracketRi: + getTok(p) + break + if p.tok.xkind == pxEof: + parMessage(p, errTokenExpected, PasTokKindToStr[pxBracketRi]) + break + var a = rangeExpr(p) + skipCom(p, a) + if p.tok.xkind == pxComma: + getTok(p) + skipCom(p, a) + addSon(result, a) + +proc exprColonEqExpr(p: var TPasParser, kind: TNodeKind, + tok: TPasTokKind): PNode = + var a = parseExpr(p) + if p.tok.xkind == tok: + result = newNodeP(kind, p) + getTok(p) + skipCom(p, result) + addSon(result, a) + addSon(result, parseExpr(p)) + else: + result = a + +proc exprListAux(p: var TPasParser, elemKind: TNodeKind, + endTok, sepTok: TPasTokKind, result: PNode) = + getTok(p) + skipCom(p, result) + while true: + if p.tok.xkind == endTok: + getTok(p) + break + if p.tok.xkind == pxEof: + parMessage(p, errTokenExpected, PasTokKindToStr[endtok]) + break + var a = exprColonEqExpr(p, elemKind, sepTok) + skipCom(p, a) + if (p.tok.xkind == pxComma) or (p.tok.xkind == pxSemicolon): + getTok(p) + skipCom(p, a) + addSon(result, a) + +proc qualifiedIdent(p: var TPasParser): PNode = + if p.tok.xkind == pxSymbol: + result = createIdentNodeP(p.tok.ident, p) + else: + parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)) + return nil + getTok(p) + skipCom(p, result) + if p.tok.xkind == pxDot: + getTok(p) + skipCom(p, result) + if p.tok.xkind == pxSymbol: + var a = result + result = newNodeI(nkDotExpr, a.info) + addSon(result, a) + addSon(result, createIdentNodeP(p.tok.ident, p)) + getTok(p) + else: + parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)) + +proc qualifiedIdentListAux(p: var TPasParser, endTok: TPasTokKind, + result: PNode) = + getTok(p) + skipCom(p, result) + while true: + if p.tok.xkind == endTok: + getTok(p) + break + if p.tok.xkind == pxEof: + parMessage(p, errTokenExpected, PasTokKindToStr[endtok]) + break + var a = qualifiedIdent(p) + skipCom(p, a) + if p.tok.xkind == pxComma: + getTok(p) + skipCom(p, a) + addSon(result, a) + +proc exprColonEqExprList(p: var TPasParser, kind, elemKind: TNodeKind, + endTok, sepTok: TPasTokKind): PNode = + result = newNodeP(kind, p) + exprListAux(p, elemKind, endTok, sepTok, result) + +proc setBaseFlags(n: PNode, base: TNumericalBase) = + case base + of base10: nil + of base2: incl(n.flags, nfBase2) + of base8: incl(n.flags, nfBase8) + of base16: incl(n.flags, nfBase16) + +proc identOrLiteral(p: var TPasParser): PNode = + case p.tok.xkind + of pxSymbol: + result = createIdentNodeP(p.tok.ident, p) + getTok(p) + of pxIntLit: + result = newIntNodeP(nkIntLit, p.tok.iNumber, p) + setBaseFlags(result, p.tok.base) + getTok(p) + of pxInt64Lit: + result = newIntNodeP(nkInt64Lit, p.tok.iNumber, p) + setBaseFlags(result, p.tok.base) + getTok(p) + of pxFloatLit: + result = newFloatNodeP(nkFloatLit, p.tok.fNumber, p) + setBaseFlags(result, p.tok.base) + getTok(p) + of pxStrLit: + if len(p.tok.literal) != 1: result = newStrNodeP(nkStrLit, p.tok.literal, p) + else: result = newIntNodeP(nkCharLit, ord(p.tok.literal[0]), p) + getTok(p) + of pxNil: + result = newNodeP(nkNilLit, p) + getTok(p) + of pxParLe: + # () constructor + result = exprColonEqExprList(p, nkPar, nkExprColonExpr, pxParRi, pxColon) + #if hasSonWith(result, nkExprColonExpr) then + # replaceSons(result, nkExprColonExpr, nkExprEqExpr) + if (sonsLen(result) > 1) and not hasSonWith(result, nkExprColonExpr): + result.kind = nkBracket # is an array constructor + of pxBracketLe: + # [] constructor + result = newNodeP(nkBracket, p) + getTok(p) + skipCom(p, result) + while (p.tok.xkind != pxBracketRi) and (p.tok.xkind != pxEof): + var a = rangeExpr(p) + if a.kind == nkRange: + result.kind = nkCurly # it is definitely a set literal + opt(p, pxComma) + skipCom(p, a) + assert(a != nil) + addSon(result, a) + eat(p, pxBracketRi) + of pxCommand: + result = parseCommand(p) + else: + parMessage(p, errExprExpected, pasTokToStr(p.tok)) + getTok(p) # we must consume a token here to prevend endless loops! + result = nil + if result != nil: skipCom(p, result) + +proc primary(p: var TPasParser): PNode = + # prefix operator? + if (p.tok.xkind == pxNot) or (p.tok.xkind == pxMinus) or + (p.tok.xkind == pxPlus): + result = newNodeP(nkPrefix, p) + var a = newIdentNodeP(getIdent(pasTokToStr(p.tok)), p) + addSon(result, a) + getTok(p) + skipCom(p, a) + addSon(result, primary(p)) + return + elif p.tok.xkind == pxAt: + result = newNodeP(nkAddr, p) + var a = newIdentNodeP(getIdent(pasTokToStr(p.tok)), p) + getTok(p) + if p.tok.xkind == pxBracketLe: + result = newNodeP(nkPrefix, p) + addSon(result, a) + addSon(result, identOrLiteral(p)) + else: + addSon(result, primary(p)) + return + result = identOrLiteral(p) + while true: + case p.tok.xkind + of pxParLe: + var a = result + result = newNodeP(nkCall, p) + addSon(result, a) + exprListAux(p, nkExprEqExpr, pxParRi, pxEquals, result) + of pxDot: + var a = result + result = newNodeP(nkDotExpr, p) + addSon(result, a) + getTok(p) # skip '.' + skipCom(p, result) + if p.tok.xkind == pxSymbol: + addSon(result, createIdentNodeP(p.tok.ident, p)) + getTok(p) + else: + parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)) + of pxHat: + var a = result + result = newNodeP(nkDerefExpr, p) + addSon(result, a) + getTok(p) + of pxBracketLe: + result = bracketExprList(p, result) + else: break + +proc lowestExprAux(p: var TPasParser, v: var PNode, limit: int): TPasTokKind = + var + nextop: TPasTokKind + v2, node, opNode: PNode + v = primary(p) # expand while operators have priorities higher than 'limit' + var op = p.tok.xkind + var opPred = getPrecedence(op) + while (opPred > limit): + node = newNodeP(nkInfix, p) + opNode = newIdentNodeP(getIdent(pasTokToStr(p.tok)), p) # skip operator: + getTok(p) + case op + of pxPlus: + case p.tok.xkind + of pxPer: + getTok(p) + eat(p, pxCurlyDirRi) + opNode.ident = getIdent("+%") + of pxAmp: + getTok(p) + eat(p, pxCurlyDirRi) + opNode.ident = getIdent("&") + else: + nil + of pxMinus: + if p.tok.xkind == pxPer: + getTok(p) + eat(p, pxCurlyDirRi) + opNode.ident = getIdent("-%") + of pxEquals: + opNode.ident = getIdent("==") + of pxNeq: + opNode.ident = getIdent("!=") + else: + nil + skipCom(p, opNode) # read sub-expression with higher priority + nextop = lowestExprAux(p, v2, opPred) + addSon(node, opNode) + addSon(node, v) + addSon(node, v2) + v = node + op = nextop + opPred = getPrecedence(nextop) + result = op # return first untreated operator + +proc fixExpr(n: PNode): PNode = + result = n + if n == nil: return + case n.kind + of nkInfix: + if n.sons[1].kind == nkBracket: + n.sons[1].kind = nkCurly + if n.sons[2].kind == nkBracket: + n.sons[2].kind = nkCurly + if (n.sons[0].kind == nkIdent): + if (n.sons[0].ident.id == getIdent("+").id): + if (n.sons[1].kind == nkCharLit) and (n.sons[2].kind == nkStrLit) and + (n.sons[2].strVal == ""): + result = newStrNode(nkStrLit, chr(int(n.sons[1].intVal)) & "") + result.info = n.info + return # do not process sons as they don't exist anymore + elif (n.sons[1].kind in {nkCharLit, nkStrLit}) or + (n.sons[2].kind in {nkCharLit, nkStrLit}): + n.sons[0].ident = getIdent("&") # fix operator + else: + nil + if not (n.kind in {nkEmpty..nkNilLit}): + for i in countup(0, sonsLen(n) - 1): result.sons[i] = fixExpr(n.sons[i]) + +proc parseExpr(p: var TPasParser): PNode = + var oldcontext = p.context + p.context = conExpr + if p.tok.xkind == pxCommand: + result = parseCommand(p) + else: + discard lowestExprAux(p, result, - 1) + result = fixExpr(result) + p.context = oldcontext + +proc parseExprStmt(p: var TPasParser): PNode = + var info = parLineInfo(p) + var a = parseExpr(p) + if p.tok.xkind == pxAsgn: + getTok(p) + skipCom(p, a) + var b = parseExpr(p) + result = newNodeI(nkAsgn, info) + addSon(result, a) + addSon(result, b) + else: + result = a + +proc inImportBlackList(ident: PIdent): bool = + for i in countup(low(ImportBlackList), high(ImportBlackList)): + if ident.id == getIdent(ImportBlackList[i]).id: + return true + +proc parseUsesStmt(p: var TPasParser): PNode = + var a: PNode + result = newNodeP(nkImportStmt, p) + getTok(p) # skip `import` + skipCom(p, result) + while true: + case p.tok.xkind + of pxEof: break + of pxSymbol: a = newIdentNodeP(p.tok.ident, p) + else: + parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)) + break + getTok(p) # skip identifier, string + skipCom(p, a) + if (gCmd != cmdBoot) or not inImportBlackList(a.ident): + addSon(result, createIdentNodeP(a.ident, p)) + if p.tok.xkind == pxComma: + getTok(p) + skipCom(p, a) + else: + break + if sonsLen(result) == 0: result = nil + +proc parseIncludeDir(p: var TPasParser): PNode = + result = newNodeP(nkIncludeStmt, p) + getTok(p) # skip `include` + var filename = "" + while true: + case p.tok.xkind + of pxSymbol, pxDot, pxDotDot, pxSlash: + filename = filename & pasTokToStr(p.tok) + getTok(p) + of pxStrLit: + filename = p.tok.literal + getTok(p) + break + of pxCurlyDirRi: + break + else: + parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)) + break + addSon(result, newStrNodeP(nkStrLit, changeFileExt(filename, "nim"), p)) + if filename == "config.inc": result = nil + +proc definedExprAux(p: var TPasParser): PNode = + result = newNodeP(nkCall, p) + addSon(result, newIdentNodeP(getIdent("defined"), p)) + ExpectIdent(p) + addSon(result, createIdentNodeP(p.tok.ident, p)) + getTok(p) + +proc isHandledDirective(p: TPasParser): bool = + result = false + if p.tok.xkind in {pxCurlyDirLe, pxStarDirLe}: + case whichKeyword(p.tok.ident) + of wElse, wEndif: result = false + else: result = true + +proc parseStmtList(p: var TPasParser): PNode = + result = newNodeP(nkStmtList, p) + while true: + case p.tok.xkind + of pxEof: + break + of pxCurlyDirLe, pxStarDirLe: + if not isHandledDirective(p): break + else: + nil + addSon(result, parseStmt(p)) + if sonsLen(result) == 1: result = result.sons[0] + +proc parseIfDirAux(p: var TPasParser, result: PNode) = + addSon(result.sons[0], parseStmtList(p)) + if p.tok.xkind in {pxCurlyDirLe, pxStarDirLe}: + var endMarker = succ(p.tok.xkind) + if whichKeyword(p.tok.ident) == wElse: + var s = newNodeP(nkElse, p) + while (p.tok.xkind != pxEof) and (p.tok.xkind != endMarker): getTok(p) + eat(p, endMarker) + addSon(s, parseStmtList(p)) + addSon(result, s) + if p.tok.xkind in {pxCurlyDirLe, pxStarDirLe}: + endMarker = succ(p.tok.xkind) + if whichKeyword(p.tok.ident) == wEndif: + while (p.tok.xkind != pxEof) and (p.tok.xkind != endMarker): getTok(p) + eat(p, endMarker) + else: + parMessage(p, errXExpected, "{$endif}") + else: + parMessage(p, errXExpected, "{$endif}") + +proc parseIfdefDir(p: var TPasParser, endMarker: TPasTokKind): PNode = + result = newNodeP(nkWhenStmt, p) + addSon(result, newNodeP(nkElifBranch, p)) + getTok(p) + addSon(result.sons[0], definedExprAux(p)) + eat(p, endMarker) + parseIfDirAux(p, result) + +proc parseIfndefDir(p: var TPasParser, endMarker: TPasTokKind): PNode = + result = newNodeP(nkWhenStmt, p) + addSon(result, newNodeP(nkElifBranch, p)) + getTok(p) + var e = newNodeP(nkCall, p) + addSon(e, newIdentNodeP(getIdent("not"), p)) + addSon(e, definedExprAux(p)) + eat(p, endMarker) + addSon(result.sons[0], e) + parseIfDirAux(p, result) + +proc parseIfDir(p: var TPasParser, endMarker: TPasTokKind): PNode = + result = newNodeP(nkWhenStmt, p) + addSon(result, newNodeP(nkElifBranch, p)) + getTok(p) + addSon(result.sons[0], parseExpr(p)) + eat(p, endMarker) + parseIfDirAux(p, result) + +proc parseDirective(p: var TPasParser): PNode = + result = nil + if not (p.tok.xkind in {pxCurlyDirLe, pxStarDirLe}): return + var endMarker = succ(p.tok.xkind) + if p.tok.ident != nil: + case whichKeyword(p.tok.ident) + of wInclude: + result = parseIncludeDir(p) + eat(p, endMarker) + of wIf: result = parseIfDir(p, endMarker) + of wIfdef: result = parseIfdefDir(p, endMarker) + of wIfndef: result = parseIfndefDir(p, endMarker) + else: + # skip unknown compiler directive + while (p.tok.xkind != pxEof) and (p.tok.xkind != endMarker): getTok(p) + eat(p, endMarker) + else: + eat(p, endMarker) + +proc parseRaise(p: var TPasParser): PNode = + result = newNodeP(nkRaiseStmt, p) + getTok(p) + skipCom(p, result) + if p.tok.xkind != pxSemicolon: addSon(result, parseExpr(p)) + else: addSon(result, nil) + +proc parseIf(p: var TPasParser): PNode = + result = newNodeP(nkIfStmt, p) + while true: + getTok(p) # skip ``if`` + var branch = newNodeP(nkElifBranch, p) + skipCom(p, branch) + addSon(branch, parseExpr(p)) + eat(p, pxThen) + skipCom(p, branch) + addSon(branch, parseStmt(p)) + skipCom(p, branch) + addSon(result, branch) + if p.tok.xkind == pxElse: + getTok(p) + if p.tok.xkind != pxIf: + # ordinary else part: + branch = newNodeP(nkElse, p) + skipCom(p, result) # BUGFIX + addSon(branch, parseStmt(p)) + addSon(result, branch) + break + else: + break + +proc parseWhile(p: var TPasParser): PNode = + result = newNodeP(nkWhileStmt, p) + getTok(p) + skipCom(p, result) + addSon(result, parseExpr(p)) + eat(p, pxDo) + skipCom(p, result) + addSon(result, parseStmt(p)) + +proc parseRepeat(p: var TPasParser): PNode = + result = newNodeP(nkWhileStmt, p) + getTok(p) + skipCom(p, result) + addSon(result, newIdentNodeP(getIdent("true"), p)) + var s = newNodeP(nkStmtList, p) + while (p.tok.xkind != pxEof) and (p.tok.xkind != pxUntil): + addSon(s, parseStmt(p)) + eat(p, pxUntil) + var a = newNodeP(nkIfStmt, p) + skipCom(p, a) + var b = newNodeP(nkElifBranch, p) + var c = newNodeP(nkBreakStmt, p) + addSon(c, nil) + addSon(b, parseExpr(p)) + skipCom(p, a) + addSon(b, c) + addSon(a, b) + if b.sons[0].kind == nkIdent and b.sons[0].ident.id == getIdent("false").id: + nil + else: + addSon(s, a) + addSon(result, s) + +proc parseCase(p: var TPasParser): PNode = + var b: PNode + result = newNodeP(nkCaseStmt, p) + getTok(p) + addSon(result, parseExpr(p)) + eat(p, pxOf) + skipCom(p, result) + while (p.tok.xkind != pxEnd) and (p.tok.xkind != pxEof): + if p.tok.xkind == pxElse: + b = newNodeP(nkElse, p) + getTok(p) + else: + b = newNodeP(nkOfBranch, p) + while (p.tok.xkind != pxEof) and (p.tok.xkind != pxColon): + addSon(b, rangeExpr(p)) + opt(p, pxComma) + skipcom(p, b) + eat(p, pxColon) + skipCom(p, b) + addSon(b, parseStmt(p)) + addSon(result, b) + if b.kind == nkElse: break + eat(p, pxEnd) + +proc parseTry(p: var TPasParser): PNode = + result = newNodeP(nkTryStmt, p) + getTok(p) + skipCom(p, result) + var b = newNodeP(nkStmtList, p) + while not (p.tok.xkind in {pxFinally, pxExcept, pxEof, pxEnd}): + addSon(b, parseStmt(p)) + addSon(result, b) + if p.tok.xkind == pxExcept: + getTok(p) + while p.tok.ident.id == getIdent("on").id: + b = newNodeP(nkExceptBranch, p) + getTok(p) + var e = qualifiedIdent(p) + if p.tok.xkind == pxColon: + getTok(p) + e = qualifiedIdent(p) + addSon(b, e) + eat(p, pxDo) + addSon(b, parseStmt(p)) + addSon(result, b) + if p.tok.xkind == pxCommand: discard parseCommand(p) + if p.tok.xkind == pxElse: + b = newNodeP(nkExceptBranch, p) + getTok(p) + addSon(b, parseStmt(p)) + addSon(result, b) + if p.tok.xkind == pxFinally: + b = newNodeP(nkFinally, p) + getTok(p) + var e = newNodeP(nkStmtList, p) + while (p.tok.xkind != pxEof) and (p.tok.xkind != pxEnd): + addSon(e, parseStmt(p)) + if sonsLen(e) == 0: addSon(e, newNodeP(nkNilLit, p)) + addSon(result, e) + eat(p, pxEnd) + +proc parseFor(p: var TPasParser): PNode = + var a, b, c: PNode + result = newNodeP(nkForStmt, p) + getTok(p) + skipCom(p, result) + expectIdent(p) + addSon(result, createIdentNodeP(p.tok.ident, p)) + getTok(p) + eat(p, pxAsgn) + a = parseExpr(p) + b = nil + c = newNodeP(nkCall, p) + if p.tok.xkind == pxTo: + addSon(c, newIdentNodeP(getIdent("countup"), p)) + getTok(p) + b = parseExpr(p) + elif p.tok.xkind == pxDownto: + addSon(c, newIdentNodeP(getIdent("countdown"), p)) + getTok(p) + b = parseExpr(p) + else: + parMessage(p, errTokenExpected, PasTokKindToStr[pxTo]) + addSon(c, a) + addSon(c, b) + eat(p, pxDo) + skipCom(p, result) + addSon(result, c) + addSon(result, parseStmt(p)) + +proc parseParam(p: var TPasParser): PNode = + var a, v: PNode + result = newNodeP(nkIdentDefs, p) + v = nil + case p.tok.xkind + of pxConst: + getTok(p) + of pxVar: + getTok(p) + v = newNodeP(nkVarTy, p) + of pxOut: + getTok(p) + v = newNodeP(nkVarTy, p) + else: + nil + while true: + case p.tok.xkind + of pxSymbol: a = createIdentNodeP(p.tok.ident, p) + of pxColon, pxEof, pxParRi, pxEquals: break + else: + parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)) + return + getTok(p) # skip identifier + skipCom(p, a) + if p.tok.xkind == pxComma: + getTok(p) + skipCom(p, a) + addSon(result, a) + if p.tok.xkind == pxColon: + getTok(p) + skipCom(p, result) + if v != nil: addSon(v, parseTypeDesc(p)) + else: v = parseTypeDesc(p) + addSon(result, v) + else: + addSon(result, nil) + if p.tok.xkind != pxEquals: + parMessage(p, errColonOrEqualsExpected, pasTokToStr(p.tok)) + if p.tok.xkind == pxEquals: + getTok(p) + skipCom(p, result) + addSon(result, parseExpr(p)) + else: + addSon(result, nil) + +proc parseParamList(p: var TPasParser): PNode = + var a: PNode + result = newNodeP(nkFormalParams, p) + addSon(result, nil) # return type + if p.tok.xkind == pxParLe: + p.inParamList = true + getTok(p) + skipCom(p, result) + while true: + case p.tok.xkind + of pxSymbol, pxConst, pxVar, pxOut: + a = parseParam(p) + of pxParRi: + getTok(p) + break + else: + parMessage(p, errTokenExpected, ")") + break + skipCom(p, a) + if p.tok.xkind == pxSemicolon: + getTok(p) + skipCom(p, a) + addSon(result, a) + p.inParamList = false + if p.tok.xkind == pxColon: + getTok(p) + skipCom(p, result) + result.sons[0] = parseTypeDesc(p) + +proc parseCallingConvention(p: var TPasParser): PNode = + result = nil + if p.tok.xkind == pxSymbol: + case whichKeyword(p.tok.ident) + of wStdcall, wCDecl, wSafeCall, wSysCall, wInline, wFastCall: + result = newNodeP(nkPragma, p) + addSon(result, newIdentNodeP(p.tok.ident, p)) + getTok(p) + opt(p, pxSemicolon) + of wRegister: + result = newNodeP(nkPragma, p) + addSon(result, newIdentNodeP(getIdent("fastcall"), p)) + getTok(p) + opt(p, pxSemicolon) + else: + nil + +proc parseRoutineSpecifiers(p: var TPasParser, noBody: var bool): PNode = + var e: PNode + result = parseCallingConvention(p) + noBody = false + while p.tok.xkind == pxSymbol: + case whichKeyword(p.tok.ident) + of wAssembler, wOverload, wFar: + getTok(p) + opt(p, pxSemicolon) + of wForward: + noBody = true + getTok(p) + opt(p, pxSemicolon) + of wImportc: + # This is a fake for platform module. There is no ``importc`` + # directive in Pascal. + if result == nil: result = newNodeP(nkPragma, p) + addSon(result, newIdentNodeP(getIdent("importc"), p)) + noBody = true + getTok(p) + opt(p, pxSemicolon) + of wNoConv: + # This is a fake for platform module. There is no ``noconv`` + # directive in Pascal. + if result == nil: result = newNodeP(nkPragma, p) + addSon(result, newIdentNodeP(getIdent("noconv"), p)) + noBody = true + getTok(p) + opt(p, pxSemicolon) + of wProcVar: + # This is a fake for the Nimrod compiler. There is no ``procvar`` + # directive in Pascal. + if result == nil: result = newNodeP(nkPragma, p) + addSon(result, newIdentNodeP(getIdent("procvar"), p)) + getTok(p) + opt(p, pxSemicolon) + of wVarargs: + if result == nil: result = newNodeP(nkPragma, p) + addSon(result, newIdentNodeP(getIdent("varargs"), p)) + getTok(p) + opt(p, pxSemicolon) + of wExternal: + if result == nil: result = newNodeP(nkPragma, p) + getTok(p) + noBody = true + e = newNodeP(nkExprColonExpr, p) + addSon(e, newIdentNodeP(getIdent("dynlib"), p)) + addSon(e, parseExpr(p)) + addSon(result, e) + opt(p, pxSemicolon) + if (p.tok.xkind == pxSymbol) and + (p.tok.ident.id == getIdent("name").id): + e = newNodeP(nkExprColonExpr, p) + getTok(p) + addSon(e, newIdentNodeP(getIdent("importc"), p)) + addSon(e, parseExpr(p)) + addSon(result, e) + else: + addSon(result, newIdentNodeP(getIdent("importc"), p)) + opt(p, pxSemicolon) + else: + e = parseCallingConvention(p) + if e == nil: break + if result == nil: result = newNodeP(nkPragma, p) + addSon(result, e.sons[0]) + +proc parseRoutineType(p: var TPasParser): PNode = + result = newNodeP(nkProcTy, p) + getTok(p) + skipCom(p, result) + addSon(result, parseParamList(p)) + opt(p, pxSemicolon) + addSon(result, parseCallingConvention(p)) + skipCom(p, result) + +proc parseEnum(p: var TPasParser): PNode = + var a, b: PNode + result = newNodeP(nkEnumTy, p) + getTok(p) + skipCom(p, result) + addSon(result, nil) # it does not inherit from any enumeration + while true: + case p.tok.xkind + of pxEof, pxParRi: break + of pxSymbol: a = newIdentNodeP(p.tok.ident, p) + else: + parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)) + break + getTok(p) # skip identifier + skipCom(p, a) + if (p.tok.xkind == pxEquals) or (p.tok.xkind == pxAsgn): + getTok(p) + skipCom(p, a) + b = a + a = newNodeP(nkEnumFieldDef, p) + addSon(a, b) + addSon(a, parseExpr(p)) + if p.tok.xkind == pxComma: + getTok(p) + skipCom(p, a) + addSon(result, a) + eat(p, pxParRi) + +proc identVis(p: var TPasParser): PNode = + # identifier with visability + var a = createIdentNodeP(p.tok.ident, p) + if p.section == seInterface: + result = newNodeP(nkPostfix, p) + addSon(result, newIdentNodeP(getIdent("*"), p)) + addSon(result, a) + else: + result = a + getTok(p) + +type + TSymbolParser = proc (p: var TPasParser): PNode + +proc rawIdent(p: var TPasParser): PNode = + result = createIdentNodeP(p.tok.ident, p) + getTok(p) + +proc parseIdentColonEquals(p: var TPasParser, + identParser: TSymbolParser): PNode = + var a: PNode + result = newNodeP(nkIdentDefs, p) + while true: + case p.tok.xkind + of pxSymbol: a = identParser(p) + of pxColon, pxEof, pxParRi, pxEquals: break + else: + parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)) + return + skipCom(p, a) + if p.tok.xkind == pxComma: + getTok(p) + skipCom(p, a) + addSon(result, a) + if p.tok.xkind == pxColon: + getTok(p) + skipCom(p, result) + addSon(result, parseTypeDesc(p)) + else: + addSon(result, nil) + if p.tok.xkind != pxEquals: + parMessage(p, errColonOrEqualsExpected, pasTokToStr(p.tok)) + if p.tok.xkind == pxEquals: + getTok(p) + skipCom(p, result) + addSon(result, parseExpr(p)) + else: + addSon(result, nil) + if p.tok.xkind == pxSemicolon: + getTok(p) + skipCom(p, result) + +proc parseRecordCase(p: var TPasParser): PNode = + var a, b, c: PNode + result = newNodeP(nkRecCase, p) + getTok(p) + a = newNodeP(nkIdentDefs, p) + addSon(a, rawIdent(p)) + eat(p, pxColon) + addSon(a, parseTypeDesc(p)) + addSon(a, nil) + addSon(result, a) + eat(p, pxOf) + skipCom(p, result) + while true: + case p.tok.xkind + of pxEof, pxEnd: + break + of pxElse: + b = newNodeP(nkElse, p) + getTok(p) + else: + b = newNodeP(nkOfBranch, p) + while (p.tok.xkind != pxEof) and (p.tok.xkind != pxColon): + addSon(b, rangeExpr(p)) + opt(p, pxComma) + skipcom(p, b) + eat(p, pxColon) + skipCom(p, b) + c = newNodeP(nkRecList, p) + eat(p, pxParLe) + while (p.tok.xkind != pxParRi) and (p.tok.xkind != pxEof): + addSon(c, parseIdentColonEquals(p, rawIdent)) + opt(p, pxSemicolon) + skipCom(p, lastSon(c)) + eat(p, pxParRi) + opt(p, pxSemicolon) + if sonsLen(c) > 0: skipCom(p, lastSon(c)) + else: addSon(c, newNodeP(nkNilLit, p)) + addSon(b, c) + addSon(result, b) + if b.kind == nkElse: break + +proc parseRecordPart(p: var TPasParser): PNode = + result = nil + while (p.tok.xkind != pxEof) and (p.tok.xkind != pxEnd): + if result == nil: result = newNodeP(nkRecList, p) + case p.tok.xkind + of pxSymbol: + addSon(result, parseIdentColonEquals(p, rawIdent)) + opt(p, pxSemicolon) + skipCom(p, lastSon(result)) + of pxCase: + addSon(result, parseRecordCase(p)) + of pxComment: + skipCom(p, lastSon(result)) + else: + parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)) + break + +proc exSymbol(n: var PNode) = + case n.kind + of nkPostfix: + nil + of nkPragmaExpr: + exSymbol(n.sons[0]) + of nkIdent, nkAccQuoted: + var a = newNodeI(nkPostFix, n.info) + addSon(a, newIdentNode(getIdent("*"), n.info)) + addSon(a, n) + n = a + else: internalError(n.info, "exSymbol(): " & $n.kind) + +proc fixRecordDef(n: var PNode) = + if n == nil: return + case n.kind + of nkRecCase: + fixRecordDef(n.sons[0]) + for i in countup(1, sonsLen(n) - 1): + var length = sonsLen(n.sons[i]) + fixRecordDef(n.sons[i].sons[length - 1]) + of nkRecList, nkRecWhen, nkElse, nkOfBranch, nkElifBranch, nkObjectTy: + for i in countup(0, sonsLen(n) - 1): fixRecordDef(n.sons[i]) + of nkIdentDefs: + for i in countup(0, sonsLen(n) - 3): exSymbol(n.sons[i]) + of nkNilLit: nil + else: internalError(n.info, "fixRecordDef(): " & $n.kind) + +proc addPragmaToIdent(ident: var PNode, pragma: PNode) = + var pragmasNode: PNode + if ident.kind != nkPragmaExpr: + pragmasNode = newNodeI(nkPragma, ident.info) + var e = newNodeI(nkPragmaExpr, ident.info) + addSon(e, ident) + addSon(e, pragmasNode) + ident = e + else: + pragmasNode = ident.sons[1] + if pragmasNode.kind != nkPragma: + InternalError(ident.info, "addPragmaToIdent") + addSon(pragmasNode, pragma) + +proc parseRecordBody(p: var TPasParser, result, definition: PNode) = + skipCom(p, result) + var a = parseRecordPart(p) + if result.kind != nkTupleTy: fixRecordDef(a) + addSon(result, a) + eat(p, pxEnd) + case p.tok.xkind + of pxSymbol: + if p.tok.ident.id == getIdent("acyclic").id: + if definition != nil: + addPragmaToIdent(definition.sons[0], newIdentNodeP(p.tok.ident, p)) + else: + InternalError(result.info, "anonymous record is not supported") + getTok(p) + else: + InternalError(result.info, "parseRecordBody") + of pxCommand: + if definition != nil: addPragmaToIdent(definition.sons[0], parseCommand(p)) + else: InternalError(result.info, "anonymous record is not supported") + else: + nil + opt(p, pxSemicolon) + skipCom(p, result) + +proc parseRecordOrObject(p: var TPasParser, kind: TNodeKind, + definition: PNode): PNode = + result = newNodeP(kind, p) + getTok(p) + addSon(result, nil) + if p.tok.xkind == pxParLe: + var a = newNodeP(nkOfInherit, p) + getTok(p) + addSon(a, parseTypeDesc(p)) + addSon(result, a) + eat(p, pxParRi) + else: + addSon(result, nil) + parseRecordBody(p, result, definition) + +proc parseTypeDesc(p: var TPasParser, definition: PNode = nil): PNode = + var oldcontext = p.context + p.context = conTypeDesc + if p.tok.xkind == pxPacked: getTok(p) + case p.tok.xkind + of pxCommand: + result = parseCommand(p, definition) + of pxProcedure, pxFunction: + result = parseRoutineType(p) + of pxRecord: + getTok(p) + if p.tok.xkind == pxCommand: + result = parseCommand(p) + if result.kind != nkTupleTy: InternalError(result.info, "parseTypeDesc") + parseRecordBody(p, result, definition) + var a = lastSon(result) # embed nkRecList directly into nkTupleTy + for i in countup(0, sonsLen(a) - 1): + if i == 0: result.sons[sonsLen(result) - 1] = a.sons[0] + else: addSon(result, a.sons[i]) + else: + result = newNodeP(nkObjectTy, p) + addSon(result, nil) + addSon(result, nil) + parseRecordBody(p, result, definition) + if definition != nil: + addPragmaToIdent(definition.sons[0], newIdentNodeP(getIdent("final"), p)) + else: + InternalError(result.info, "anonymous record is not supported") + of pxObject: result = parseRecordOrObject(p, nkObjectTy, definition) + of pxParLe: result = parseEnum(p) + of pxArray: + result = newNodeP(nkBracketExpr, p) + getTok(p) + if p.tok.xkind == pxBracketLe: + addSon(result, newIdentNodeP(getIdent("array"), p)) + getTok(p) + addSon(result, rangeExpr(p)) + eat(p, pxBracketRi) + else: + if p.inParamList: addSon(result, newIdentNodeP(getIdent("openarray"), p)) + else: addSon(result, newIdentNodeP(getIdent("seq"), p)) + eat(p, pxOf) + addSon(result, parseTypeDesc(p)) + of pxSet: + result = newNodeP(nkBracketExpr, p) + getTok(p) + eat(p, pxOf) + addSon(result, newIdentNodeP(getIdent("set"), p)) + addSon(result, parseTypeDesc(p)) + of pxHat: + getTok(p) + if p.tok.xkind == pxCommand: result = parseCommand(p) + elif gCmd == cmdBoot: result = newNodeP(nkRefTy, p) + else: result = newNodeP(nkPtrTy, p) + addSon(result, parseTypeDesc(p)) + of pxType: + getTok(p) + result = parseTypeDesc(p) + else: + var a = primary(p) + if p.tok.xkind == pxDotDot: + result = newNodeP(nkBracketExpr, p) + var r = newNodeP(nkRange, p) + addSon(result, newIdentNodeP(getIdent("range"), p)) + getTok(p) + addSon(r, a) + addSon(r, parseExpr(p)) + addSon(result, r) + else: + result = a + p.context = oldcontext + +proc parseTypeDef(p: var TPasParser): PNode = + result = newNodeP(nkTypeDef, p) + addSon(result, identVis(p)) + addSon(result, nil) # generic params + if p.tok.xkind == pxEquals: + getTok(p) + skipCom(p, result) + addSon(result, parseTypeDesc(p, result)) + else: + addSon(result, nil) + if p.tok.xkind == pxSemicolon: + getTok(p) + skipCom(p, result) + +proc parseTypeSection(p: var TPasParser): PNode = + result = newNodeP(nkTypeSection, p) + getTok(p) + skipCom(p, result) + while p.tok.xkind == pxSymbol: + addSon(result, parseTypeDef(p)) + +proc parseConstant(p: var TPasParser): PNode = + result = newNodeP(nkConstDef, p) + addSon(result, identVis(p)) + if p.tok.xkind == pxColon: + getTok(p) + skipCom(p, result) + addSon(result, parseTypeDesc(p)) + else: + addSon(result, nil) + if p.tok.xkind != pxEquals: + parMessage(p, errColonOrEqualsExpected, pasTokToStr(p.tok)) + if p.tok.xkind == pxEquals: + getTok(p) + skipCom(p, result) + addSon(result, parseExpr(p)) + else: + addSon(result, nil) + if p.tok.xkind == pxSemicolon: + getTok(p) + skipCom(p, result) + +proc parseConstSection(p: var TPasParser): PNode = + result = newNodeP(nkConstSection, p) + getTok(p) + skipCom(p, result) + while p.tok.xkind == pxSymbol: + addSon(result, parseConstant(p)) + +proc parseVar(p: var TPasParser): PNode = + result = newNodeP(nkVarSection, p) + getTok(p) + skipCom(p, result) + while p.tok.xkind == pxSymbol: + addSon(result, parseIdentColonEquals(p, identVis)) + p.lastVarSection = result + +proc parseRoutine(p: var TPasParser): PNode = + var + stmts: PNode + noBody: bool + result = newNodeP(nkProcDef, p) + getTok(p) + skipCom(p, result) + expectIdent(p) + addSon(result, identVis(p)) + addSon(result, nil) # generic parameters + addSon(result, parseParamList(p)) + opt(p, pxSemicolon) + addSon(result, parseRoutineSpecifiers(p, noBody)) + if (p.section == seInterface) or noBody: + addSon(result, nil) + else: + stmts = newNodeP(nkStmtList, p) + while true: + case p.tok.xkind + of pxVar: addSon(stmts, parseVar(p)) + of pxConst: addSon(stmts, parseConstSection(p)) + of pxType: addSon(stmts, parseTypeSection(p)) + of pxComment: skipCom(p, result) + of pxBegin: break + else: + parMessage(p, errTokenExpected, "begin") + break + var a = parseStmt(p) + for i in countup(0, sonsLen(a) - 1): addSon(stmts, a.sons[i]) + addSon(result, stmts) + +proc fixExit(p: var TPasParser, n: PNode): bool = + result = false + if (p.tok.ident.id == getIdent("exit").id): + var length = sonsLen(n) + if (length <= 0): return + var a = n.sons[length-1] + if (a.kind == nkAsgn) and (a.sons[0].kind == nkIdent) and + (a.sons[0].ident.id == getIdent("result").id): + delSon(a, 0) + a.kind = nkReturnStmt + result = true + getTok(p) + opt(p, pxSemicolon) + skipCom(p, a) + +proc fixVarSection(p: var TPasParser, counter: PNode) = + if p.lastVarSection == nil: return + assert(counter.kind == nkIdent) + for i in countup(0, sonsLen(p.lastVarSection) - 1): + var v = p.lastVarSection.sons[i] + for j in countup(0, sonsLen(v) - 3): + if v.sons[j].ident.id == counter.ident.id: + delSon(v, j) + if sonsLen(v) <= 2: + delSon(p.lastVarSection, i) + return + +proc parseBegin(p: var TPasParser, result: PNode) = + getTok(p) + while true: + case p.tok.xkind + of pxComment: addSon(result, parseStmt(p)) + of pxSymbol: + if not fixExit(p, result): addSon(result, parseStmt(p)) + of pxEnd: + getTok(p) + break + of pxSemicolon: getTok(p) + of pxEof: parMessage(p, errExprExpected) + else: addSonIfNotNil(result, parseStmt(p)) + if sonsLen(result) == 0: addSon(result, newNodeP(nkNilLit, p)) + +proc parseStmt(p: var TPasParser): PNode = + var oldcontext = p.context + p.context = conStmt + result = nil + case p.tok.xkind + of pxBegin: + result = newNodeP(nkStmtList, p) + parseBegin(p, result) + of pxCommand: result = parseCommand(p) + of pxCurlyDirLe, pxStarDirLe: + if isHandledDirective(p): result = parseDirective(p) + of pxIf: result = parseIf(p) + of pxWhile: result = parseWhile(p) + of pxRepeat: result = parseRepeat(p) + of pxCase: result = parseCase(p) + of pxTry: result = parseTry(p) + of pxProcedure, pxFunction: result = parseRoutine(p) + of pxType: result = parseTypeSection(p) + of pxConst: result = parseConstSection(p) + of pxVar: result = parseVar(p) + of pxFor: + result = parseFor(p) + fixVarSection(p, result.sons[0]) + of pxRaise: result = parseRaise(p) + of pxUses: result = parseUsesStmt(p) + of pxProgram, pxUnit, pxLibrary: + # skip the pointless header + while not (p.tok.xkind in {pxSemicolon, pxEof}): getTok(p) + getTok(p) + of pxInitialization: getTok(p) # just skip the token + of pxImplementation: + p.section = seImplementation + result = newNodeP(nkCommentStmt, p) + result.comment = "# implementation" + getTok(p) + of pxInterface: + p.section = seInterface + getTok(p) + of pxComment: + result = newNodeP(nkCommentStmt, p) + skipCom(p, result) + of pxSemicolon: getTok(p) + of pxSymbol: + if p.tok.ident.id == getIdent("break").id: + result = newNodeP(nkBreakStmt, p) + getTok(p) + skipCom(p, result) + addSon(result, nil) + elif p.tok.ident.id == getIdent("continue").id: + result = newNodeP(nkContinueStmt, p) + getTok(p) + skipCom(p, result) + addSon(result, nil) + elif p.tok.ident.id == getIdent("exit").id: + result = newNodeP(nkReturnStmt, p) + getTok(p) + skipCom(p, result) + addSon(result, nil) + else: + result = parseExprStmt(p) + of pxDot: getTok(p) # BUGFIX for ``end.`` in main program + else: result = parseExprStmt(p) + opt(p, pxSemicolon) + if result != nil: skipCom(p, result) + p.context = oldcontext + +proc parseUnit(p: var TPasParser): PNode = + result = newNodeP(nkStmtList, p) + getTok(p) # read first token + while true: + case p.tok.xkind + of pxEof, pxEnd: break + of pxBegin: parseBegin(p, result) + of pxCurlyDirLe, pxStarDirLe: + if isHandledDirective(p): addSon(result, parseDirective(p)) + else: parMessage(p, errXNotAllowedHere, p.tok.ident.s) + else: addSon(result, parseStmt(p)) + opt(p, pxEnd) + opt(p, pxDot) + if p.tok.xkind != pxEof: + addSon(result, parseStmt(p)) # comments after final 'end.' + |