-- brackets.lua
-- version: 2004dec28

-- conventions:
-- %b[] - balanced [] block
-- %w - word constituent (everything but blanks chars and [ and ])
-- %s - space
-- %c - non-[] chars



_ = {}
FAIL = {"FAIL"}
FAILS    = function (f) _ = pack(f()); return _[1] == FAIL end
SUCCEEDS = function (f) _ = pack(f()); return _[1] ~= FAIL end

pat0 = function (patstr)
    local _, __, e = string.find(subj, patstr, pos)
    if _ then pos = e else return FAIL end
  end

wplus = function () return pat0("^[^ \t\n%[%]]+()") end
splus = function () return pat0("^[ \t\n]+()")      end
cplus = function () return pat0("^[^%[%]]+()")      end
block = function () return pat0("^%b[]()")          end

subjsubstr = function (b, e) return string.sub(subj, b, e-1) end

blockorwplus = function ()				-- %b[]|%w+
    if SUCCEDS(block) then return end
    if SUCCEDS(wplus) then return end
    return FAIL
  end
blockorwplus_plus = function ()				-- (%b[]|%w+)+
    if    FAILS(blockorwplus) then return FAIL end
    while SUCCEDS(blockorwplus) do end
    return pos
  end
blockorwplus_eval = function ()				-- (%b[]|%w+)+
    local b = pos
    if SUCCEEDS(block) then return evalblock(b, pos) end
    if SUCCEEDS(wplus) then return subjsubstr(b, pos) end
    return FAIL
  end
blockorwplus_eval_plus = function ()			-- (%b[]|%w+)+ ???
    if FAILS(blockorwplus_eval) then return FAIL end
    local result = _[1]
    while SUCCEEDS(blockorwplus_eval) do
      result = result .. _[1]
    end
    return result
  end
argument = function () splus(); return blockorwplus_eval_plus() end
arguments = function ()
    local arr = {}
    while SUCCEEDS(argument) do table.insert(arr, _[1]) end
    return arr
  end

evalblock = function (s, e)
    local oldpos = pos
    pos = s + 1
    if FAILS(argument) then error("Empty block") end
    local head, args = _[1], arguments()
    pos = oldpos
    local f = functions[head]
    return f(unpack(args))
  end



functions = {}
functions["<>"] = function (str) local s = "<"..str..">"; print(s); return s end
functions["PP"] = function (...) PP(unpack(arg)); return "_" end

subj = "foo bar[PP weep [<> blink]][<> aloo] b"
print(subj)
pos = 1
PP(22, argument())
PP(33, argument())


-- Notes:
-- if an evalblock returns FAIL then things will get VERY messy
--

gather_results = function ()
    local a = {}
    store = function (x) tinsert(a, x) end
    result = function () return a end
    return store, result
  end

stuff = function (gatheter, parsefunction)
    store, result = gatherer()
    while SUCCEEDS(parsefunction()) do store(_[1]) end
    return result()
  end 


pat0 = function (patstr)
    local _, __, e = string.find(subj, patstr, pos)
    if _ then pos = e else return FAIL end
  end

subjsubstr = function (b, e) return string.sub(subj, b, e-1) end
wplus = function () return pat0("^[^ \t\n%[%]]+()") end
splus = function () return pat0("^[ \t\n]+()")      end
cplus = function () return pat0("^[^%[%]]+()")      end
block = function () return pat0("^%b[]()")          end




--%%%%%
--%
--% versao nova
--%
--%%%%%

-- "r_" = "returning"
-- "ir

pack = function (...) return arg end
id   = function (...) return unpack(arg) end
nop  = function () end

looking_at = function (pat)
    return function ()
        local _, __, e = strfind(subj, pat, pos)
        if _ then pos = e; return true end
      end
  end

blanks    = looking_at("^[ \t\n]+()")
wordchars = looking_at("^[^ \t\n%[%]]+()")
bracket   = looking_at("^%b[]()")

OR = function (f1, f2)
    return function ()
        return f1() or f2()
      end
  end

PROG2 = function (f1, f2)
    return function ()
        f1()
        return f2()
      end
  end

r_string = function (f)
    return function ()
        local b = pos
        if f() then r = string.sub(subj, b, pos-1); return true end
      end
  end


--%%%%%
--%
--% gatherers for plus and star
--%
--%%%%%

gplus_concat = function ()
    local s
    return (function () s = r end),
           (function () s = s .. r end),
	   (function () return s end)
  end

gplus_list = function ()
    local a
    return (function () a = {r} end),
           (function () table.insert(a, r) end),
	   (function () return a end)
  end

gstar_concat = function ()
    local s
    return (function () if s then s = s .. r else s = r end),
	   (function () return s end)
  end

gstar_list = function ()
    local a = {}
    return (function () table.insert(a, r) end),
	   (function () return a end)
  end

gplus_nil = function () return nop, nop, nop end
gstar_nil = function () return nop, nop end

--%%%%%
--%
--% PLUS and STAR using the gatherer functions
--%
--%%%%%

r_gather_PLUS = function (gatherer, f)
    return function ()
        local addfirst, addmore, result = gatherer()
	if not f() then return false end
	addfirst()
	while f() do addmore() end
	r = result()
	return true
      end  
  end

r_gather_STAR = function (gatherer, f)
    return function ()
        local add, result = gatherer()
	while f() do add() end
	r = result()
	return true
      end  
  end

-- normalchars  (nao vou usar por enquanto)
-- (find-fline "~/elisp/lua-mode.el")




r_concat_PLUS = function (f)
    return function ()
	if not f() then return false end
        local newr = r
        while f() do newr = newr .. r end
        r = newr
        return true
      end
  end

r_list_STAR = function (f)
    return function ()
        local newr = {}
        while f() do table.insert(newr, r) end
        r = newr
        return true
      end
  end

r_string_bigword = r_concat_PLUS(OR(r_string(wordchars), r_string(bracket))

r_string(wordchars)

PROG2(blanks, argument

bigword = r_concat_PLUS(OR(r_string(wordchars), r_eval_bracket)
r_list_STAR = PROG2(blanks, 

starfs_concat = function ()
    local s = ""



STAR = function (f)
    return function ()
	while f() end
        return true
      end
  end

PLUS = function (f1, f2)
    f2 = f2 or f1
    return function ()
        if not f1() then return false end
        while f2() do end
        return true
      end
  end



init, add, ret