Warning: this is an htmlized version!
The original is across this link,
and the conversion rules are here.
#!/usr/bin/env lua5.1
---- This is a one-file version of dednat5, generated
---- automatically by build.lua on 2012Jun11 13:55 BRT. See:
----   http://angg.twu.net/dednat5/build.lua.html
----                {sp}(find-dn5 "build.lua")
----   http://angg.twu.net/dednat5/dednat5.lua.html
----                {sp}(find-dn5 "dednat5.lua")

---- Index to the modules:
-- «.common.lua»              (to "common.lua")
-- «.eoo.lua»                 (to "eoo.lua")
-- «.errors.lua»              (to "errors.lua")
-- «.prefixes.lua»            (to "prefixes.lua")
-- «.parse.lua»               (to "parse.lua")
-- «.preamble.lua»            (to "preamble.lua")
-- «.process.lua»             (to "process.lua")
-- «.treetex.lua»             (to "treetex.lua")
-- «.treesegs.lua»            (to "treesegs.lua")
-- «.treehead.lua»            (to "treehead.lua")
-- «.diagstacks.lua»          (to "diagstacks.lua")
-- «.diagtex.lua»             (to "diagtex.lua")
-- «.diagforth.lua»           (to "diagforth.lua")
-- «.diagmiddle.lua»          (to "diagmiddle.lua")
-- «.begriff.lua»             (to "begriff.lua")
-- «.repl.lua»                (to "repl.lua")
-- «.options.lua»             (to "options.lua")


