' This is file h_2_bi_Macros.bas
' (C) 2010-2011 by TJF, GPLv3
' It's part of 'h_2_bi.bas' package, see for details:
' http://www.freebasic.net/forum/viewtopic.php?t=15364&postdays=0&postorder=asc&start=0

TYPE Macros
  AS RepData Def ' Macros
  DECLARE CONSTRUCTOR(BYREF T AS STRING, BYVAL O AS Options PTR, BYVAL E AS ErrorHandler PTR)
  DECLARE FUNCTION expand(BYREF T AS STRING, BYREF Bl AS STRING, BYVAL St AS INTEGER = 0) AS STRING
  DECLARE FUNCTION getParList(BYREF T AS STRING, BYREF I AS INTEGER, _
                              BYVAL Lt AS INTEGER, Pa() AS STRING) AS INTEGER
Private:
  AS ErrorHandler PTR Er
  AS Options PTR Op
  DECLARE FUNCTION check(BYREF T AS STRING, BYREF W AS STRING, _
                         BYREF I AS INTEGER, BYVAL Lt AS INTEGER, _
                         BYREF Bl AS STRING) AS STRING
END TYPE

#MACRO Macros_Check_Para()
  IF l THEN
    VAR n = MID(r, i - l + 1, l)
    FOR j AS INTEGER = UBOUND(Pa) TO 0 STEP -1
      IF n = Pa(j) THEN
        VAR z = MID(r, a + 1, i - a - l)
        VAR y = LTRIM(z, TRIMM)
        IF LEFT(y, 2) = "##" THEN z = LTRIM(MID(y, 3), TRIMM)
        y = RTRIM(z, TRIMM)
        IF RIGHT(y, 2) = "##" THEN z = RTRIM(LEFT(y, LEN(y) - 2), TRIMM)
        VAR l = LEN(q)
        IF MID(q, l, 1) = "#" THEN z = """" & z : MID(q, l, 1) = """"
        re &= MKI(LEN(z)) & MKI(j)
        q &= z
        az += 1
        a = i
        EXIT FOR
      END IF
    NEXT
  END IF
#ENDMACRO

CONSTRUCTOR Macros(BYREF T AS STRING, BYVAL O AS Options PTR, BYVAL E AS ErrorHandler PTR)
  Op = O
  Er = E
  VAR aa = 0, ee = 5
  DO
    aa = ee + 1 : ee = INSTR(aa, T, CHR(1)) : IF ee <= aa THEN EXIT DO
    VAR r = MID(T, aa, ee - aa) : Kompri(r)
    VAR lr = LEN(r) - 1, i = 0
    VAR re = nextWord(r, i)
    IF re <> "define" THEN ? "Macro without 'define'" & r : CONTINUE DO
    VAR se = nextWord(r, i) : i = skipTrenn(r, i, lr)
    IF i >= lr THEN '                                        empty macro
      re = MKI(0) & MKI(0)
    ELSEIF r[i] <> ASC("(") THEN '              macro without parameters
      re = MKI(0) & MKI(0) & MID(r, i + 1)
    ELSE '                                         macro with parameters
      REDIM AS STRING pa(0)
      VAR az = getParList(r, i, lr, pa())
      IF az = 0 THEN
        re = MKI(0) & MKI(0)
        ? "Error in macro parameter definition:" & NL & r : CONTINUE DO
      END IF : re = MKI(az) & MKI(0) : az = 0
      VAR a = i, l = 0, q = ""
      FOR i = a TO lr + 1'                          get macro definition
        SELECT CASE AS CONST CHAR_TYP(r[i]) + 5
        CASE 0 TO 2 : l += 1 '                            name character
        CASE 3 : IF l THEN l += 1 '                               number
        CASE ELSE
          IF l THEN
            VAR n = MID(r, i - l + 1, l)
            FOR j AS INTEGER = UBOUND(Pa) TO 0 STEP -1
              IF n = Pa(j) THEN
                VAR z = MID(r, a + 1, i - a - l)
                VAR y = LTRIM(z, TRIMM)
                IF LEFT(y, 2) = "##" THEN z = LTRIM(MID(y, 3), TRIMM)
                y = RTRIM(z, TRIMM)
                IF RIGHT(y, 2) = "##" THEN z = RTRIM(LEFT(y, LEN(y) - 2), TRIMM)
                VAR l = LEN(q)
                IF MID(q, l, 1) = "#" THEN z = """" & z : MID(q, l, 1) = """"
                re &= MKI(LEN(z)) & MKI(j)
                q &= z
                az += 1
                a = i
                EXIT FOR
              END IF
            NEXT
          END IF
          IF CHAR_TYP(r[i]) = 3 THEN i = findBlockEnd(r, i, lr) : IF i < 0 THEN EXIT FOR
          l = 0
        END SELECT
      NEXT : MID(re, 5, 4) = MKI(az)
      VAR z = MID(r, a + 1), y = LTRIM(z, TRIMM)
      IF LEFT(y, 2) = "##" THEN z = LTRIM(MID(y, 3), TRIMM)
      re &= q & z
    END IF : VAR z = Def.add(se, re) : IF z THEN ? "Error: macro '" & se & "' " & *z
  LOOP
END CONSTRUCTOR

' sets I behind par list, returns parameter number (<0: variadic)
' liest die Eintraege der Parameter Liste in vordimensionierte Feld Pa()
FUNCTION Macros.getParList(BYREF T AS STRING, BYREF I AS INTEGER, _
                           BYVAL Lt AS INTEGER, Pa() AS STRING) AS INTEGER
  VAR a = I + 2, n = UBOUND(Pa), kl = 0
  FOR j AS INTEGER = I + 1 TO Lt
    SELECT CASE AS CONST T[j]
    CASE ASC("(") : kl += 1
    CASE ASC(")") : kl -= 1 : IF kl = -1 THEN I = j + 1 : EXIT FOR
    CASE ASC(",")
      Pa(n) = TRIM(MID(T, a, j - a + 1), TRIMM)
      n += 1 : REDIM PRESERVE AS STRING Pa(n)
      a = j + 2
    END SELECT
  NEXT : Pa(n) = TRIM(MID(T, a, I - a), TRIMM)
  RETURN IIF(Pa(n) = "...", -n, n + 1)
END FUNCTION

' checks if word is macro name, returns macro expansion or word
' prueft ob ein Wort ein Makroname ist, liefert Expansion, sonst Wort
FUNCTION Macros.check(BYREF T AS STRING, BYREF W AS STRING, _
                      BYREF I AS INTEGER, BYVAL Lt AS INTEGER, _
                      BYREF Bl AS STRING) AS STRING
  VAR p = Def.rep(W) : IF p = SADD(W) THEN RETURN W '           no macro
  IF STACK_FIN(Bl, W) = 0 THEN STACK_ADD(Bl, W) ELSE RETURN W ' already done
  VAR r = "", q = CAST(INTEGER PTR, p), az = *q
  IF az = 0 THEN '                                         no parameters
    IF p[8] = 0 THEN RETURN "" '                             empty macro
    r = *(p + 8)
  ELSE '                                       macro with parameter list
    VAR p2 = skipTrenn(T, I, Lt) : IF p2 >= I THEN I = p2 ELSE RETURN W
    IF T[I] <> ASC("(") THEN RETURN W '                no parameter list

    REDIM AS STRING pa(0)
    VAR ii = i, neu = getParList(T, I, Lt, pa())
    IF az >= 0 THEN
      IF neu <> az THEN I = ii : Er->E.PANR = 1 : RETURN W
    ELSE
      az = ABS(az) - 1
      IF ABS(neu) <= az THEN I = ii : Er->E.PANR = 1 : RETURN W
      FOR j AS INTEGER = az + 1 TO UBOUND(pa) ' collect pars for ellipsis
        pa(az) &= ", " & pa(j)
      NEXT
    END IF

    VAR l = 0, n = 0
    q += 1 : az = *q : p += 8 * (az + 1)
    FOR j AS INTEGER = 1 TO az '                run through macro blocks
      q += 1 : l = *q : q += 1 : n = *q
      r &= LEFT(*p, l) & pa(n)
      p += l
    NEXT : r &= *p
  END IF : IF Op->T.MA = 0 THEN RETURN r
  IF ASC(r) THEN Kompri(r) : IF LEN(r) THEN RETURN expand(r, Bl)
  RETURN ""
END FUNCTION

' searches for words in T, expands macros
' sucht Worte in T, expandiert ggf. Makros
FUNCTION Macros.expand(BYREF T AS STRING, BYREF Bl AS STRING, _
                       BYVAL St AS INTEGER = 0) AS STRING
  VAR lt = LEN(T) - 1, r = "", l = 0, i = St
  WHILE i <= lt
    SELECT CASE AS CONST CHAR_TYP(T[i]) + 5
    CASE 0 TO 2 : l += 1 '                                 "_", A-Z, a-z
    CASE 3 : IF l THEN l += 1 ELSE r &= CHR(T[i]) '                0 - 9
    CASE ELSE
      IF l THEN
        r &= check(T, MID(T, i - l + 1, l), i, lt, Bl)
        l = 0 : i -= 1
      ELSE
        r &= CHR(T[i])
      END IF
    END SELECT : i += 1
  WEND : IF l = 0 THEN RETURN r
  RETURN r & check(T, MID(T, i - l + 1), i, lt, Bl)
END FUNCTION