big repo cleanup

compiler/pas2nim/pas2nim.cfg

@@ -0,0 +1,4 @@
+# Use the modules of the compiler
+
+path: "$nimrod/compiler"
+

compiler/pas2nim/pas2nim.nim

@@ -0,0 +1,64 @@
+#
+#
+#      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 
+  strutils, os, parseopt, llstream, ast, rnimsyn, options, msgs,
+  paslex, pasparse
+
+const
+  Version = "0.8"
+  Usage = """
+pas2nim - Pascal to Nimrod source converter
+  (c) 2010 Andreas Rumpf
+Usage: pas2nim [options] inputfile [options]
+Options: 
+  -o, --out:FILE         set output filename
+  --ref                  convert ^typ to ref typ (default: ptr typ)
+  --boot                 use special translation rules for the Nimrod compiler
+  -v, --version          write pas2nim's version
+  -h, --help             show this help
+"""
+
+proc main(infile, outfile: string, flags: set[TParserFlag]) = 
+  var stream = LLStreamOpen(infile, fmRead)
+  if stream == nil: rawMessage(errCannotOpenFile, infile)
+  var p: TParser
+  openParser(p, infile, stream, flags)
+  var module = parseUnit(p)
+  closeParser(p)
+  renderModule(module, outfile)
+
+var
+  infile = ""
+  outfile = ""
+  flags: set[TParserFlag] = {}
+for kind, key, val in getopt():
+  case kind
+  of cmdArgument: infile = key
+  of cmdLongOption, cmdShortOption:
+    case key
+    of "help", "h":
+      stdout.write(Usage)
+      quit(0)
+    of "version", "v":
+      stdout.write(Version & "\n")
+      quit(0)
+    of "o", "out": outfile = key
+    of "ref": incl(flags, pfRefs)
+    of "boot": flags = flags + {pfRefs, pfMoreReplacements, pfImportBlackList}
+    else: stdout.write("[Error] unknown option: " & key)
+  of cmdEnd: assert(false)
+if infile.len == 0:
+  # no filename has been given, so we show the help:
+  stdout.write(Usage)
+else:
+  if outfile.len == 0:
+    outfile = changeFileExt(infile, "nim")
+  infile = addFileExt(infile, "pas")
+  main(infile, outfile, flags)

compiler/pas2nim/paslex.nim

@@ -0,0 +1,570 @@
+#
+#
+#      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, llstream
+
+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
+  TTokKind* = 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
+  TTokKinds* = set[TTokKind]
+
+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
+  TNumericalBase* = enum base10, base2, base8, base16
+  TToken* = object
+    xkind*: TTokKind          # 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
+  
+  TLexer* = object of TBaseLexer
+    filename*: string
+  
+
+proc getTok*(L: var TLexer, tok: var TToken)
+proc PrintTok*(tok: TToken)
+proc `$`*(tok: TToken): string
+# implementation
+
+var
+  dummyIdent: PIdent
+  gLinesCompiled: int
+
+proc fillToken(L: var TToken) = 
+  L.xkind = pxInvalid
+  L.iNumber = 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.filename = filename
+
+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.GenericMessage(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.GenericMessage(info, msg, arg)
+
+proc TokKindToStr*(k: TTokKind): string =
+  case k
+  of pxEof: result = "[EOF]"
+  of firstKeyword..lastKeyword:
+    result = keywords[ord(k)-ord(firstKeyword)]
+  of pxInvalid, pxComment, pxStrLit: result = "string literal"
+  of pxCommand: result = "{@"
+  of pxAmp: result = "{&"
+  of pxPer: result = "{%"
+  of pxSymbol: result = "identifier"
+  of pxIntLit, pxInt64Lit: result = "integer literal"
+  of pxFloatLit: result = "floating point literal"
+  of pxParLe: result = "("
+  of pxParRi: result = ")"
+  of pxBracketLe: result = "["
+  of pxBracketRi: result = "]"
+  of pxComma: result = ","
+  of pxSemiColon: result = ";"
+  of pxColon: result = ":"
+  of pxAsgn: result = ":="
+  of pxEquals: result = "="
+  of pxDot: result = "."
+  of pxDotDot: result = ".."
+  of pxHat: result = "^"
+  of pxPlus: result = "+"
+  of pxMinus: result = "-"
+  of pxStar: result = "*"
+  of pxSlash: result = "/"
+  of pxLe: result = "<="
+  of pxLt: result = "<"
+  of pxGe: result = ">="
+  of pxGt: result = ">"
+  of pxNeq: result = "<>"
+  of pxAt: result = "@"
+  of pxStarDirLe: result = "(*$"
+  of pxStarDirRi: result = "*)"
+  of pxCurlyDirLe: result = "{$"
+  of pxCurlyDirRi: result = "}"
+
+proc `$`(tok: TToken): string = 
+  case tok.xkind
+  of pxInvalid, pxComment, pxStrLit: result = tok.literal
+  of pxSymbol: result = tok.ident.s
+  of pxIntLit, pxInt64Lit: result = $tok.iNumber
+  of pxFloatLit: result = $tok.fNumber
+  else: result = TokKindToStr(tok.xkind)
+  
+proc PrintTok(tok: TToken) = 
+  writeln(stdout, $tok)
+
+proc setKeyword(L: var TLexer, tok: var TToken) = 
+  var x = binaryStrSearch(keywords, toLower(tok.ident.s))
+  if x < 0: tok.xkind = pxSymbol
+  else: tok.xKind = TTokKind(x + ord(firstKeyword))
+  
+proc matchUnderscoreChars(L: var TLexer, tok: var TToken, 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 TLexer, tok: var TToken) = 
+  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 TLexer, tok: var TToken) = 
+  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 TLexer, tok: var TToken) = 
+  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 TLexer, tok: var TToken) = 
+  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 TLexer, tok: var TToken) = 
+  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 TLexer, tok: var TToken) = 
+  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 TLexer, tok: var TToken) = 
+  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 TLexer, tok: var TToken) = 
+  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 TLexer, tok: var TToken) = 
+  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 getTok(L: var TLexer, tok: var TToken) = 
+  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)