-- This file:
--   http://angg.twu.net/HASKELL/LuaTree1.hs.html
--   http://angg.twu.net/HASKELL/LuaTree1.hs
--           (find-angg "HASKELL/LuaTree1.hs")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
--
-- (defun e () (interactive) (find-angg "HASKELL/LuaTree1.hs"))

-- «.pipeThrough»		(to "pipeThrough")
-- «.callLuaTree»		(to "callLuaTree")
-- «.callLuaTree-tests»		(to "callLuaTree-tests")
-- «.luatree1»			(to "luatree1")
-- «.luatree1-tests»		(to "luatree1-tests")



import System.IO
import System.Process

-- «pipeThrough»  (to ".pipeThrough")
-- See: (find-es "haskell" "pipeThrough")
pipeThrough p str_in = do
  (Just hin, Just hout, _, _) <-
    createProcess p { std_in = CreatePipe, std_out = CreatePipe }
  hPutStr hin str_in
  hClose hin
  hGetContents hout

-- «callLuaTree»  (to ".callLuaTree")
-- See: http://angg.twu.net/eev-maxima.html#luatree
-- and: (find-angg "luatree/luatree.lua")
callLuaTree str = do
  pipeThrough (proc "/home/edrx/luatree/luatree.lua" []) str

teststr1 :: String
teststr1 = "{[0]='[', {[0]='/', 'x', 'y'}, '33'}"


-- «callLuaTree-tests»  (to ".callLuaTree-tests")
{-
* (eepitch-ghci)
* (eepitch-kill)
* (eepitch-ghci)
:load LuaTree1.hs
pipeThrough (proc "tac" []) "a\nbb\nccc\ndddd\n"
:t callLuaTree
callLuaTree teststr1
callLuaTree teststr1 >>= putStr

-}


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

data LT = LTS String
        | LTN Int
        | LTT String [LT]
        deriving (Eq,Ord,Show)

testlt1 :: LT
testlt1 = LTT "[" [LTT "/" [LTS "x", LTS "y"], LTN 33]

luatree0 :: LT -> String
luatree0 (LTS s) = show s
luatree0 (LTN n) = show n
luatree0 (LTT s xs) =
  let f x = ", " ++ luatree0 x
      rest = concat (map f xs)
  in "{[0]=" ++ (show s) ++ rest ++ "}"

luatree1 :: LT -> IO ()
luatree1 lt = callLuaTree (luatree0 lt) >>= putStr

-- «luatree1-tests»  (to ".luatree1-tests")
{-
* (eepitch-ghci)
* (eepitch-kill)
* (eepitch-ghci)
:load LuaTree1.hs
testlt1
luatree0 testlt1
luatree1 testlt1

-}

-- (find-huttonbookpage 285 "17.3      Adding a stack")
-- (find-huttonbooktext 285 "17.3      Adding a stack")

type Stack = [LT]
data Code = Pushn Int | Pushs String | Bin String

exec1 :: Code -> Stack -> Stack
exec1 (Pushn n)     st  = (LTN n):st
exec1 (Pushs s)     st  = (LTS s):st
exec1 (Bin op) (b:a:st) = (LTT op [a,b]):st

execn :: [Code] -> Stack -> Stack
execn []     st = st
execn (c:cs) st = execn cs (exec1 c st)

exec :: [Code] -> LT
exec cs = head (execn cs [])

execl :: [Code] -> IO ()
execl cs = luatree1 (exec cs)

{-
* (eepitch-ghci)
* (eepitch-kill)
* (eepitch-ghci)
:load LuaTree1.hs
execn [Pushn 22, Pushn 33, Bin "+"] []
exec  [Pushn 22, Pushn 33, Bin "+"]
execl [Pushn 22, Pushn 33, Bin "+"]
execl [Pushn 22, Pushn 33, Bin "+", Pushn 5, Bin "/"]

-}




-- (find-rwhaskellpage (+ 40 103)  "As-patterns")






-- Local Variables:
-- coding:  utf-8-unix
-- End: