-- This is the `blogme2-middle.lua' file of blogme2.
-- It contains the "middle layer" of the kernel of blogme2 - the
-- functions for parsing arguments, the main functions for defining
-- blogme words, and a handful of words.
-- Author and version: Eduardo Ochs <[email protected]>, 2005aug24
-- License: GPL.
-- (find-fline "INTERNALS")
-- (find-fline "blogme2-inner.lua")
-- (find-fline "blogme2-middle.lua")
-- (find-fline "blogme2-outer.lua")

----------[[ argument-parsing functions ]]----------

--;;
--;; vparse: parse and return val
--;; pparse: parse a string and print the result (for debugging)
--;;

vparse = function (tag) if parse(tag or "rest:string") then return val end end
pparse = function (str, tag) subj, pos = str, 0; print(vparse(tag)) end -- dbg

--;;
--;; typical argument-parsing functions
--;;

vword    = function () return vparse("bigword:eval") end
vrest    = function () parse("%s*"); return vparse("rest:string") end
vrest_a  = function () return vparse("rest:list") end               -- "array"
vrest_q  = function () parse("%s*"); return substring(pos, e) end   -- "quoted"

vargs1_  = function () return vrest() end
vargs2_  = function () return vword(), vrest() end
vargs3_  = function () return vword(), vword(), vrest() end
vargs4_  = function () return vword(), vword(), vword(), vrest() end

vargs1   = function () return vrest() or "" end
vargs2   = function () return vword(), vrest() or "" end
vargs3   = function () return vword(), vword(), vrest() or "" end
vargs4   = function () return vword(), vword(), vword(), vrest() or "" end

vargs1_a = function () return vrest_a() end
vargs2_a = function () return vword(), vrest_a() end
vargs3_a = function () return vword(), vword(), vrest_a() end
vargs4_a = function () return vword(), vword(), vword(), vrest_a() end

vargs1_q = function () return vrest_q() end
vargs2_q = function () return vword(), vrest_q() end
vargs3_q = function () return vword(), vword(), vrest_q() end
vargs4_q = function () return vword(), vword(), vword(), vrest_q() end

nop = function () end

_AA = {
  ["1"] =vargs1,   ["2"] =vargs2,   ["3"] =vargs3,   ["4"] =vargs4,
  ["1L"]=vargs1_a, ["2L"]=vargs2_a, ["3L"]=vargs3_a, ["4L"]=vargs4_a,
  ["1Q"]=vargs1_q, ["2Q"]=vargs2_q, ["3Q"]=vargs3_q, ["4Q"]=vargs4_q
}


----------[[ def - a simple high-level tool for defining heads ]]----------

--;;
--;; eval, expr, slambda, lambda, undollar
--;;
eval = function (body) return assert(loadstring(body))() end
expr = function (body) return assert(loadstring("return "..body))() end
slambda = function (arglist, body)           -- here body is made of statements
    return assert(loadstring(
      "return function ("..arglist..")\n"..body.."\nend"))()
  end
lambda = function (arglist, body)            -- here body is an expression
    return assert(loadstring(
      "return function ("..arglist..")\nreturn "..body.."\nend"))()
  end
undollar = function (str)
    str = string.gsub(str, "%$([a-z]+)", "\"..%1..\"")
    str = string.gsub(str, "%$(%b())",   "\"..%1..\"")
    str = string.gsub(str, "%$(%b[])", function (s)
        return "]]..("..strsub(s, 2, -2)..")..[["
      end)
    return str
  end

--;;
--;; def itself. Note that def is to be invoked from Lua code.
--;; Example: def [[ BF 1 str "<strong>$str</strong>" ]]
--;; runs as: _G["BF"] = function (str) return "<strong>"..str.."</strong>" end
--;;          _A["BF"] = _AA["1"] or _G["1"]
--;;
-- (find-luafile "src/lib/lstrlib.c" "case 's' : res = isspace(c)")
-- (find-node "(libc)Classification of Characters" "int isspace")
def = function (str)
    local _, __, name, aspec, arglist, body =
      string.find (str, "^%s*(%S+)%s+(%S+)%s+(%S+)%s(.*)")
    _G[name] = lambda(arglist, undollar(body))
    _A[name] = _AA[aspec] or _G[aspec]
      or error("Bad argument-parsing specificier: "..name.." "..aspec)
  end


----------[[ DEF - for defining blogme words in blogme ]]----------

--;; $, list, WITH and withvars.
--;; Blogme's "WITH" is similar to Elisp's "let".
--;; We use dynamic scoping because it is trivial to implement.
--;; See: (info "(elisp)Variable Scoping")
--;; Example of use:
--;;   [WITH [list a valueofa b valueofb]
--;;     a is [$ a], b is [$ b];
--;;     [WITH [list a othervalueofa b othervalueofb]
--;;       inside the sub-"WITH": a is [$ a], b is [$ b];]
--;;     outside again, a is [$ a], b is [$ b].
--;;   ]
--;; The above gets expanded to this (modulo whitespace):
--;;   a is valueofa, b is valueofb;
--;;     inside the sub-"WITH": a is othervalueofa, b is othervalueofb;
--;;   outside again, a is valueofa, b is valueofb.
--;;
_V = {}
def [[ $    1   varname  _V[varname] or ""              ]]
def [[ list 1L  arr      arr                            ]]
def [[ WITH nop noargs   withvars(vword(), vrest) or "" ]]
withvars = function (plist, code)
    local _Vbackups = {}
    for i=1,getn(plist),2 do
      local varname, value = plist[i], plist[i+1]
      tinsert(_Vbackups, {varname, _V[varname]})
      _V[varname] = value
    end
    local result = code()
    for i=getn(_Vbackups),1,-1 do
      local varname, value = _Vbackups[i][1], _Vbackups[i][2]
      _V[varname] = value
    end
    return result
  end

--;;
--;; withsubj, withvars_expand, zip: auxiliary functions used by DEF
--;;
withsubj = function (newsubj, code)
    local oldsubj, oldpos = subj, pos
    subj, pos = newsubj, 0
    local result = code()
    subj, pos = oldsubj, oldpos
    return result
  end
withvars_expand = function (plist, text)
    return withvars(plist, function () return
        withsubj(text, vparse)
      end)
  end
zip = function (arr1, arr2)
    local arr12 = {}
    for i=1,getn(arr1) do
      tinsert(arr12, arr1[i])
      tinsert(arr12, arr2[i])
    end
    return arr12
  end

--;;
--;; DEF itself.
--;;
--;; Here's a simple example. This:
--;;   [DEF HREF   2 url,text   <a href="[$ url]">[$ str]</a>]
--;; runs like this:
--;;   HREF = function (url, text)
--;;       return withvars_expand({"url", url, "text", text},
--;;         "<a href=\"[$ url]\">[$ str]</a>")
--;;     end
--;;   _A["HREF"] = vargs2
--;; Note that the `[DEF ...]' construct is used inside blogme code, 
--;; while the `def [[...]]' construct is a Lua command.
--;; Let's dissect how the the definition of "DEF", below, works.
--;; First we transform the above into:
--;;   local wordname = "HREF"
--;;   local argparser = vargs2
--;;   local argnamelist = {"url", "text"}
--;;   local text = "<a href=\"[$ url]\">[$ str]</a>"
--;;   _G[wordname] = function (...)
--;;       return withvars_expand(zip(argnamelist, arg), text)
--;;     end
--;;   _A[wordname] = argparser
--;; And now it's easy to write the word DEF:
--;;
DEF = function (wordname, argparser_spec, argnames, text)
    local argparser = _AA[argparser_spec] or _G[argparser_spec]
    local argnamelist = split(argnames, "([^,]+)")
    _G[wordname] = function (...)
        return withvars_expand(zip(argnamelist, arg), text)
      end
    _A[wordname] = argparser
    return ""
  end
_A["DEF"] = vargs4_q


---------------------------------------------------------

-- (find-blogmefile "blogme.lua" "_G[\"lua:\"]")