src/squeaknim.nim

import macros, strutils
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
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: '$1'!
!$1 class methodsFor: 'primitives' stamp: 'SqueakNim'!
""", 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.} =
  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 ntyCString: result = "char*"
  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*(className: string; 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 & "'>\n" &
              "\t^self externalCallFailed.\n")
  stCode.add(st & "\n\t\"Generated by NimSqueak\"\n\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($# '$#')\n", $t[i], mapTypeToC(t[i])
  let st = """ExternalStructure subclass: #$1
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: 'FFIConstants'
    category: '$2'!
$1 class
   instanceVariableNames: ''!
  !$1 class methodsFor: 'field definition' stamp: 'SqueakNim'!
  fields
   ^#(
$3
   )! !
  $1 defineFields.
""" % [name, dllName, fields]
  stCode.add(st)
  result = newStmtList()