3DICC / SqueakNim

import macros
# Note: Since we combine -d:useNimRtl with this module, we cannot use strutils.
# So we use our own helper procs here:

proc toUpper(c: char): char =
  result = if c in {'a'..'z'}: chr(c.ord - 'a'.ord + 'A'.ord) else: c

proc capitalize(s: string): string {.noSideEffect.} =
  result = toUpper(s[0]) & substr(s, 1)

proc invalidFormatString() {.noinline.} =
  raise newException(ValueError, "invalid format string")

proc addf(s: var string, formatstr: string, a: varargs[string, `$`]) =
  ## The same as ``add(s, formatstr % a)``, but more efficient.
  const PatternChars = {'a'..'z', 'A'..'Z', '0'..'9', '\128'..'\255', '_'}
  var i = 0
  var num = 0
  while i < len(formatstr):
    if formatstr[i] == '$':
      case formatstr[i+1] # again we use the fact that strings
                          # are zero-terminated here
      of '#':
        if num >% a.high: invalidFormatString()
        add s, a[num]
        inc i, 2
        inc num
      of '$':
        add s, '$'
        inc(i, 2)
      of '1'..'9', '-':
        var j = 0
        inc(i) # skip $
        var negative = formatstr[i] == '-'
        if negative: inc i
        while formatstr[i] in {'0'..'9'}:
          j = j * 10 + ord(formatstr[i]) - ord('0')
          inc(i)
        let idx = if not negative: j-1 else: a.len-j
        if idx >% a.high: invalidFormatString()
        add s, a[idx]
      else:
        invalidFormatString()
    else:
      add s, formatstr[i]
      inc(i)

proc `%`(formatstr: string, a: openArray[string]): string =
  result = newStringOfCap(formatstr.len + a.len shl 4)
  addf(result, formatstr, a)

proc `%`(formatstr, a: string): string =
  result = newStringOfCap(formatstr.len + a.len)
  addf(result, formatstr, [a])

proc format(formatstr: string, a: varargs[string, `$`]): string =
  result = newStringOfCap(formatstr.len + a.len)
  addf(result, formatstr, a)


const
  pragmaPos = 4
  paramPos = 3
  intType = when sizeof(int) == 8: "longlong" else: "long"
  uintType = when sizeof(int) == 8: "ulonglong" else: "ulong"

var
  dllName {.compileTime.}: string = "SqueakNimTest"
  stCode {.compileTime.}: string = ""
  gPrefix {.compileTime.}: string = ""

template setModulename*(s, prefix: string) =
  ## Sets the DLL name. This is also used to set the 'category' in the generated
  ## classes. 'prefix' is added to every generated class that wraps a Nim
  ## object.
  static:
    dllName = s
    gPrefix = prefix

template writeExternalLibrary*() =
  static:
    addf(stCode, "ExternalLibrary subclass: #$1\C" &
                 "\tinstanceVariableNames: ''\C" &
                 "\tclassVariableNames: ''\C" &
                 "\tpoolDictionaries: ''\C" &
                 "\tcategory: '$2'!\C" &
                 "!$1 class methodsFor: 'primitives' stamp: 'SqueakNim'!\C",
      gPrefix & capitalize(dllName), capitalize(dllName))

template writeSmallTalkCode*(filename: string) =
  ## You need to invoke this template to write the produced SmallTalk code to
  ## a file.
  static:
    writeFile(filename, stCode)

proc mapTypeToC(symbolicType: NimNode): string {.compileTime.} =
  if symbolicType.kind == nnkEmpty: return "void"
  let t = symbolicType.getType
  if symbolicType.kind == nnkSym and t.typeKind == ntyObject:
    return gPrefix & $symbolicType
  case t.typeKind
  of ntyPtr, ntyVar:
    expectKind t, nnkBracketExpr
    result = mapTypeToC(t[1]) & "*"
  of ntyArray:
    expectKind t, nnkBracketExpr
    result = mapTypeToC(t[2]) & "*"
  of ntyCString: result = "char*"
  of ntyPointer: result = "void*"
  of ntyInt: result = intType
  of ntyInt8: result = "sbyte"
  of ntyInt16: result = "short"
  of ntyInt32: result = "long"
  of ntyInt64: result = "longlong"
  of ntyUInt: result = uintType
  of ntyUInt8: result = "ubyte"
  of ntyUInt16: result = "ushort"
  of ntyUInt32: result = "ulong"
  of ntyUInt64: result = "ulonglong"
  of ntyFloat, ntyFloat64: result = "double"
  of ntyFloat32: result = "float"
  of ntyBool, ntyChar, ntyEnum: result = "char"
  else: quit "Error: cannot wrap to Squeak " & treeRepr(t)

macro exportSt*(body: stmt): stmt =
  # generates something like:

  # system: aString
  #"Some kind of comment"
  #
  #   <apicall: long 'system' (char*) module: 'libSystem.dylib'>
  #   ^self externalCallFailed.
  result = body
  result[pragmaPos].add(ident"exportc", ident"dynlib", ident"cdecl")
  let params = result[paramPos]
  let procName = $result[0]
  var st = procName
  #echo treeRepr params
  if params.len > 1:
    expectKind params[1], nnkIdentDefs
    let ident = $params[1][0]
    if ident.len > 1:
      st.add(ident.capitalize & ": " & ident)
    else:
      st.add(": " & ident)
  # return type:
  var apicall = "<cdecl: " & mapTypeToC(params[0]) & " '" &
               procName & "' ("
  var counter = 0
  # parameter types:
  for i in 1.. <params.len:
    let param = params[i]
    let L = param.len
    for j in 0 .. param.len-3:
      let name = param[j]
      let typ = param[L-2]
      if counter > 0:
        apicall.add(" ")
        st.addf(" $1: $1", name)
      apicall.add(mapTypeToC(typ))
      inc counter
  apicall.add(") module: '" & dllName & "'>\C" &
              "\t^self externalCallFailed\C!\C\C")
  stCode.add(st & "\C\t\"Generated by NimSqueak\"\C\t" & apicall)

macro wrapObject*(typ: stmt): stmt =
  ## Declares a SmallTalk wrapper class.
  var t = typ.getType()
  if t.typeKind == ntyTypeDesc:
    expectKind t, nnkBracketExpr
    t = t[1]
  expectKind t, nnkSym
  let name = gPrefix & ($t).capitalize
  if t.kind != nnkObjectTy: t = t.getType
  expectKind t, nnkObjectTy
  t = t[1]
  expectKind t, nnkRecList
  var fields = ""
  for i in 0.. < t.len:
    expectKind t[i], nnkSym
    fields.addf "\t\t($# '$#')\C", $t[i], mapTypeToC(t[i])

  let st = ("ExternalStructure subclass: #$1\C" &
    "\tinstanceVariableNames: ''\C" &
    "\tclassVariableNames: ''\C" &
    "\tpoolDictionaries: 'FFIConstants'\C" &
    "\tcategory: '$2'!\C\C" &
    "$1 class\C" &
    "\tinstanceVariableNames: ''!\C\C" &
    "!$1 class methodsFor: 'field definition' stamp: 'SqueakNim'!\C" &
    "\tfields\C" &
    "\t^#(\C" &
    "$3\C" &
    "\t)! !\C" &
    "$1 defineFields.\C!\C\C") % [name, capitalize(dllName), fields]
  stCode.add(st)
  result = newStmtList()