---- From: (find-dn5 "common")
---- «common.lua»  (to ".common.lua")
---- This block is from: (find-dn5 "common.lua")
-- common.lua: functions from my LUA_INIT file.
-- This file:
--   http://angg.twu.net/dednat5/common.lua.html
--   http://angg.twu.net/dednat5/common.lua
--                    (find-dn5 "common.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011dec03
-- License: GPL3

-- (find-blogme4 "common.lua")
-- (find-angg "LUA/lua50init.lua" "PP")


-- «.readfile»		(to "readfile")
-- «.writefile»		(to "writefile")
-- «.split»		(to "split")
-- «.untabify»		(to "untabify")
-- «.printf»		(to "printf")
-- «.PP»		(to "PP")
-- «.pack-and-unpack»	(to "pack-and-unpack")
-- «.guill»		(to "guill")
-- «.gformat»		(to "gformat")
-- «.ee_template»	(to "ee_template")
-- «.errors»		(to "errors")



-- «readfile»  (to ".readfile")
-- «writefile»  (to ".writefile")
-- (find-angg "LUA/lua50init.lua" "readfile")
-- (find-angg "LUA/lua50init.lua" "writefile")
readfile = function (fname)
    local f = assert(io.open(fname, "r"))
    local bigstr = f:read("*a")
    f:close()
    return bigstr
  end
writefile = function (fname, bigstr)
    local f = assert(io.open(fname, "w+"))
    f:write(bigstr)
    f:close()
  end

-- (find-angg "LUA/lua50init.lua" "mapconcat")
map = function (f, arr, n)
    local brr = {}
    for i=1,(n or #arr) do table.insert(brr, f(arr[i])) end
    return brr
  end
mapconcat = function (f, tbl, sep) return table.concat(map(f, tbl), sep) end
nop = function () end
id  = function (...) return ... end

-- (find-luamanualw3m "#pdf-table.sort")
sorted = function (tbl, lt) table.sort(tbl, lt); return tbl end

-- «split»  (to ".split")
-- (find-angg "LUA/lua50init.lua" "split")
split = function (str, pat)
    local arr = {}
    string.gsub(str, pat or "([^%s]+)", function (word)
        table.insert(arr, word)
      end)
    return arr
  end

-- «untabify»  (to ".untabify")
-- (find-angg "LUA/lua50init.lua" "untabify")
-- Note: to untabify strings in encodings where chars can be more than
-- 1-byte long, change the "#" below... (I never had to do that,
-- though).
untabify_table =
  {"        ", "       ", "      ", "     ", "    ", "   ", "  ", " "}
--{"--------", "-------", "------", "-----", "----", "---", "--", "-"}
untabify_strtab = function (strbeforetab)
    return strbeforetab ..
      untabify_table[math.mod(#strbeforetab, 8) + 1]
  end
untabify = function (str)
    return (gsub(str, "([^\t\r\n]*)\t", untabify_strtab))
  end

-- (find-angg "LUA/lua50init.lua" "mytostring")
tos_compare_pairs = function (pair1, pair2)
    local key1,  key2  = pair1.key,  pair2.key
    local type1, type2 = type(key1), type(key2)
    if type1 == type2 then
      if type1 == "number" then return key1 < key2 end
      if type1 == "string" then return key1 < key2 end
      return tostring(key1) < tostring(key2)  -- fast
    else
      return type1 < type2   -- numbers before strings before tables, etc
    end
  end
tos_sorted_pairs = function (T)
    local Tpairs = {}
    for key,val in pairs(T) do
      table.insert(Tpairs, {key=key, val=val})
    end
    return sorted(Tpairs, tos_compare_pairs)
  end
tos_table_orig = function (T, sep)
    return "{"..mapconcat(tos_pair, tos_sorted_pairs(T), sep or ", ").."}"
  end
tos_table = tos_table_orig
tos = function (o)
    local t = type(o)
    if t=="number" then return tostring(o) end
    if t=="string" then return string.format("%q", o) end
    if t=="table"  then return tos_table(o) end
    return "<"..tostring(o)..">"
  end
tos_key = tos              -- change this to print string keys differently
tos_pair = function (pair)
    return tos_key(pair.key).."="..tos(pair.val)
  end

mysort = tos_sorted_pairs   -- compatibility
mytostring = tos            -- compatibility
mytostring_arg = function (T, sep)
    return mapconcat(tos, T, sep or " ", T.n)
  end

-- Tools for building extensions
tos_good_string_key = function (key)
    return type(key) == "string" and key:match("^[A-Za-z_][A-Za-z_0-9]*$")
  end
tos_has_tostring = function (o)
    return getmetatable(T) and getmetatable(T).__tostring
  end
tos_has_eootype = function (o)
    return type(o) == "table" and getmetatable(o) and getmetatable(o).type
  end


-- «printf»  (to ".printf")
-- (find-angg "LUA/lua50init.lua" "printf")
printf = function (...) io.write(string.format(...)) end


-- «PP»  (to ".PP")
-- (find-angg "LUA/lua50init.lua" "PP")
-- Examples:
--  PP(nil, true, false, 22, "22", "a\nb", print, nil)
-->   <nil> <true> <false> 22 "22" "a\
--    b" <function: 0x806b388> <nil>
--
--  PP({44, 55, nil, 77, [{a=11}]={[22]="b"}, [{}]={}, [{}]={}})
-->    {1=44, 2=55, 4=77, {"a"=11}={22="b"}, {}={}, {}={}}
--
PP = function (...)
    local arg = arg or pack(...)   -- for Lua 5.2
    for i=1,arg.n do printf(" %s", mytostring(arg[i])) end
    printf("\n")
    return myunpack(arg)    -- todo: change to "..." (a 5.1-ism)
  end


-- «pack-and-unpack»  (to ".pack-and-unpack")
-- (find-angg "LUA/lua50init.lua" "pack-and-unpack")
-- (find-luamanualw3m "#pdf-unpack")
pack     = table.pack or function (...) return arg end
unpack   = unpack or table.unpack
myunpack = function (arg) return unpack(arg, 1, arg.n) end


-- «guill»  (to ".guill")
-- «gformat»  (to ".gformat")
-- «ee_template»  (to ".ee_template")
-- (find-angg "LUA/lua50init.lua" "gformat")
-- (find-angg "LUA/lua50init.lua" "ee_template")
-- These are mostly for build.lua...
guill = function (str) return (str:gsub("<<", "\171"):gsub(">>", "\187")) end
gformat = function (fmt, pat)
    return function (str)
        return (str:gsub((pat or "^.*$"), fmt))
      end
  end
ee_template = function (pairs, templatestr)
    return (string.gsub(templatestr, "{([^{}]+)}", pairs))
  end


-- «errors»  (to ".errors")
-- (find-dn5 "errors.lua")








---- From: (find-dn5 "eoo")
---- «eoo.lua»  (to ".eoo.lua")
---- This block is from: (find-dn5 "eoo.lua")
-- eoo.lua: Edrx'x simple OO scheme.
-- This file:
--   http://angg.twu.net/dednat5/eoo.lua.html
--   http://angg.twu.net/dednat5/eoo.lua
--                    (find-dn5 "eoo.lua")
-- (find-tkdiff "~/blogme4/eoo.lua" "~/dednat5/eoo.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011nov21
-- License: GPL3
--
-- A very simple object system.
-- The metatable of each object points to its class,
-- and classes are callable, and act as creators.
-- New classes can be created with, e.g.:
--   Circle = Class { type = "Circle", __index = {...} }
-- then:
--   Circle {size = 1}
-- sets the metatable of the table {size = 1} to Circle,
-- and returns the table {size = 1} (with its mt modified).
--
-- Originally from: (find-angg "LUA/canvas2.lua"  "Class")
-- A tool:          (find-angg ".emacs.templates" "class")

-- «.test-eoo»		(to "test-eoo")
-- «.box-diagram»	(to "box-diagram")


Class = {
    type   = "Class",
    __call = function (class, o) return setmetatable(o, class) end,
  }
setmetatable(Class, Class)

otype = function (o)  -- works like type, except on my "objects"
    local  mt = getmetatable(o)
    return mt and mt.type or type(o)
  end


-- Code for inheritance (2011nov21), untested...
-- The examples of usage for this are coming soon!
over = function (uppertable)
    return function (lowertable)
        setmetatable(uppertable, {__index=lowertable})
        return uppertable
      end
  end

ClassOver = function (upperclassmt)
    return function (lowerclass)
        setmetatable(upperclassmt.__index, {__index=lowerclass.__index})
        return Class(upperclassmt)
      end
  end





---- From: (find-dn5 "errors")
---- «errors.lua»  (to ".errors.lua")
---- This block is from: (find-dn5 "errors.lua")
-- errors.lua:
-- This file:
--   http://angg.twu.net/dednat5/errors.lua.html
--   http://angg.twu.net/dednat5/errors.lua
--                    (find-dn5 "errors.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011feb27?
-- License: GPL3
--

-- require "eoo"         -- (find-dn5 "eoo.lua")

error_ = function (str)
    print((fname or "<nil>")..":"..(nline or "<nil>")..":"..(str or "?"))
    printf(" (find-fline %q %d)", (fname or "<nil>"), (nline or 0))
    error()
  end
Error = function (str) -- generic error
    error_(" "..(str or "?"))
  end
FError = function (str)  -- error in a Forth word
    error_((word or "<nil>")..": "..(str or "?"))
  end
FGetword = function (str)
    return getword() or FError(str or "missing argument")
  end


FGetword  = function () return getword() or FError("missing argument") end
FGetword1 = function () return getword() or FError("missing 1st argument") end
FGetword2 = function () return getword() or FError("missing 2nd argument") end




---- From: (find-dn5 "prefixes")
---- «prefixes.lua»  (to ".prefixes.lua")
---- This block is from: (find-dn5 "prefixes.lua")
-- prefixes.lua: handle expansions, abbrev tables and tables of prefixes.
-- This file:
--   http://angg.twu.net/dednat5/prefixes.lua.html
--   http://angg.twu.net/dednat5/prefixes.lua
--                    (find-dn5 "prefixes.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011apr10
-- License: GPL3
--

-- «.unabbrev»	(to "unabbrev")

-- (find-dn4 "dednat5.lua" "prefixes-and-ptables")
-- (find-dn4 "dednat5.lua" "heads")
-- (find-dn4 "dednat5.lua" "abbrevs")

-- We have two standard "prefix tables" in dednat5: abbrevs and heads.
-- The way to search for a "longest prefix" is the same in both...
-- Here is an example, to explain both the data structure and the
-- basic algorithm. If we only have two abbreviations, "a"->"<a>" and
-- "abc"->"<abc>", then the table "abbrevs" will be like this:
--   abbrevs = { ["a"]="<a>",
--               ["ab"]=0,
--               ["abc"]="<abc>" }
-- and then:
--   unabbrev("ababc")
-- returns:
--   "<a>b<abc>"
-- To calculate the "unabbreviated form" of the string "ababc" we
-- start at the left, and try to find the longest substring of
-- "ababc", starting at 1, which has an expansion... "a" has an
-- expansion, and "ab" has not; but the table abbrevs has an entry
-- ["ab"]=0, that means "keep trying" - because even though "ab" does
-- not have an expansion, some strings starting with "ab" may have.

abbrevs = {}
longestprefix = function (str, j, pt)
    j  = j  or 1          -- starting position
    pt = pt or abbrevs    -- prefix table
    local longest = nil   -- longest prefix having an expansion
    for k=j,#str do
      local candidate = str:sub(j, k)
      local e = pt[candidate]
      if e == nil then break end   -- if e==nil we can stop
      if e ~= 0 then               -- if e==0 we keep trying
        longest = candidate        -- if e~=nil and e~=0 we record the match
      end
    end
    return longest, pt[longest]    -- return the best match and its "expansion"
  end
findfirstexpansion = function (str, i, pt)
    for j=i,#str do
      local longest, expansion = longestprefix(str, j, pt)
      if longest then return j, longest, expansion end
    end
  end
-- «unabbrev»  (to ".unabbrev")
unabbrev = function (str, i, pt)
    i = i or 1
    local j, longest, expansion = findfirstexpansion(str, i, pt)
    if j then
      return str:sub(i, j-1) ..               -- the unexpandable part, then
             expansion ..                     -- the expansion, then...
             unabbrev(str, j+#longest, pt)    -- recurse!
    end
    return str:sub(i)                         -- or all the rest of the string.
  end


-- (find-dn4 "dednat4.lua" "abbrevs")
addabbrev = function (abbrev, expansion, pt)
    pt = pt or abbrevs
    for i=1,#abbrev-1 do
      local prefix = abbrev:sub(1, i)
      pt[prefix] = pt[prefix] or 0
    end
    pt[abbrev] = expansion
  end
addabbrevs = function (...)
    local arg = {...}
    for i=1,#arg,2 do
      addabbrev(arg[i], arg[i+1])
    end
  end
delabbrev = function (abbrev, pt)
    (pt or abbrevs)[abbrev] = 0    -- yep!
  end





---- From: (find-dn5 "parse")
---- «parse.lua»  (to ".parse.lua")
---- This block is from: (find-dn5 "parse.lua")
-- parse.lua: functions to parse words keeping track of the column.
-- These functions are used to parse tree segments (in "%:" lines)
--   and 2D grids (in both "%D 2Dx" and "%D 2D" lines).
-- This file:
--   http://angg.twu.net/dednat5/parse.lua.html
--   http://angg.twu.net/dednat5/parse.lua
--                    (find-dn5 "parse.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011apr07
-- License: GPL3
--

setsubj = function (subj_, pos_)
    subj = subj_
    pos  = pos_ or 3
    startcol, endcol = 1, pos
  end
getword = function ()
    local spaces, word_, newpos = subj:match("( *)([^ ]+)()", pos)
    if spaces then
      startcol = endcol + #spaces
      endcol   = endcol + #spaces + #word_   -- change for UTF-8
      word     = word_
      pos      = newpos
      return word
    end
  end
getwordasluaexpr = function ()
    local expr = getword()
    local code = "return "..expr
    return assert(loadstring(code))()
  end

getrestofline = function ()
    local spaces, word_, newpos = subj:match("( *)(.*)()", pos)
    if spaces then
      startcol = endcol + #spaces
      endcol   = endcol + #spaces + #word_   -- change for UTF-8
      word     = word_
      pos      = newpos
      return word
    end
  end




---- From: (find-dn5 "preamble")
---- «preamble.lua»  (to ".preamble.lua")
---- This block is from: (find-dn5 "preamble.lua")
-- preamble.lua: functions about the TeX definitions in the .dnt file.
-- This file:
--   http://angg.twu.net/dednat5/preamble.lua.html
--   http://angg.twu.net/dednat5/preamble.lua
--                    (find-dn5 "preamble.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011may12
-- License: GPL3
--
-- Adapted from:
--   (find-dn4ex "edrx08.sty")
--   (find-dn4ex "edrxdnt.tex" "defded")
--   (find-dn4ex "edrxdnt.tex" "defdiag")
-- See also:
--   (find-dn4ex "edrxmain.tex")
--   (find-dn4ex "edrxmain41.tex")
--   (find-dn4ex "edrxmain41a.tex")

preamble = [==[
% These definitions - the "preable" of a .dnt file - are from:
%   http://angg.twu.net/dednat5/preamble.lua.html
%   http://angg.twu.net/dednat5/preamble.lua
%                    (find-dn5 "preamble.lua")
%
\usepackage{proof}   % For derivation trees ("%:" lines)
\input diagxy        % For 2D diagrams ("%D" lines)
\xyoption{curve}     % For the ".curve=" feature in 2D diagrams
%
\def\defded#1#2{\expandafter\def\csname ded-#1\endcsname{#2}}
\def\ifdedundefined#1{\expandafter\ifx\csname ded-#1\endcsname\relax}
\def\ded#1{\ifdedundefined{#1}
    \errmessage{UNDEFINED DEDUCTION: #1}
  \else
    \csname ded-#1\endcsname
  \fi
}
\def\defdiag#1#2{\expandafter\def\csname diag-#1\endcsname{\bfig#2\efig}}
\def\defdiagprep#1#2#3{\expandafter\def\csname diag-#1\endcsname{{#2\bfig#3\efig}}}
\def\ifdiagundefined#1{\expandafter\ifx\csname diag-#1\endcsname\relax}
\def\diag#1{\ifdiagundefined{#1}
    \errmessage{UNDEFINED DIAGRAM: #1}
  \else
    \csname diag-#1\endcsname
  \fi
}
% End of the preamble.

]==]





---- From: (find-dn5 "process")
---- «process.lua»  (to ".process.lua")
---- This block is from: (find-dn5 "process.lua")
-- process.lua: process files, lines, and heads.
--   all the lines in a file (by heads)
-- This file:
--   http://angg.twu.net/dednat5/process.lua.html
--   http://angg.twu.net/dednat5/process.lua
--                    (find-dn5 "process.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011apr09
-- License: GPL3

-- untabify        (find-angg "LUA/lua50init.lua" "untabify")
-- parse_pattern   (find-blogme4 "eval.lua" "parse_pattern")
-- ProcessLine     (find-dn4 "dednat4.lua" "abbrev-head")
-- ProcessBlock    (find-dn4 "dednat4.lua" "lua-head")
-- ProcessFile     (find-dn4 "dednat4.lua" "process")
-- ProcessWord     uses subj and pos; used by trees and dforth
-- Head
-- heads           (find-dn4 "dednat4.lua" "heads")
-- registerhead
-- AbbrevHead
-- LuaHead


-- «.main-loop»		(to "main-loop")
-- «.abbrev-head»	(to "abbrev-head")
-- «.lua-head»		(to "lua-head")


-- require "prefixes"  -- (find-dn5 "prefixes.lua")

-- (find-dn4 "dednat4.lua" "heads")
heads = {}
registerhead = function (headstr)
    return function (head)
        head.headstr = headstr
        addabbrev(headstr, head, heads)
      end
  end
registerhead "" {}
headstrfor_ = function (lstr) return longestprefix(lstr, 1, heads) or "" end
headfor_    = function (lstr) return heads[headstrfor_(lstr)] end
headstrfor  = function (lstr) return lstr and headstrfor_(lstr) end
headfor     = function (lstr) return lstr and headfor_(lstr) end
--
fname  = "<none>"    -- used in error messages
flines = {}          -- like "subj", but is an array of strings
nline  = 1           -- like "pos"
--
linehead    = function (n) return headfor   (flines[n or nline]) end
lineheadstr = function (n) return headstrfor(flines[n or nline]) end
nextheadstr = function ()  return lineheadstr(nline + 1) end
--
set_nline  = function (nline_) nline = nline_; linestr = flines[nline] end
set_flines = function (flines_, fname_)
    fname  = fname_ or "<none>"
    flines = flines_
    allsegments = {}   -- (find-dn5 "segments.lua")
    set_nline(1)
  end
use_bigstr = function (bigstr, fname) set_flines(splitlines(bigstr), fname) end
use_fname  = function (fname) use_bigstr(readfile(fname), fname) end

-- «main-loop»  (to ".main-loop")
processlines = function ()
    while nline <= #flines do
      local head = linehead()
      if head.action then head.action() end
      set_nline(nline + 1)
    end
  end
process_bigstr = function (bstr, fn) use_bigstr(bstr, fn) processlines() end
process_fname  = function (fname)    use_fname(fname)     processlines() end



-- Two trivial heads:

-- «abbrev-head»  (to ".abbrev-head")
-- (find-dn4 "dednat4.lua" "abbrev-head")
-- (find-dn5 "prefixes.lua")
registerhead "%:*" {
  action = function ()
      local abbrev, expansion = linestr:match("^%%:*(.-)*(.-)*")
      assert(abbrev)
      addabbrev(abbrev, expansion)
    end,
}

-- «lua-head»  (to ".lua-head")
-- (find-dn4 "dednat4.lua" "lua-head")
lualinebody = function () return untabify(linestr):match("^%%L ?(.*)") end
registerhead "%L" {
  action = function ()
      local chunkname = fname..":%L:"..nline
      local lualines  = { lualinebody() }     -- get body of first line
      while nextheadstr() == "%L" do          -- when the next line is also %L
        set_nline(nline + 1)                     -- advance pointer
        table.insert(lualines, lualinebody())    -- add its body to the chunk
      end
      local luacode = table.concat(lualines, "\n")
      assert(loadstring(luacode, chunkname))()
    end,
}






---- From: (find-dn5 "treetex")
---- «treetex.lua»  (to ".treetex.lua")
---- This block is from: (find-dn5 "treetex.lua")
-- treetex.lua: derivation trees and functions to convert them to TeX.
-- This file:
--   http://angg.twu.net/dednat5/treetex.lua.html
--   http://angg.twu.net/dednat5/treetex.lua
--                    (find-dn5 "treetex.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011apr04
-- License: GPL3
--

-- intersecting   (find-dn4 "dednat4.lua" "tree-lib")
-- tatsuta        (find-dn4 "dednat4.lua" "tree-out")
-- paultaylor

-- require "eoo"       -- (find-dn5 "eoo.lua")

TreeNode = Class {
  type    = "TreeNode",
  __index = {
    hasbar    = function (tn) return tn.bar ~= nil end,
    barchar   = function (tn) return tn.bar end,
    TeX_root  = function (tn) return tn[0] end,
    TeX_label = function (tn) return tn.label end,
    nhyps     = function (tn) return #tn end,
    hypslist  = function (tn) return tn end,
  },
}

TeX_subtree_tatsuta = function (tn, i_)
    if not tn:hasbar() then
      return i_.."\\mathstrut "..tn:TeX_root()
    else
      local r_ = tn:TeX_root()
      local b_ = tn:barchar()
      local l_ = tn:TeX_label()
      local h_ = tn:hypslist()
      local r  = "\\mathstrut "..r_
      local b  = ({["-"]="", ["="]="=", [":"]="*"})[b_]
      local l  = (l_ and "[{"..l_.."}]") or ""
      local i  = i_.." "
      local f  = function (tn) return TeX_subtree_tatsuta(tn, i) end
      local h  = mapconcat(f, h_, " &\n")
      return i_.."\\infer"..b..l.."{ "..r.." }{\n"..h.." }"
    end
  end
TeX_deftree_tatsuta = function (tn, name, link)
    return "\\defded{"..name.."}{"..(link or "").."\n"..
           TeX_subtree_tatsuta(tn, " ").." }"
  end

TreeNode.__index.TeX_subtree = TeX_subtree_tatsuta
TreeNode.__index.TeX_deftree = TeX_deftree_tatsuta





---- From: (find-dn5 "treesegs")
---- «treesegs.lua»  (to ".treesegs.lua")
---- This block is from: (find-dn5 "treesegs.lua")
-- treesegs.lua:
-- This file:
--   http://angg.twu.net/dednat5/treesegs.lua.html
--   http://angg.twu.net/dednat5/treesegs.lua
--                    (find-dn5 "treesegs.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011mar28
-- License: GPL3
--

-- «.allsegments-test»	(to "allsegments-test")

-- require "eoo"    -- (find-dn5 "eoo.lua")
-- require "parse"  -- (find-dn5 "parse.lua")

intersects = function (start1, end1, start2, end2)
    if end1 <= start2 then return false end
    if end2 <= start1 then return false end
    return true
  end

allsegments = {}
-- allsegment[5] is a Segments object containing the list of all
-- Segment objects at line 5 of the current file.

Segment = Class {
  type    = "Segment",
  __index = {
    iswithin = function (seg, l, r)
        return intersects(seg.l, seg.r, l, r)
      end,
    intersects = function (seg1, seg2)
        return intersects(seg1.l, seg1.r, seg2.l, seg2.r)
      end,
    segsabove_ = function (seg, dy)
        return allsegments[seg.y - dy] or Segments {}
      end,
    segsabove = function (seg)
        return seg:segsabove_(1):allintersecting(seg)
      end,
    firstsegabove = function (seg) return seg:segsabove()[1] end,
    rootnode = function (seg)
        return seg:segsabove_(2):firstwithin(seg.l, seg.l + 1)
      end,
  },
}
Segments = Class {
  type    = "Segments",
  __index = {
    allwithin = function (segs, l, r)
        local T = {}
        for _,seg in ipairs(segs) do
          if seg:iswithin(l, r) then table.insert(T, seg) end
        end
        return T
      end,
    firstwithin = function (segs, l, r)
        return segs:allwithin(l, r)[1]
      end,
    allintersecting = function (segs, seg)
        return segs:allwithin(seg.l, seg.r)
      end,
    firstintersecting = function (segs, seg)
        return segs:allwithin(seg.l, seg.r)[1]
      end,
  },
}


-- (find-dn5 "parse.lua")
tosegments = function (str, line)
    local T = {}
    setsubj(untabify(str))
    while getword() do
      table.insert(T, Segment {l=startcol, r=endcol, t=word, y=line, i=#T+1})
    end
    return Segments(T)
  end




---- From: (find-dn5 "treehead")
---- «treehead.lua»  (to ".treehead.lua")
---- This block is from: (find-dn5 "treehead.lua")
-- treehead.lua:
-- This file:
--   http://angg.twu.net/dednat5/treehead.lua.html
--   http://angg.twu.net/dednat5/treehead.lua
--                    (find-dn5 "treehead.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011feb27
-- License: GPL3
--

-- require "segments"   -- (find-dn5 "segments.lua")
-- require "trees"      -- (find-dn5 "trees.lua")
-- require "process"    -- (find-dn5 "process.lua")

output = output or print

-- (find-dn5 "segments.lua")
-- This should be enough for the moment.
segtotreenode = function (seg)
    local bar = seg:firstsegabove()
    if bar then
      local bart = bar.t
      local barchars = bart:match("-+") or
                       bart:match("=+") or
                       bart:match(":+")
      if not barchars then Error("Bad bar: "..bart) end
      local barchar = bart:sub(1, 1)
      local label = bart:sub(1 + #barchars)
      local hyps = bar:segsabove()
      local T = map(segtotreenode, hyps)
      T[0] = seg.t
      T.bar = barchar
      T.label = label
      return TreeNode(T)
    end
    return TreeNode {[0]=seg.t}
  end
-- Add new methods to an existing class
Segment.__index.totreenode = segtotreenode

-- (find-dn5 "trees.lua")
-- (find-dn5 "segments.lua")
registerhead "%:" {
  action = function ()
      allsegments[nline] = tosegments(linestr, nline)
      for _,seg in ipairs(allsegments[nline]) do
        local name = seg.t:match("^%^(.*)")
        if name then
          output(seg:rootnode():totreenode():TeX_deftree(name))
        end
      end
    end,
}






---- From: (find-dn5 "diagstacks")
---- «diagstacks.lua»  (to ".diagstacks.lua")
---- This block is from: (find-dn5 "diagstacks.lua")
-- diagstacks.lua: the stack, the metastack, and the arrays "nodes" and "arrows".
-- This file:
--   http://angg.twu.net/dednat5/diagstacks.lua.html
--   http://angg.twu.net/dednat5/diagstacks.lua
--                    (find-dn5 "diagstacks.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011apr10
-- License: GPL3
--



-- «.Stack»		(to "Stack")
-- «.MetaStack»		(to "MetaStack")
-- «.nodes»		(to "nodes")
-- «.arrows»		(to "arrows")



-- require "eoo"       -- (find-dn5 "eoo.lua")



-- «Stack»  (to ".Stack")
push = function (stack, o) table.insert(stack, o) end
pop  = function (stack, msg)
    assert(#stack > 0, msg or "Empty stack")
    return table.remove(stack)
  end
popuntil = function (stack, depth) while #stack > depth do pop(stack) end end
pick = function (stack, offset) return stack[#stack - offset] end
pock = function (stack, offset, o)     stack[#stack - offset] = o end

Stack = Class {
  type    = "Stack",
  __index = {
    push     = push, 
    pop      = pop,
    popuntil = popuntil,
    clear    = function (s) s:popuntil(0) end,
    pick     = pick,
    pock     = pock,
  },
}
-- Current fragilities: pushing a nil is a no-op;
-- and pick and pock do not check depth.
-- Beware: in dednat4 we stored the stack elements in the "wrong"
-- order just to make pick and pock trivial to implement (tos was
-- ds[1] in dednat4)... Now the conventions are:
--   ds:pick(0)       returns the tos ("top of stack")
--   ds:pick(1)       returns the element below tos
--   ds:pock(0, "a")  replaces the tos by "a"
--   ds:pock(1, "b")  replaces the element below tos by "b"

ds = Stack {}     -- (find-miniforthgempage 3  "DS={ 5 }")






-- «MetaStack»  (to ".MetaStack")
-- (find-dn5 "diagforth.lua" "metastack")
MetaStack = ClassOver(Stack) {
  type    = "MetaStack",
  __index = {
    ppush = function (ms) push(ms, #(ms.stack)) end,
    ppop  = function (ms) popuntil(ms.stack, pop(ms, "Empty metastack")) end,
    metapick = function (ms, offset) return ms.stack[ms:pick(0) + offset] end,
  },
}
depths = MetaStack {stack=ds}








-- «nodes»  (to ".nodes")
nodes = {}                      -- has numeric and string indices
storenode = function (node)
    table.insert(nodes, node)
    node.noden = #nodes         -- nodes[node.noden] == node
    if node.tag then            -- was: "and not nodes[node.tag]"...
      nodes[node.tag] = node    -- nodes[node.tag] == node
    end
    return node
  end

-- «arrows»  (to ".arrows")
arrows = {}                     -- has numeric and string indices
storearrow = function (arrow)
    table.insert(arrows, arrow)
    arrow.arrown = #arrows      -- arrows[arrow.arrown] == arrow
    if arrow.tag then           -- (unused at the moment)
      arrows[arrow.tag] = arrow -- arrows[arrow.tag] == arrow
    end
    return arrow
  end




---- From: (find-dn5 "diagtex")
---- «diagtex.lua»  (to ".diagtex.lua")
---- This block is from: (find-dn5 "diagtex.lua")
-- diagtex.lua:
-- This file:
--   http://angg.twu.net/dednat5/diagtex.lua.html
--   http://angg.twu.net/dednat5/diagtex.lua
--                    (find-dn5 "diagtex.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011apr10
-- License: GPL3

-- «.coords»		(to "coords")
-- «.arrow_to_TeX»	(to "arrow_to_TeX")
-- «.DxyArrow»		(to "DxyArrow")
-- «.DxyPlace»		(to "DxyPlace")
-- «.DxyLiteral»	(to "DxyLiteral")
-- «.DxyLoop»		(to "DxyLoop")
-- «.arrows_to_defdiag»	(to "arrows_to_defdiag")



-- require "eoo"         -- (find-dn5 "eoo.lua")
-- require "diagstacks"  -- (find-dn5 "diagstacks.lua")
-- require "prefixes"    -- (find-dn5 "prefixes.lua")
                      -- (find-dn5 "prefixes.lua" "unabbrev")

-- «coords»  (to ".coords")
-- (find-dn4 "dednat4.lua" "diag-out" "dxyorigx =")
dxyorigx = 100
dxyorigy = 100
dxyscale = 15
realx = function (x) return  dxyscale * (x - dxyorigx) end
realy = function (y) return -dxyscale * (y - dxyorigy) end
realxy = function (x, y) return realx(x), realy(y) end

-- «arrow_to_TeX»  (to ".arrow_to_TeX")
-- (find-diagxypage  6 "2"   "  The basic syntax")
-- (find-diagxytext    "2"   "  The basic syntax")
-- (find-diagxypage  6         "\\morphism(x,y)|p|/{sh}/<dx,dy>[N`N;L]")
-- (find-diagxytext            "\\morphism(x,y)|p|/{sh}/<dx,dy>[N`N;L]")
-- (find-diagxypage  7         "@{shape}")
-- (find-diagxytext            "@{shape}")
-- (find-diagxypage 23 "4.3" "  Empty placement and moving labels")
-- (find-diagxytext    "4.3" "  Empty placement and moving labels")
-- (find-dn4 "dednat4.lua" "diag-out" "arrowtoTeX =")
-- (find-dn4 "dednat4.lua" "lplacement")
node_to_TeX = function (node)
    local tex = node.tex or node.tag
    local TeX = node.TeX or (tex and unabbrev(tex))
    return (TeX and "{"..TeX.."}") or ""
  end
arrow_to_TeX = function (arrow)
    local node1 = nodes[arrow.from]
    local node2 = nodes[arrow.to]
    local x1, y1 = realxy(node1.x, node1.y)
    local x2, y2 = realxy(node2.x, node2.y)
    local dx, dy = x2 - x1, y2 - y1
    local N1 = node_to_TeX(node1)
    local N2 = node_to_TeX(node2)
    local Label = arrow.Label or (arrow.label and unabbrev(arrow.label))
    local L = Label and "{"..Label.."}" or ""
    --
    local p = arrow.placement and "|"..arrow.placement.."|" or ""
    local shape = arrow.shape or "->"
    local slide = arrow.slide and "@<"..arrow.slide..">"
    local curve = arrow.curve and "@/"..arrow.curve.."/"
    local lplace = arrow.lplacement and arrow.lplacement.."{"..label.."}"
    local sh
    if slide or curve or lplace then
      sh = format("/{@{%s}%s%s%s}/", shape,
		  (lplace or ""), (slide or ""), (curve or ""))
    else
      sh = "/"..shape.."/"
    end
    if lplace then p = "||"; L = "" end
    --
    return format("\\morphism(%d,%d)%s%s<%d,%d>[%s`%s;%s]",
                  x1, y1, p, sh, dx, dy, N1, N2, L)
  end


-- The kinds of things that we store in the array "arrows".
-- (find-dn5 "diagstacks.lua" "arrows")
-- «DxyArrow»  (to ".DxyArrow")
DxyArrow = Class {
  type    = "DxyArrow",
  __index = {
    TeX = function (ar) return arrow_to_TeX(ar) end,
  },
}
-- «DxyPlace»  (to ".DxyPlace")
DxyPlace = Class {
  type    = "DxyPlace",
  __index = {
    TeX = function (pseudoar)
        local node = pseudoar[1]
        local x, y = realxy(node.x, node.y)
        return format("\\place(%d,%d)[{%s}]", x, y, node_to_TeX(node))
      end,
  },
}
-- «DxyLiteral»  (to ".DxyLiteral")
DxyLiteral = Class {
  type    = "DxyLiteral",
  __index = {
    TeX = function (pseudoar) return pseudoar[1] end,
  },
}
-- «DxyLoop»  (to ".DxyLoop")
-- (find-dn4 "experimental.lua" "loop")
DxyLoop = Class {
  type    = "DxyLoop",
  __index = {
    TeX = function (pseudoar)
        local node, dTeX = pseudoar[1], pseudoar.dTeX
        local x, y = realxy(node.x, node.y)
        return format("\\Loop(%d,%d){%s}%s", x, y, node_to_TeX(node), dTeX)
      end,
  },
}


-- «arrows_to_defdiag»  (to ".arrows_to_defdiag")
arrows_to_TeX = function (prefix)
    local f = function (ar) return (prefix or "  ")..ar:TeX().."\n" end
    return mapconcat(f, arrows, "")
  end
arrows_to_defdiag = function (name, hyperlink)
    return format("\\defdiag{%s}{%s\n%s}",
                  name, (hyperlink or ""),
                  arrows_to_TeX("  "))
  end





---- From: (find-dn5 "diagforth")
---- «diagforth.lua»  (to ".diagforth.lua")
---- This block is from: (find-dn5 "diagforth.lua")
-- diagforth.lua: interpreting the words in "%D" lines in dednat5 files.
-- This file:
--   http://angg.twu.net/dednat5/diagforth.lua.html
--   http://angg.twu.net/dednat5/diagforth.lua
--                    (find-dn5 "diagforth.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011may13
-- License: GPL3
--


-- (find-blogme4 "eval.lua" "parse_pattern")
-- (find-angg "LUA/lua50init.lua" "untabify")
-- (find-blogme4 "eval.lua" "readvword")



-- «.metastack»		(to "metastack")
-- «.diag-head»		(to "diag-head")
-- «.diagram»		(to "diagram")
-- «.enddiagram»	(to "enddiagram")
-- «.nodes»		(to "nodes")
-- «.2D-and-2Dx»	(to "2D-and-2Dx")

-- «.run»		(to "run")
-- «.forths»		(to "forths")

-- require "diagtex"   -- (find-dn5 "diagtex.lua")
-- require "parse"     -- (find-dn5 "parse.lua")
-- require "process"   -- (find-dn5 "process.lua")
-- require "errors"    -- (find-dn5 "errors.lua")


forths = {}


-- «metastack»  (to ".metastack")
-- (find-dn5 "diagstacks.lua" "MetaStack")
forths["(("] = function () depths:ppush() end
forths["))"] = function () depths:ppop() end
forths["@"] = function () ds:push(depths:metapick(1 + getwordasluaexpr())) end



-- «run»  (to ".run")

-- «diag-head»  (to ".diag-head")
-- (find-dn5file "segments.lua" "tosegments =")
dxyrun = function (str, pos)
    setsubj(str, pos or 1)
    while getword() do
      -- PP(word)
      if    forths[word] then forths[word]()
      elseif nodes[word] then ds:push(nodes[word])
      else Error("Unknown word: "..word)
      end
    end
  end

registerhead "%D" {
  action = function ()
      dxyrun(untabify(linestr), 3)
    end,
}



-- «diagram»  (to ".diagram")
-- «enddiagram»  (to ".enddiagram")
forths["diagram"] = function ()
    diagramname = getword() or derror("No diagram name")
    xys = {}
    nodes = {}
    arrows = {}
    lasty = nil
  end
forths["enddiagram"] = function ()
    output(arrows_to_defdiag(diagramname, " % no hyperlink yet"))
  end



-- «2D-and-2Dx»  (to ".2D-and-2Dx")
-- (find-dn4file "dednat4.lua" "dxy2Dx =")
torelativenumber = function (prevn, str)
    local sign, strn = str:match("^([-+]?)([0-9.]+)$")
    if not sign then return end           -- fail
    local n = tonumber(strn)
    if sign == "" then return n end
    if sign == "+" then return prevn + n else return prev - n end
  end

dxy2Dx = function ()
    xs = {}
    local lastx = nil
    while getword() do
      local n = torelativenumber(lastx, word)
      if n then
        xs[startcol] = n
        lastx = n
      end
    end
  end
forths["2Dx"] = dxy2Dx

firstxin = function (s, e)
    for i=s,e do if xs[i] then return xs[i] end end
  end
dxy2Ddo = function (y, word)
    if word == "#" then getrestofline(); return end
    local x = firstxin(startcol, endcol-1)
    if not x then return end
    storenode {x=x, y=y, tag=word}
  end
dxy2D = function ()
    if not getword() then return end
    thisy = torelativenumber(lasty, word)
    if not thisy then getrestofline(); return end
    while getword() do dxy2Ddo(thisy, word) end
    lasty = thisy
  end
forths["2D"]  = dxy2D



-- «forths»  (to ".forths")
forths["#"] = function () getrestofline() end

-- «nodes»  (to ".nodes")
forths["node:"] = function ()
    local x,y = getwordasluaexpr()
    local tag = getword()
    ds:push(storenode {x=x, y=y, tag=tag})
  end
forths[".tex="] = function () ds:pick(0).tex = getword() or werror() end
forths[".TeX="] = function () ds:pick(0).TeX = getword() or werror() end

-- (find-dn4 "dednat4.lua" "diag-arrows")
forths[".p="] = function () ds:pick(0).placement = getword() or werror() end
forths[".slide="] = function () ds:pick(0).slide = getword() or werror() end
forths[".curve="] = function () ds:pick(0).curve = getword() or werror() end
forths[".label="] = function () ds:pick(0).label = getword() or werror() end
forths[".plabel="] = function ()
    ds:pick(0).placement = getword() or error()
    ds:pick(0).label     = getword() or error()
  end

pusharrow = function (shape)
    local from, to = ds:pick(1), ds:pick(0)
    ds:push(storearrow(DxyArrow {from=from.noden, to=to.noden, shape=shape}))
  end

forths["->"] = function () pusharrow("->") end
forths["=>"] = function () pusharrow("=>") end
forths[".>"] = function () pusharrow(".>") end
forths[":>"] = function () pusharrow(":>") end
forths["|.>"] = function () pusharrow("|.>") end
forths["-->"] = function () pusharrow("-->") end
forths["==>"] = function () pusharrow("==>") end
forths["|->"] = function () pusharrow("|->") end
forths["`->"] = function () pusharrow("^{ (}->") end
forths["<-"]   = function () pusharrow("<-") end
forths["<-|"]  = function () pusharrow("<-|") end
forths["<--"]  = function () pusharrow("<--") end

forths["sl^^"] = function () ds:pick(0).slide =    "5pt" end
forths["sl^"]  = function () ds:pick(0).slide =  "2.5pt" end
forths["sl_"]  = function () ds:pick(0).slide = "-2.5pt" end
forths["sl__"] = function () ds:pick(0).slide =   "-5pt" end

defarrows = function (bigstr)
    for _,spec in ipairs(split(bigstr)) do
      forths[spec] = function () pusharrow(spec) end
    end
  end

forths["place"] = function ()
    ds:push(storearrow(DxyPlace {ds:pick(0)}))
  end
forths["loop"] = function ()
    ds:push(storearrow(DxyLoop {ds:pick(0), dTeX=getword()}))
  end



---- From: (find-dn5 "diagmiddle")
---- «diagmiddle.lua»  (to ".diagmiddle.lua")
---- This block is from: (find-dn5 "diagmiddle.lua")
-- diagmiddle.lua: words for drawing arrows between the sides of rectangles.
-- This file:
--   http://angg.twu.net/dednat5/diagmiddle.lua.html
--   http://angg.twu.net/dednat5/diagmiddle.lua
--                    (find-dn5 "diagmiddle.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011may09
-- License: GPL3
--
-- This corresponds to:
--   (find-dn4 "experimental.lua" "splitdist")
-- and at the moment (?) it is not included by default in dednat5.
-- The test that uses this file is at:
--   (find-dn5 "tests/test3.tex")



phantomnode = "\\phantom{O}"

-- «midpoint»  (to ".midpoint")
forths["midpoint"] = function ()
    local node1, node2 = ds[2], ds[1]
    local midx, midy = (node1.x + node2.x)/2, (node1.y + node2.y)/2
    ds[2] = storenode{x=midx, y=midy, TeX=phantomnode}
    dspop()
  end


-- Words for drawing arrows in the middle of rectangles.
-- Actually these words build the vertex nodes for those arrows.
--    "harrownodes" is for horizontal arrows,
--    "varrownodes" is for vertical arrows,
--   "dharrownodes" and
--   "dvarrownodes" are for diagonal arrows.
-- They all expect two nodes on the stack, "node1" and "node2", and
-- they read three parameters with getwordasluaexpr(): "dx0", "dx1",
-- and "dx2" (or "dy0", "dy1" and "dy2").
--   "dx0" controls how far from "node1" the arrow starts,
--   "dx1" controls the length of the arrow,
--   "dx2" controls how far from "node2" the arrow starts.
-- Some of dx0, dx1, and dx2 can be nil; see "splitdist" below.
--   "harrownodes" uses y = (node1.y+node2.y)/2.
--   "varrownodes" uses x = (node1.x+nodex.y)/2.
-- This needs more documentation. Sorry.
-- Also, the "\phantom{O}" shouldn't be hardcoded.

-- «splitdist»  (to ".splitdist")
splitdist = function (x1, x2, dx0, dx1, dx2)
    local dx = x2-x1
    local rest = dx-(dx0 or 0)-(dx1 or 0)-(dx2 or 0)
    local type = (dx0 and "n" or "_")..(dx1 and "n" or "_")..
                 (dx2 and "n" or "_")
    if type=="_n_" then
      return x1+rest/2, x2-rest/2
    elseif type=="n_n" then
      return x1+dx0, x2-dx2
    elseif type=="nn_" then
      return x1+dx0+rest/2, x2-rest/2
    elseif type=="_nn" then
      return x1+rest/2, x2-dx2-rest/2
    end
    local p = function (n) return n or "nil" end
    print("Bad splitdist pattern: "..p(dx0).." "..p(dx1).." "..p(dx2))
  end

harrownodes = function (dx0, dx1, dx2, TeX1, TeX2)
    local node1, node2 = ds:pick(1), ds:pick(0)
    local midy = (node1.y + node2.y)/2
    local x1, x2 = splitdist(node1.x, node2.x, dx0, dx1, dx2)
    ds:push(storenode{x=x1, y=midy, TeX=(TeX1 or phantomnode)})
    ds:push(storenode{x=x2, y=midy, TeX=(TeX2 or phantomnode)})
  end
varrownodes = function (dy0, dy1, dy2, TeX1, TeX2)
    local node1, node2 = ds:pick(1), ds:pick(0)
    local midx = (node1.x + node2.x)/2
    local y1, y2 = splitdist(node1.y, node2.y, dy0, dy1, dy2)
    ds:push(storenode{x=midx, y=y1, TeX=(TeX1 or phantomnode)})
    ds:push(storenode{x=midx, y=y2, TeX=(TeX2 or phantomnode)})
  end

forths["harrownodes"] = function ()
    harrownodes(getwordasluaexpr(), getwordasluaexpr(), getwordasluaexpr())
  end
forths["varrownodes"] = function ()
    varrownodes(getwordasluaexpr(), getwordasluaexpr(), getwordasluaexpr())
  end





---- From: (find-dn5 "begriff")
---- «begriff.lua»  (to ".begriff.lua")
---- This block is from: (find-dn5 "begriff.lua")
-- begriff.lua:
-- This file:
--   http://angg.twu.net/dednat5/begriff.lua.html
--   http://angg.twu.net/dednat5/begriff.lua
--                    (find-dn5 "begriff.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011may15
-- License: GPL3
--
-- *** This is a prototype!!! ***
-- I am still discussing with Alessandro Bandeira Duarte -
-- see his homepage, at <http://frege.hdfree.com.br/> -
-- which syntax we want this to support, its interface, etc.
-- If you are interested in using this please get in touch!!!!

-- (find-angg "LUA/begriff.lua")
-- (find-fline "/usr/share/doc/texlive-doc/latex/begriff/README")

-- \BGassert            - generates an assertion sign
-- \BGcontent           - generates an assertion sign
-- \BGnot               - generates a negation sign
-- \BGquant{v}          - generates a universal quantifier with variable v
-- \BGconditional{a}{c} - generates a conditional with antecendent
--                        a and consequent c. Note that in the Begriffsschrift, 
--                        the antecendent is placed below the consequent.
-- 
-- (the following three commands were introduced in version 1.5)
-- 
-- \BGterm{x}           - creates a right-justified terminal node x 
-- \BGstem{x}           - inserts arbitrary LaTeX maths x into a non-terminal node
-- \BGbracket{x}        - places the expression x inside brackets

-- (find-books "__frege/__frege.el" "heijenoort")

-- «.begriff_classes»	(to "begriff_classes")
-- «.begriff_parse»	(to "begriff_parse")
-- «.begriff_head»	(to "begriff_head")
-- «.begriff_preamble»	(to "begriff_preamble")


--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
-- require "begriff"
--]]
-- require "eoo"        -- (find-dn5 "eoo.lua")
-- require "process"    -- (find-dn5 "process.lua")

-- «begriff_classes»  (to ".begriff_classes")
BegCond = Class {
  type    = "BegCond",
  __index = {
    TeX = function (o, p)
        local pp = p.."  "
        local a, c = o.a:TeX(pp), o.c:TeX(pp)
        -- return "\\BGconditional{\n"..
        --        pp..a.."\n"..
        --        p.."}{"..c.."\n"..
        --        p.."}"
        return "\\BGrevconditional{\n"..
               pp..c.."\n"..
               p.."}{"..a.."\n"..
               p.."}"
      end,
  },
}
BegNot = Class {
  type    = "BegNot",
  __index = {
    TeX = function (o, p) return "\\BGnot"..o[1]:TeX(p) end,
  },
}
BegAssert = Class {
  type    = "BegAssert",
  __index = {
    TeX = function (o, p) return "\\BGassert"..o[1]:TeX(p) end,
  },
}
BegQuant = Class {
  type    = "BegQuant",
  __index = {
    TeX = function (o, p) return "\\BGquant{"..o.v.."}"..o[1]:TeX(p) end,
  },
}
BegTerm = Class {
  type    = "BegTerm",
  __index = {
    -- TeX = function (o) return "\\BGterm "..o[1] end,
    TeX = function (o, p) return " "..o[1] end,
  },
}


-- «begriff_parse»  (to ".begriff_parse")
beglines = {}
bperror = function (x, y, msg)
    error(format("x=%d y=%d msg=%s", x, y, msg or "?"))
  end
bpterm = function (x, y)
    local xx = beglines[y]:match("^[^ ]*()", x)
    while 1 do
       local xxx = beglines[y]:match("^ [^ ]+()", xx)
       if xxx then xx = xxx else break end
    end
    return beglines[y]:sub(x, xx)
  end
-- bprest = function (x, y) return beglines[y]:sub(x) end
bpstart = function (x, y)
    if beglines[y]:match("^|", x) then
      return BegAssert {bptree(x+1, y)}
    end
    return bptree(x, y)
  end
bptree = function (x, y)
    local hyphs = beglines[y]:match("^-+", x)
    if hyphs then
      return bptree(x+#hyphs, y) or bperror(x, y, "hyphs")
    end
    if beglines[y]:match("^~", x) then
      return BegNot {bptree(x+1, y) or bperror(x+1, y, "~")}
    end
    local quant = beglines[y]:match("^%b()", x)
    if quant then
      local v = quant:sub(2, -2)
      return BegQuant {v=v, bptree(x+#quant, y) or bperror(x+#quant, y, "()")}
    end
    if beglines[y]:match("^%.", x) then
      local ya = y + 1
      while beglines[ya]:sub(x, x) == "|" do ya = ya + 1 end
      local c = bptree(x+1, y)  or bperror(x+1, y,  "c")
      local a = bptree(x+1, ya) or bperror(x+1, ya, "a")
      -- I am not testing for the "\\" yet
      return BegCond {a=a, c=c}
    end
    if beglines[y]:match("^ ", x) then
      return BegTerm {bpterm(x+1, y) or bperror(x, y, "term")}
    end
    bperror(x, y, "?")
  end

-- «begriff_head»  (to ".begriff_head")
-- (find-dn5 "process.lua" "lua-head")
registerhead "%B" {
  action = function ()
      local chunkname = fname..":%B:"..nline
      beglines  = { untabify(linestr) }     -- get body of first line
      while nextheadstr() == "%B" do              -- when the next line is also %B
        set_nline(nline + 1)                      -- advance pointer
        table.insert(beglines, untabify(linestr)) -- add its body to the chunk
      end
      processbeglines()
    end,
}
processbeglines = function ()
    for y,line in ipairs(beglines) do
      for name,x in line:gmatch"([^ ]+) :+> ()" do
        local body = bpstart(x, y):TeX("  ")
        local link = " % no hyperlink yet"
        local def = format("\\defbegr{%s}{%s\n  %s}", name, link, body)
        output(def)
      end
    end
  end

-- «begriff_preamble»  (to ".begriff_preamble")
begriff_preamble = [[
% From: (find-dn5 "begriff.lua" "begriff_preamble")
\usepackage{begriff}
\def\defbegr#1#2{\expandafter\def\csname begr-#1\endcsname{#2}}
\def\ifbegrundefined#1{\expandafter\ifx\csname begr-#1\endcsname\relax}
\def\begr#1{\ifbegrundefined{#1}
    \errmessage{UNDEFINED BEGRIFFSSCHRIFT DIAGRAM: #1}
  \else
    \csname begr-#1\endcsname
  \fi
}
\def\BGrevconditional#1#2{\BGconditional{#2}{#1}}

]]




---- From: (find-dn5 "repl")
---- «repl.lua»  (to ".repl.lua")
---- This block is from: (find-dn5 "repl.lua")
-- repl.lua: a repl for Lua (new version).
-- This file:
--   http://angg.twu.net/dednat5/repl2.lua.html
--   http://angg.twu.net/dednat5/repl2.lua
--                    (find-dn5 "repl2.lua")
--
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011dec05
-- License: GPL3
--
-- REPLs are hard to implement! As I've tried to explain in my notes in
--   http://angg.twu.net/repl.html
--             (find-TH "repl")
-- the control flow of a REPL can be daunting...
--
-- The class "Repl", defined below, is an attempt to implement all the
-- ideas mentioned in those notes, plus a few more - e.g., different
-- prefixes - without using any tricks like throw/catch, gotos, or
-- tail cails; we just use Repl object with a "status" field, plus
-- several other fields for temporary data.
--
-- The logic of a REPL is, very roughly, this:
--
--     /--------------------\
--     |                    |
--     v                    |
--     R ---> E ---> P ---> L
--
-- which means: Try to [R]ead a command, possibly spanning several
-- lines; after reading it, try to [E]val it; if the eval was
-- successful, [P]rint the results, otherwise display the error; if
-- not abort has been requested, [L]oop.
--
-- The logic of [R]ead is roughly this: read a first line of input,
-- with prompt ">"; while what we've got is an incomplete command -
-- like "if foo() then bar() else", read more input, now with prompt
-- ">>", again testing for completeness after adding each line. But
-- there are several kinds of errors that we must handle, so here is
--
-- The full pseudocode
-- ===================
-- (Note that this is to be read while you follow the real code!)
--
--   "Read()" is this:
--     Readfirst(), and while not Incomplete() do Readanother(); end;
--     if not Compilationerror() then return true end.
--     If either "Readfirst()" or "Readanother" receive a "^C", a "^D"
--     or an "eof" in its input, return nil.
--     Note that:
--       1) Compilationerror() may set the status to "compilation
--          error", and in this case Read() returns nil.
--       2) If Read() returns true this means that we have something
--          to Eval().
--       3) There are several cases in which Read() returns nil:
--            r.status = "eof"                -> means: abort the REPL
--            r.status = "^D"                 -> means: abort the REPL
--            r.status = "compilation error"  -> means: read more
--            r.status = "^C"                 -> means: read more
--       4) Incomplete() runs r.f, r.err = loadstring(r.code) and
--          tests if r.err holds certain a certain type of error (that
--          means that the code ends prematurely). The values in r.f
--          and r.err are reused by Compilationerror() and Eval().
--       5) Readfirst() runs Identify(), which detects which prefix is
--          being used and sets some variables (e.g. r.print)
--          accordingly.
--   "Eval()" is this:
--     Run r.f() with xpcall, using a simple error handler to display
--     a traceback in case of runtime errors; when a runtime error
--     occurs, set r.status to "runtime error" and return nil, and
--     when there are no runtime errors set r.fresults to a closure
--     that returns the same return values as r.f(), and return true.
--     Note that when Eval() returns true that means that we may have
--     something to print.
--   "Print()" is this:
--     Run r.print(r:fresults()). For some prefixes, like "=", r.print
--     is set to a function that prints the results; for other
--     prefixes, like "", r.print is set to nop, which do not print
--     the results.
--   "ReadEvalPrint()" is this:
--     r:Read() and r:Eval() and r:Print().
--     After running that, r.status can be one of: "eof", "^C", "^D",
--     "compilation error", "runtime error", or some other (garbage)
--     values, all meaning "ok". When the status is "eof" or "^D"
--     ReadEvalPrint() returns nil, in all other cases it returns
--     true. When ReadEvalPrint() returns true that means that we
--     should loop.
--
-- How did I develop that
-- ======================
-- I examined this sample interaction,
--
--   > r = Repl {}
--   > r:Repl()
--   L> = 2 +
--   LL>  3,     4
--        5      4
--   L> ^D
--   >
--
-- and wrote down how the fields in the Repl object "r" should be
-- changed, and in which order, and by which function:
--
--   r.line      =       "= 2 +"          <-- set by Readline
--   r.str       =       "= 2 +"          <-- set by Readfirst
--   r.prefix    =       "="              <-- set by Identify
--   r.body      =        " 2 +"          <-/
--   r.code      = "return  2 +"          <-/
--   r.print     =  <function print>      <-/
--   r.status    = "incomplete"           <-- set by Incomplete
--   r.line      =               "3, 4"   <-- set by Readline
--   r.str       =       "= 2 +\n 3, 4"   <-- set by Readanother
--   r.body      =        " 2 +\n 3, 4"   <-/
--   r.code      = "return  2 +\n 3, 4"   <-/
--   r.status    = "complete"             <-- set by Incomplete
--   r.f, r.err  = loadstring("return  2 +\n 3, 4") <-- set by Eval
--   r.out       = {true, 5, 4, n=3}                <-/
--   r.results() = 5, 4                             <-/
--   r.line      =        "^D"            <-- set by Readline
--   r.status    =        "^D"
--
-- Then, starting from the sketchy data flow diagram above, I
-- discovered how should be the control flow, and wrote the code.
--
-- A note: I'm cheap, so I decided to support "^C" and "^D" only as
-- lines holding a LITERAL caret then an uppercase "C" or "D" - I
-- don't want to have to deal with real signals right now! 8-\
--
-- (find-es "lua5" "loadstring_and_eof")
-- (find-es "lua5" "traceback")
-- (find-luamanualw3m "#pdf-xpcall")
-- (find-luamanualw3m "#pdf-unpack")
-- (find-luamanualw3m "#pdf-select")

-- require "common"     -- (find-dn5 "common.lua")
-- require "eoo"        -- (find-dn5 "eoo.lua")

Repl = Class {
  type    = "Repl",
  __index = {
    Readline = function (r, prompt)
        io.write(prompt)
        r.line = io.read()
	if r.line == nil  then r.status = "eof"; return end
        if r.line == "^C" then r.status = "^C"; return end
        if r.line == "^D" then r.status = "^D"; return end
        return true
      end,
    Identify = function (r)
        local prefix, body = r.line:match("^(==?)(.*)$")
	r.str = r.line
        if prefix then
          r.prefix = prefix
          r.body   = body
          r.code   = "return "..body
	  r.print  = print
	  r.print  = PP
        else
          r.prefix = ""
          r.body   = r.line
          r.code   = r.line
	  r.print  = function (...) end
        end
      end,
    Incomplete = function (r)
        local pat = "<eof>.$"
        r.f, r.err = loadstring(r.code)
        if r.err and r.err:match(pat) then
          r.status = "incomplete"
          return true
        end
      end,
    Compilationerror = function (r)
        if r.err then
          r.status = "compilation error"
	  print(r.err)
          return true
        end
      end,
    Readfirst = function (r)
        if r:Readline("L> ") then
          r:Identify()
          return true
        end
      end,
    Readanother = function (r)
        if r:Readline("LL> ") then
          r.str  = r.str .."\n"..r.line
          r.body = r.body.."\n"..r.line
          r.code = r.code.."\n"..r.line
          return true
        end
      end,
    Read = function (r)
        if not r:Readfirst() then return end
        while r:Incomplete() do
          if not r:Readanother() then return end
        end
        if r:Compilationerror() then return end
        return true
      end,
    Eval = function (r)
        local handler    = function () print(debug.traceback()) end
        local out        = pack(xpcall(r.f, handler))
        if not out[1] then r.status = "runtime error"; return end
        r.fresults = function () return unpack(out, 2, out.n) end
	return true
      end,
    Print = function (r)
        r.print(r:fresults())
      end,
    ReadEvalPrint = function (r)
        if r:Read() and r:Eval() then r:Print() end
	if r.status == "^D" or r.status == "eof" then return nil end
        return true
      end,
    Repl = function (r)
        while r:ReadEvalPrint() do end
      end,
  },
}

repl = function () Repl{}:Repl() end


---- From: (find-dn5 "options")
---- «options.lua»  (to ".options.lua")
---- This block is from: (find-dn5 "options.lua")
-- options.lua: process command-line options. This is a prototype!
-- This file:
--   http://angg.twu.net/dednat5/options.lua.html
--   http://angg.twu.net/dednat5/options.lua
--                    (find-dn5 "options.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011apr10
-- License: GPL3
--
-- See: (find-LATEX "2011ebl-slides.tex")
--      (find-dn5 "build.lua")
--      (find-blogme4 "options.lua")

-- require "preamble"   -- (find-dn5 "preamble.lua")
-- require "process"    -- (find-dn5 "process.lua")
-- require "treehead"   -- (find-dn5 "treehead.lua")
-- require "diagforth"  -- (find-dn5 "diagforth.lua")


dooption_t = function (texfile)
    local fname_tex = texfile
    local fname = texfile:match("^(.*)%.tex$")
    if not fname then
      error(fname_tex.." does not end with .tex!\n"..
            "`-t' refuses to run.")
    end
    local fname_dnt = fname .. ".dnt"
    output = function (str) table.insert(outputs, str) end
    outputs = {preamble}
    process_fname(fname_tex)
    writefile(fname_dnt, table.concat(outputs, "\n").."\n")
    print("  "..fname_tex.." -> "..fname_dnt)
  end

dooption_e = function (luacode) assert(loadstring(luacode))() end

_O = _O or {}
_O["-t"]      = function (texfile, ...) dooption_t(texfile); dooptions(...) end
_O["-e"]      = function (luacode, ...) dooption_e(luacode); dooptions(...) end

dooptions = function (optionname, ...)
    -- PP("o", optionname, ...)
    if not    optionname  then return end
    if not _O[optionname] then
      error(format("Not in _O (for dooptions): %q", optionname))
    end
    -- PP("g", ...)
    _O[optionname](...)
  end


dooptions(...)

-- (find-dn4 "dednat4.lua" "main")
-- (find-luamanualw3m "#6" "arg =")
-- (find-dn5 "process.lua" "main-loop")








-- Local Variables:
-- coding:             raw-text-unix
-- ee-anchor-format:   "«%s»"
-- End: