-- This file:
--      http://angg.twu.net/LUA/middle-c.lua.html
--      http://angg.twu.net/LUA/middle-c.lua
--              (find-angg "LUA/middle-c.lua")
-- This is an attempt to implement the ideas in:
--      http://angg.twu.net/peek.html
--   file:///home/edrx/TH/L/peek.html
--                (find-TH "peek")
-- Status: this is just a proof of concept.
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011jan06
-- License: GPL3

-- See also:
--   (find-angg "DAVINCI/peek.c")
--   (find-angg "DAVINCI/peek.lua")
--   (find-angg "DAVINCI/peek-luadecls-1.txt")
--   (find-angg "DAVINCI/peek-luadecls-2.txt")
--                (find-TH "davinci" "peek.lua")
--      http://angg.twu.net/davinci.html#peek.lua
--   file:///home/edrx/TH/L/davinci.html#peek.lua

-- Motivation:
-- The Lua interpreter has some internal data structures that I
-- do not understand well enough - namely: prototypes, stack
-- frames, coroutines, and threads. Using this and peek.c we
-- should be able to inspect these data structures from inside a
-- running Lua; also, it shouldn't be hard to implement another
-- way to access stack frames - by pointing directly to the frame
-- instead of referring to it using a thread and a level.
-- (find-lua51src "lobject.h" "Proto")
-- (find-lua51src "lobject.h" "UpVal")
-- (find-lua51src "lvm.c" "luaV_execute" "OP_TAILCALL")
-- (find-lua51src "ldo.c")
-- (find-lua51src "ldo.h")
-- (find-luamanualw3m "#pdf-debug.getinfo")
-- (find-luamanualw3m "#pdf-debug.getlocal")
-- (find-luamanualw3m "#pdf-debug.traceback")
-- (find-lua51src "ldblib.c" "dblib")
-- (find-lua51src "ldblib.c" "db_getinfo")
-- (find-lua51src "ldblib.c" "db_getlocal")
-- (find-lua51src "ldblib.c" "db_errorfb")




-- Quick index:
-- «.Class»		(to "Class")
-- «.classes»		(to "classes")
-- «.C___Type»		(to "C___Type")
-- «.C___TypeFrom»	(to "C___TypeFrom")
-- «.test-2-output»	(to "test-2-output")


-- (find-es "lua5" "setvbuf")
io.stdout:setvbuf("no")  -- sync errors

-- (defun c () (interactive) (find-sh "lua51 ~/LUA/middle-c.lua"))
-- (find-angg "LUA/lua50init.lua" "userocks")
userocks()
require "lpeg"


--- «Class»  (to ".Class")
--- A very simple object system.
-- See: (find-angg "LUA/canvas2.lua" "Class")
--      (find-dn5 "eoo.lua")
smt = setmetatable
gmt = getmetatable
Class = {
    type   = "Class",
    __call = function (class, o) return setmetatable(o, class) end,
  }
setmetatable(Class, Class)
otype = function (o)
    local mt = getmetatable(o)
    return mt and mt.type or type(o)
  end



--- «classes»  (to ".classes")
--- «C___Type»  (to ".C___Type")
--- The classes for Middle-C types.
-- Structs, unions, enums, functions and typedefs will come later.
CPrimType = Class {     -- Middle-C primitive type
  type    = "CPrimType",
  __index = {
  },
}
CArrayType = Class {    -- Middle-C array type
  type    = "CArrayType",
  __index = {
  },
}
CStarType = Class {    -- Middle-C star type
  type    = "CStarType",
  __index = {
  },
}



--- «C___TypeFrom»  (to ".C___TypeFrom")
--- Low-level functions to create types.
-- Note that "basetype" is always a string.
types = {}
CPrimTypeFrom = function (name, size, align)
    types[name] = CPrimType { name = name, size = size, align = align }
    return types[name]
  end
CArrayTypeFrom = function (name, basetype, n)
    -- PP("CArrayTypeFrom", name, basetype, n)
    if not types[basetype].size then
      error("Can't create "..name.." - the base type has no sizeof")
    end
    types[name] = CArrayType {
      name     = name,
      basetype = basetype,
      size     = n and (types[basetype].size * n),
      align    = types[basetype].align,
    }
    return types[name]
  end
CStarTypeFrom = function (name, basetype)
    types[name] = CStarType {
      name     = name,
      basetype = basetype,
      size     = 4,
      align    = 4,
    }
    return types[name]
  end



--- Create a few primitive types.
CPrimTypeFrom("char",   1, 1)
CPrimTypeFrom("short",  2, 2)
CPrimTypeFrom("ushort", 2, 2)
CPrimTypeFrom("int",    4, 4)
CPrimTypeFrom("uint",   4, 4)
CPrimTypeFrom("void",   nil, nil)



--- High-level functions to create types.
-- They are all based on a tricky LPeg pattern - MType - that
-- processes parts of a middle-C type...
-- (find-es "lua5" "lpeg-quickref")
MType = function (fsetsubj, fbase, farr, fstar)
    local Alpha_, Alpha_num, Base, Arr, Star
    Alpha_    = lpeg.R("AZ", "az", "__")
    Alpha_num = lpeg.R("AZ", "az", "__", "09")
    Base      = (Alpha_ * Alpha_num^0) / fbase
    Arr       = (lpeg.P"[" * (lpeg.R("09")^0):C() * lpeg.P"]" * lpeg.Cp()) / farr
    Star      = (lpeg.P"*" * lpeg.Cp()) / fstar
    -- Note that the patterns above are local, but MType is not...
    -- The effect of this function is to define MType globally,
    -- using the current values of the functions fsetsubj,
    -- fbase, farr, fstar.
    return  lpeg.P(fsetsubj) * Base * (Arr + Star)^0
  end


-- Test 0.
print "-------"
print "Test 0:"
fsetsubj = function (...) PP("setsubj", ...); return 1 end
fbase    = function (...) PP("fbase", ...) end
farr     = function (...) PP("farr",  ...) end
fstar    = function (...) PP("fstar", ...) end
PP(MType(fsetsubj, fbase, farr, fstar):match("char[23][4][]*[5]"))


-- Test 1.
print "-------"
print "Test 1:"
fsetsubj = function (s, pos) subj = s; return 1 end
fbase    = function (name)   PP(name, "fbase") end
farr     = function (s, pos) PP(subj:sub(1, pos-1), "farr", s) end
fstar    = function (pos)    PP(subj:sub(1, pos-1), "fstar") end
PP(MType(fsetsubj, fbase, farr, fstar):match("char[23][4][]*[5]"))
-- Output:
-- "char" "fbase"
-- "char[23]" "farr" "23"
-- "char[23][4]" "farr" "4"
-- "char[23][4][]" "farr" ""
-- "char[23][4][]*" "fstar"
-- "char[23][4][]*[5]" "farr" "5"
-- 18




-- Test 2.
print "-------"
print "Test 2:"
temptype = nil
fsetsubj = function (s, pos) tempsubj = s; return 1 end
fbase    = function (name)   temptype = types[name] or error("nbt: "..name) end
farr     = function (s, pos)
    local name = tempsubj:sub(1, pos-1)
    temptype = types[name] or CArrayTypeFrom(name, temptype.name, tonumber(s))
  end
fstar    = function (pos)
    local name = tempsubj:sub(1, pos-1)
    temptype = types[name] or CStarTypeFrom(name, temptype.name)
  end
tempMType = MType(fsetsubj, fbase, farr, fstar)
PP(tempMType:match("char[23][4][]*[5]"))    --> output: 18
sorted = function (tbl, f) table.sort(tbl, f); return tbl end
for _,k in ipairs(sorted(keys(types))) do
  PP(k, types[k])
end
-- «test-2-output»  (to ".test-2-output")
-- Output:
-- "char" {"align"=1, "name"="char", "size"=1}
-- "char[23]" {"align"=1, "basetype"="char", "name"="char[23]", "size"=23}
-- "char[23][4]" {"align"=1, "basetype"="char[23]", "name"="char[23][4]", "size"=92}
-- "char[23][4][]" {"align"=1, "basetype"="char[23][4]", "name"="char[23][4][]"}
-- "char[23][4][]*" {"align"=4, "basetype"="char[23][4][]", "name"="char[23][4][]*", "size"=4}
-- "char[23][4][]*[5]" {"align"=4, "basetype"="char[23][4][]*", "name"="char[23][4][]*[5]", "size"=20}
-- "int" {"align"=4, "name"="int", "size"=4}
-- "short" {"align"=2, "name"="short", "size"=2}
-- "uint" {"align"=4, "name"="uint", "size"=4}
-- "ushort" {"align"=2, "name"="ushort", "size"=2}
-- "void" {"name"="void"}





-- (find-sh "lua51 ~/LUA/middle-c.lua")
print "ok"






-- Local Variables:
-- coding:  raw-text-unix
-- modes:   (fundamental-mode lua-mode)
-- End: