make this compilable again

make this compilable again

-- Modeling Opetopes
-- here is Eric's editor: http://sma.epfl.ch/~finster/opetope/opetope.html
--
-- Note: Kock et al. use a similar scheme, where
--          - dots    <-->   lines
--          - spheres <-->   dots
--          - lines disappear
--          -                spheres appear

-- Note: In Eric's new work (at IAS) there are no
--       dots any more, instead he uses 'external cards', so
--          - (external) cards   <-->  lines
--          - space between stacked cards <--> external cards
--          - lines disappear
--          -                (regular) cards appear

import "../tests/Nat.prg"

-- GLOBAL TODOs
----------------

-- Naming: Seems essential for identifying things Hor(Name), Ver(Tree)
--         Name can be Label, then Niches (= sequences of opetope names).
--         the latter arise from the composition rule.
--         Note: don't store names in Stacks, that kills alpha
--               conversion. Instead names should be pushed into nodes
--               'singleton style' from outside: (node :: Tree (Hor `g))

-- Morphisms: given an opetope and a pointer to one of its cards
--            extract the opetope of that face (do we need a label
--            space to reliably find it?). This must be a type
--            function, with an algorithm accompanying it to extract
--            the face proper.

-- Composition: grafting of trees to external cards, but only if the
--              morphisms (faces) match. lower-dim stuff is unaffected.

-- Swapping: given a proof of equality between two niches, provide an
--           operation to swap them, replacing old faces by new ones,
--           FGL-style (functional graph library), just note that
--           certain morphisms are gone, others appeared.

-- References: a disciplined way of saying "I am an identical node to that guy",
--             by corollary these always obtain the same names.
--             a topologist would say 'surgery' (http://en.wikipedia.org/wiki/Surgery_theory)
--             We get a new Tree flavour, Ref, at least one up, followed by
--             naturals to index a node in a subtree.
--             At this point we are doing algebraic topology, and dealing with
--             closed manifolds, so that we can do homology etc. on them.
--             In logic this corresponds to relations, satisfiability.

-- Quoting: So far we have only dealt with data, i.e. quoted (inert) syntax.
--          we need a way to convert this syntax to code (e.g. at some stage),
--          to obtain semantics. We can have the usual splicing game.
--          Lisp does this with sexprs and macros.
--          The code needs then be executed (run, decreasing stage), when
--          it becomes active, and we can observe the manifestation of its
--          semantics. The reduction system could go along the lines of the
--          (typed) LambdaGraph.

-- NbE: I fully believe we can use this technique to reduce opetopic terms
--      to normal form. ('many syntax', 'one semantics' adjunction:
--                       http://www.logicmatters.net/resources/pdfs/Galois.pdf)

-- TODO: these three must be LeftLists
--
kind Trees = NoTree | Pre (Tree d) Trees deriving syntax (ts) List(NoTree, Pre)

data ZoomCompley :: Tree e ~> Tree f ~> * where
  Nily :: ZoomCompley a a
  Consy :: Stack a b -> ZoomCompley b c -> ZoomCompley a c
 deriving List(cply)

data ZoomComplex :: Trees ~> * where
  Nilx :: ZoomComplex [()tr]ts
  Endx :: Stack a b -> ZoomComplex [a, b]ts
  Consx :: Stack a b -> ZoomComplex [b; c]ts -> ZoomComplex [a, b; c]ts
 deriving syntax (cplx) List(Nilx, Consx) Item(Endx)

data Dir :: *2 where
  Hor :: Dir
  Ver :: Dir

-- define the Tree kind, a rose tree
-- note: we may need a two-level kind, since we need to track disjointness
--       of subtrees
-- todo: later we may want to have a label kind parameter too

data Tree :: Dir ~> *1 where
  Unit :: Tree Ver
  Ni :: Tree Hor
  Fork :: Tree d ~> Tree Hor ~> Tree Hor
 deriving syntax (tr) List(Ni, Fork) Unit(Unit)

-- make it singleton

data Tree' :: Tree d ~> * where
  In :: Tree' ()tr
  Fork :: Tree' head -> Tree' tail -> Tree' [head; tail]tr
  Done :: Tree' []tr
 deriving syntax (ar) List(Done, Fork) Unit(In) -- "arbre"
-- http://www.papoulipoesique.com/wp-content/uploads/2013/06/arbre.jpg

-- define a proposition for subtrees
-- to be checked: TakeHead must ensure that all the node is consumed

prop Subtree :: Tree d ~> Tree e ~> * where
  UnitSub :: Subtree ()tr tr
  BothNil :: Subtree []tr []tr
  TakeHead :: Subtree head head' -> Subtree tail tail' -> Subtree [head; tail]tr [head'; tail']tr

-- TODO: separate the notions of Niche / Frame / Cell
kind Volume = FramedHollow | FilledCell
kind Diagram = Closed Volume | OpenNiche
-- should be a parameter to Stack

-- now we can stack cards (these are zooms in Kock et al. parlance)

data Stack :: Tree d ~> Tree e ~> * where
  Corolla :: Corolla tr => Tree' tr -> Stack tr ()tr

  -- needed? TODO: Define Target
  Encompass :: Subtree consumed tr => Stack consumed prod -> Stack tr prod

  -- put a frame around a niche
  Frame :: (Corolla out, {nodes tr}  `Equal` {nodeValence out}) => Stack tr out -> Stack tr out

  -- add another target face to a web
  Target :: ({nodes tr} `Equal` {nodeValence out}) => Stack tr out -> Stack tr out

  -- the following three grab a node (and possibly its offsprings) and incorporate it into a single card
  NodeDone :: Stack []tr [()tr]tr
  Pick :: {- EntireNode => -} Stack head prodhead -> Stack tail prodtail -> Stack [head; tail]tr [prodhead; prodtail]tr
  Exclude :: {- EntireNode => -} Stack tail prod -> Stack [()tr; tail]tr prod
  -- TODO: maybe just specify a subtree (Tree') and that's it

  On :: (Subtree tr' tr, Pointers 1t at out) => Stack tr' out' -> Stack tr out -> Tree' at -> Stack tr {graft out' at out}

  -- building niches
  NicheDone :: Stack ()tr []tr
  Niche :: Stack tr out -> Stack tr [out]tr
  Also :: Pointers 1t at tr
       => Tree' at -> Stack tr' out' -> Stack tr out -> Stack {extgraft tr' at tr} [out'; out]tr

 deriving syntax(z) Record(NicheDone, Also) Item(Target)

subDone = ({}z)z

-- this is bogus, just make it compile again...
subCont :: Stack ()tr tr -> Stack ()tr [tr]tr
subCont inner = ({()ar=inner}z)z

-- it remains to define corollas

-- TODO: one could say {nodes tr} == 1
prop Corolla :: Tree d ~> * where
  None' :: Corolla []tr
  One' :: Corolla tail -> Corolla [()tr; tail]tr

--  o   --->  |
--  |         |

lolliCell :: Stack []tr ()tr
lolliCell = Corolla Done

--  |         |
--  o   --->  |
--  |         |

dolliCell :: Stack [()tr]tr ()tr
dolliCell = Corolla $ Fork In Done

--              |
--  [o]   --->  o
--   |          |

lolliFrame :: Stack []tr [()tr]tr
lolliFrame = Encompass NodeDone

--   |          |
--  [o]   --->  o
--   |          |

dolliFrame :: Stack [()tr]tr [()tr]tr
dolliFrame = Encompass (Exclude NodeDone)

--   |          |
--   |          o
-- [[o]]  --->  |
--   |          o
--   |          |

stacked :: Stack [()tr]tr [[()tr]tr]tr
stacked = (dolliFrame `On` dolliFrame) (In `Fork` Done)

--   |
--  [|]   --->  o
--   |          |

crossed :: Stack ()tr []tr
crossed = subDone

-- we can now join things
--
dolliForever = [dolliFrame; dolliForever]cply
nopetope = [crossed, lolliFrame; dolliForever]cply

-- back to unit as fast as possible...
--
stopetope = [crossed, lolliFrame, dolliCell]cply
neverstopetope = [crossed, lolliFrame, dolliCell; neverstopetope]cply
stopetope' = [crossed, lolliFrame; (dolliCell)cplx]cplx
stopetope'' = [crossed, lolliFrame, dolliCell]cplx

--   |          o
-- [[|]]  --->  |
--   |          o
--   |          |

drossed :: Stack ()tr [[]tr]tr
drossed = subCont subDone

-- ################################
-- ############  Niches ###########
-- ################################

--  |          +
--  |          |

-- this is a niche, but assume to be a frame
niche0 :: Stack ()tr []tr
niche0 = {}z

--  |           |
-- [|]          +
--  |           |

-- this is a niche, but assume to be a frame
niche1 :: Stack ()tr [[]tr]tr
niche1 = {()ar=subDone; {}z}z

--  |         o   o
-- [|]  --->   \ /
-- [|]          +
--  |           |

-- this is a niche, but assume to be a frame
niche2 :: Stack ()tr [[]tr, []tr]tr
niche2 = {()ar=subDone; niche1}z

--                |
--  |         o   o
-- [o]  --->   \ /
-- [|]          +
--  |           |

niche10 :: Stack [()tr]tr [[()tr]tr, []tr]tr
niche10 = {()ar=Exclude NodeDone; Niche subDone}z

-- ################################
-- ############  Frames ###########
-- ################################

--   |              |
--  /|\         o   o
-- |[o]|  --->   \ /
-- |[|]|          o
--  \|/           |
--   |

cyclops :: Stack [()tr]tr [[()tr]tr, []tr]tr
cyclops = (niche10)z

-- Stacking, Valence, Affine subtree, Substitute at an affine position

-- counting Units in a tree

valence :: Tree d ~> Nat
{valence []tr} = 0t
{valence [head; tail]tr} = {plus {valence head} {valence tail}}
{valence ()tr} = 1t

-- counting siblings of a tree

nodeValence :: Tree d ~> Nat
{nodeValence []tr} = 0t
{nodeValence [head; tail]tr} = (1+{nodeValence tail})t

-- counting nodes in a tree

nodes :: Tree d ~> Nat
{nodes ()tr} = t
{nodes []tr} = 1t
{nodes [head; tail]tr} = {plus {nodes head} {nodes tail}}

-- nodeValenceAt: given a (multi)pointer, determine the node valences at those positions
--               WHERE     IN
nodeValenceAt :: Tree d ~> Tree e ~> Nat
{nodeValenceAt ()tr tree} = {nodeValence tree}
{nodeValenceAt []tr []tr} = 0t
{nodeValenceAt [head'; tail']tr [head; tail]tr} = {plus {nodeValenceAt head' head} {nodeValenceAt tail' tail}}

-- a pointer is a valence-1 subtree of a tree
-- it is used to mark a unit in a tree where substitution will occur
--
prop Pointers :: Nat ~> Tree d ~> Tree e ~> * where
  Finger :: Pointers 1t ()tr ()tr
  Finished :: Pointers 0t []tr []tr
  ThisWay :: Pointers 1t head' head -> Pointers n tail' tail -> Pointers (1+n)t [head'; tail']tr [head; tail]tr
  ElseWhere :: Pointers n tail' tail -> Pointers n [[]tr; tail']tr [head; tail]tr

-- http://en.wikipedia.org/wiki/Grafting
--
-- graft WHAT      WHERE     IN
graft :: Tree d ~> Tree e ~> Tree f ~> Tree f
{graft what ()tr ()tr} = what
{graft what []tr tr} = tr
{graft what [head'; tail']tr [head; tail]tr} = [{graft what head' head}; {graft what tail' tail}]tr

-- extgraft: extend and graft
--
extgraft :: Tree what ~> Tree wher ~> Tree tree ~> Tree tree'
{extgraft what ()tr ()tr} = what
{extgraft what []tr ()tr} = ()tr
{extgraft what [head; tail]tr ()tr} = {extgrafthor what [head; tail]tr}
{extgraft what []tr []tr} = []tr
{extgraft what []tr [head; tail]tr} = [head; tail]tr
{extgraft what [head'; tail']tr [head; tail]tr} = [{extgraft what head' head}; {extgraft what tail' tail}]tr

-- helper:
extgrafthor :: Tree what ~> Tree Hor ~> Tree Hor
{extgrafthor what []tr} = []tr
{extgrafthor what [head; tail]tr} = [{extgraft what head ()tr}; {extgrafthor what tail}]tr

{- NOTE: we have an Omega bug here:

prompt> :norm {graft []tr ()tr ()tr}
Normalizes to:
  []tr

prompt> :kind []tr
[]tr :: Tree Hor  = []tr

prompt> :kind {graft []tr ()tr ()tr}
{graft []tr ()tr ()tr} :: Tree Ver  = {graft []tr ()tr ()tr}

... BUT: Hor /= Ver :-(
-}

-- substitution: replace a pointed node (of valence n) in a tree with an
-- other tree of (valence n) -- TODO

-- HERE IS A NICE RESEARCH QUESTION:
-- is it possible to "proof search" a Zoom?
-- i.e.
{-

class ZoomLike (int :: Tree) (out :: Tree) where
  zoom :: (Nodes int ~ Valence out) => Zoom int out

-}

prop Reference :: Tree Hor ~> * where
  Stop :: Reference []tr
  Up :: Reference tr -> Reference [tr]tr

{-

    |
0   L  (lambda node)
|   |
1   1
|   |
2   2
 \ /
  o
  |
  B  (binds here)
  |

Encodes \x.xx

And this:

|
LB
|

encodes \x.x

Or should this be just the unit tree (|)?

-}

--TODO: prop Lambda :: Tree Hor ~> * where

{-
The slogan is: binder nodes do not count as result nodes:
 - just consider the next node upstream
 - incoming (external) cards, when identified to a binder do not count as inputs to application
 - incoming (external) cards, when identified to an (iterated) application become pattern matching (sigma).

In the end all identifications have a semantics (hopefully!), when the counting rules are ensured.

-}

-- Modeling Opetopes
-- here is Eric's editor: http://sma.epfl.ch/~finster/opetope/opetope.html
--
-- Note: Kock et al. use a similar scheme, where
--          - dots    <-->   lines
--          - spheres <-->   dots
--          - lines disappear
--          -                spheres appear

-- Note: In Eric's new work (at IAS) there are no
--       dots any more, instead he uses 'external cards', so
--          - (external) cards   <-->  lines
--          - space between stacked cards <--> external cards
--          - lines disappear
--          -                (regular) cards appear

import "../tests/Nat.prg"

-- GLOBAL TODOs
----------------

-- Naming: Seems essential for identifying things Hor(Name), Ver(Tree)
--         Name can be Label, then Niches (= sequences of opetope names).
--         the latter arise from the composition rule.
--         Note: don't store names in Stacks, that kills alpha
--               conversion. Instead names should be pushed into nodes
--               'singleton style' from outside: (node :: Tree (Hor `g))

-- Morphisms: given an opetope and a pointer to one of its cards
--            extract the opetope of that face (do we need a label
--            space to reliably find it?). This must be a type
--            function, with an algorithm accompanying it to extract
--            the face proper.

-- Composition: grafting of trees to external cards, but only if the
--              morphisms (faces) match. lower-dim stuff is unaffected.

-- Swapping: given a proof of equality between two niches, provide an
--           operation to swap them, replacing old faces by new ones,
--           FGL-style (functional graph library), just note that
--           certain morphisms are gone, others appeared.

-- References: a disciplined way of saying "I am an identical node to that guy",
--             by corollary these always obtain the same names.
--             a topologist would say 'surgery' (http://en.wikipedia.org/wiki/Surgery_theory)
--             We get a new Tree flavour, Ref, at least one up, followed by
--             naturals to index a node in a subtree.
--             At this point we are doing algebraic topology, and dealing with
--             closed manifolds, so that we can do homology etc. on them.
--             In logic this corresponds to relations, satisfiability.

-- Quoting: So far we have only dealt with data, i.e. quoted (inert) syntax.
--          we need a way to convert this syntax to code (e.g. at some stage),
--          to obtain semantics. We can have the usual splicing game.
--          Lisp does this with sexprs and macros.
--          The code needs then be executed (run, decreasing stage), when
--          it becomes active, and we can observe the manifestation of its
--          semantics. The reduction system could go along the lines of the
--          (typed) LambdaGraph.

-- NbE: I fully believe we can use this technique to reduce opetopic terms
--      to normal form. ('many syntax', 'one semantics' adjunction:
--                       http://www.logicmatters.net/resources/pdfs/Galois.pdf)

-- TODO: these three must be LeftLists
--
kind Trees = NoTree | Pre (Tree d) Trees deriving syntax (ts) List(NoTree, Pre)

data ZoomCompley :: Tree e ~> Tree f ~> * where
  Nily :: ZoomCompley a a
  Consy :: Stack a b -> ZoomCompley b c -> ZoomCompley a c
 deriving List(cply)

data ZoomComplex :: Trees ~> * where
  Nilx :: ZoomComplex [()tr]ts
  Endx :: Stack a b -> ZoomComplex [a, b]ts
  Consx :: Stack a b -> ZoomComplex [b; c]ts -> ZoomComplex [a, b; c]ts
 deriving syntax (cplx) List(Nilx, Consx) Item(Endx)

data Dir :: *2 where
  Hor :: Dir
  Ver :: Dir

-- define the Tree kind, a rose tree
-- note: we may need a two-level kind, since we need to track disjointness
--       of subtrees
-- todo: later we may want to have a label kind parameter too

data Tree :: Dir ~> *1 where
  Unit :: Tree Ver
  Ni :: Tree Hor
  Fork :: Tree d ~> Tree Hor ~> Tree Hor
 deriving syntax (tr) List(Ni, Fork) Unit(Unit)

-- make it singleton

data Tree' :: Tree d ~> * where
  In :: Tree' ()tr
  Fork :: Tree' head -> Tree' tail -> Tree' [head; tail]tr
  Done :: Tree' []tr
 deriving syntax (ar) List(Done, Fork) Unit(In) -- "arbre"
-- http://www.papoulipoesique.com/wp-content/uploads/2013/06/arbre.jpg

-- define a proposition for subtrees
-- to be checked: TakeHead must ensure that all the node is consumed

prop Subtree :: Tree d ~> Tree e ~> * where
  UnitSub :: Subtree ()tr tr
  BothNil :: Subtree []tr []tr
  TakeHead :: Subtree head head' -> Subtree tail tail' -> Subtree [head; tail]tr [head'; tail']tr

-- TODO: separate the notions of Niche / Frame / Cell
kind Volume = FramedHollow | FilledCell
kind Diagram = Closed Volume | OpenNiche
-- should be a parameter to Stack

-- now we can stack cards (these are zooms in Kock et al. parlance)

data Stack :: Tree d ~> Tree e ~> * where
  Corolla :: Corolla tr => Tree' tr -> Stack tr ()tr

  -- needed? TODO: Define Target
  Encompass :: Subtree consumed tr => Stack consumed prod -> Stack tr prod

  -- put a frame around a niche
  -- TODO: Corolla out
  -- TODO: this constructor should be called Target
  Frame :: (Corolla out, Equal {nodes tr} {nodeValence out}) => Stack tr out -> Stack tr out

  -- the following three grab a node (and possibly its offsprings) and incorporate it into a single card
  NodeDone :: Stack []tr [()tr]tr
  Pick :: {- EntireNode => -} Stack head prodhead -> Stack tail prodtail -> Stack [head; tail]tr [prodhead; prodtail]tr
  Exclude :: {- EntireNode => -} Stack tail prod -> Stack [()tr; tail]tr prod
  -- TODO: maybe just specify a subtree (Tree') and that's it

  On :: (Subtree tr' tr, Pointers 1t at out) => Stack tr' out' -> Stack tr out -> Tree' at -> Stack tr {graft out' at out}

  -- building niches
  NicheDone :: Stack ()tr []tr
  Niche :: Stack tr out -> Stack tr [out]tr
  Also :: Pointers 1t at tr
       => Tree' at -> Stack tr' out' -> Stack tr out -> Stack {extgraft tr' at tr} [out'; out]tr

 deriving syntax(z) Record(NicheDone, Also) Item(Frame)

subDone = ({}z)z

subCont :: Stack ()tr tr -> Stack ()tr [tr]tr
subCont inner = ({()ar=inner}z)z

-- it remains to define corollas

-- TODO: one could say {nodes tr} == 1
prop Corolla :: Tree d ~> * where
  None' :: Corolla []tr
  One' :: Corolla tail -> Corolla [()tr; tail]tr

--  o   --->  |
--  |         |

lolliCell :: Stack []tr ()tr
lolliCell = Corolla Done

--  |         |
--  o   --->  |
--  |         |

dolliCell :: Stack [()tr]tr ()tr
dolliCell = Corolla $ Fork In Done

--              |
--  [o]   --->  o
--   |          |

lolliFrame :: Stack []tr [()tr]tr
lolliFrame = Encompass NodeDone

--   |          |
--  [o]   --->  o
--   |          |

dolliFrame :: Stack [()tr]tr [()tr]tr
dolliFrame = Encompass (Exclude NodeDone)

--   |          |
--   |          o
-- [[o]]  --->  |
--   |          o
--   |          |

stacked :: Stack [()tr]tr [[()tr]tr]tr
stacked = (dolliFrame `On` dolliFrame) (In `Fork` Done)

--   |
--  [|]   --->  o
--   |          |

crossed :: Stack ()tr []tr
crossed = subDone

-- we can now join things
--
dolliForever = [dolliFrame; dolliForever]cply
nopetope = [crossed, lolliFrame; dolliForever]cply

-- back to unit as fast as possible...
--
stopetope = [crossed, lolliFrame, dolliCell]cply
neverstopetope = [crossed, lolliFrame, dolliCell; neverstopetope]cply
stopetope' = [crossed, lolliFrame; (dolliCell)cplx]cplx
stopetope'' = [crossed, lolliFrame, dolliCell]cplx

--   |          o
-- [[|]]  --->  |
--   |          o
--   |          |

drossed :: Stack ()tr [[]tr]tr
drossed = subCont subDone

-- ################################
-- ############  Niches ###########
-- ################################

--  |          +
--  |          |

-- this is a niche, but assume to be a frame
niche0 :: Stack ()tr []tr
niche0 = {}z

--  |           |
-- [|]          +
--  |           |

-- this is a niche, but assume to be a frame
niche1 :: Stack ()tr [[]tr]tr
niche1 = {()ar=subDone; {}z}z

--  |         o   o
-- [|]  --->   \ /
-- [|]          +
--  |           |

-- this is a niche, but assume to be a frame
niche2 :: Stack ()tr [[]tr, []tr]tr
niche2 = {()ar=subDone; niche1}z

--                |
--  |         o   o
-- [o]  --->   \ /
-- [|]          +
--  |           |

niche10 :: Stack [()tr]tr [[()tr]tr, []tr]tr
niche10 = {()ar=Exclude NodeDone; Niche subDone}z

-- ################################
-- ############  Frames ###########
-- ################################

--   |              |
--  /|\         o   o
-- |[o]|  --->   \ /
-- |[|]|          o
--  \|/           |
--   |

cyclops :: Stack [()tr]tr [[()tr]tr, []tr]tr
cyclops = (niche10)z

-- Stacking, Valence, Affine subtree, Substitute at an affine position

-- counting Units in a tree

valence :: Tree d ~> Nat
{valence []tr} = 0t
{valence [head; tail]tr} = {plus {valence head} {valence tail}}
{valence ()tr} = 1t

-- counting siblings of a tree

nodeValence :: Tree d ~> Nat
{nodeValence []tr} = 0t
{nodeValence [head; tail]tr} = (1+{nodeValence tail})t

-- counting nodes in a tree

nodes :: Tree d ~> Nat
{nodes ()tr} = t
{nodes []tr} = 1t
{nodes [head; tail]tr} = {plus {nodes head} {nodes tail}}

-- nodeValenceAt: given a (multi)pointer, determine the node valences at those positions
--               WHERE     IN
nodeValenceAt :: Tree d ~> Tree e ~> Nat
{nodeValenceAt ()tr tree} = {nodeValence tree}
{nodeValenceAt []tr []tr} = 0t
{nodeValenceAt [head'; tail']tr [head; tail]tr} = {plus {nodeValenceAt head' head} {nodeValenceAt tail' tail}}

-- a pointer is a valence-1 subtree of a tree
-- it is used to mark a unit in a tree where substitution will occur
--
prop Pointers :: Nat ~> Tree d ~> Tree e ~> * where
  Finger :: Pointers 1t ()tr ()tr
  Finished :: Pointers 0t []tr []tr
  ThisWay :: Pointers 1t head' head -> Pointers n tail' tail -> Pointers (1+n)t [head'; tail']tr [head; tail]tr
  ElseWhere :: Pointers n tail' tail -> Pointers n [[]tr; tail']tr [head; tail]tr

-- http://en.wikipedia.org/wiki/Grafting
--
-- graft WHAT      WHERE     IN
graft :: Tree d ~> Tree e ~> Tree f ~> Tree f
{graft what ()tr ()tr} = what
{graft what []tr tr} = tr
{graft what [head'; tail']tr [head; tail]tr} = [{graft what head' head}; {graft what tail' tail}]tr

-- extgraft: extend and graft
--
extgraft :: Tree what ~> Tree wher ~> Tree tree ~> Tree tree'
{extgraft what ()tr ()tr} = what
{extgraft what []tr ()tr} = ()tr
{extgraft what [head; tail]tr ()tr} = {extgrafthor what [head; tail]tr}
{extgraft what []tr []tr} = []tr
{extgraft what []tr [head; tail]tr} = [head; tail]tr
{extgraft what [head'; tail']tr [head; tail]tr} = [{extgraft what head' head}; {extgraft what tail' tail}]tr

-- helper:
extgrafthor :: Tree what ~> Tree Hor ~> Tree Hor
{extgrafthor what []tr} = []tr
{extgrafthor what [head; tail]tr} = [{extgraft what head ()tr}; {extgrafthor what tail}]tr

{- NOTE: we have an Omega bug here:

prompt> :norm {graft []tr ()tr ()tr}
Normalizes to:
  []tr

prompt> :kind []tr
[]tr :: Tree Hor  = []tr

prompt> :kind {graft []tr ()tr ()tr}
{graft []tr ()tr ()tr} :: Tree Ver  = {graft []tr ()tr ()tr}

... BUT: Hor /= Ver :-(
-}

-- substitution: replace a pointed node (of valence n) in a tree with an
-- other tree of (valence n) -- TODO

-- HERE IS A NICE RESEARCH QUESTION:
-- is it possible to "proof search" a Zoom?
-- i.e.
{-

class ZoomLike (int :: Tree) (out :: Tree) where
  zoom :: (Nodes int ~ Valence out) => Zoom int out

-}

prop Reference :: Tree Hor ~> * where
  Stop :: Reference []tr
  Up :: Reference tr -> Reference [tr]tr

{-

    |
0   L  (lambda node)
|   |
1   1
|   |
2   2
 \ /
  o
  |
  B  (binds here)
  |

Encodes \x.xx

And this:

|
LB
|

encodes \x.x

Or should this be just the unit tree (|)?

-}

--TODO: prop Lambda :: Tree Hor ~> * where

{-
The slogan is: binder nodes do not count as result nodes:
 - just consider the next node upstream
 - incoming (external) cards, when identified to a binder do not count as inputs to application
 - incoming (external) cards, when identified to an (iterated) application become pattern matching (sigma).

In the end all identifications have a semantics (hopefully!), when the counting rules are ensured.
-}


Fixes #640

Fixes #640

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
USING System.Collections
USING System.Collections.Generic
USING System.Linq
USING System.Text
USING System.Diagnostics
USING System.Reflection
USING XSharp
USING System.Runtime.Serialization
BEGIN NAMESPACE XSharp
    /// Internal type that implements the new TYPED ARRAY type.

    /// This type has methods and properties that normally are never directly called from user code.
    ///
    /// <typeparam name="T">Type of the elements inside the array </typeparam>
    [DebuggerDisplay("{DebuggerString(),nq}")] ;
    [Serializable];
    PUBLIC CLASS __ArrayBase<T> ;
        IMPLEMENTS INamedIndexer, IEnumerable<T>, ISerializable

        [DebuggerBrowsable(DebuggerBrowsableState.Never)];
        PROTECTED INTERNAL _internalList AS List<T>
        [DebuggerBrowsable(DebuggerBrowsableState.Never)];
        PRIVATE _islocked AS LOGIC
        #region constructors
        /// Create an empty array
        CONSTRUCTOR()
            _internalList := List<T>{}
            RETURN

        /// Create an array with a certain capacity.
        CONSTRUCTOR(capacity AS DWORD)
            _internalList := List<T>{ (INT) capacity}
            //_internalList:AddRange(Enumerable.Repeat(DEFAULT(T),(INT) capacity))
            RETURN

        /// Create an array with a certain capacity and specify if it should be filled with default values.
        CONSTRUCTOR(capacity AS DWORD, fill AS LOGIC)
            _internalList := List<T>{ (INT) capacity}
            IF fill
                _internalList:AddRange(Enumerable.Repeat(SELF:DefaultValue,(INT) capacity))
            ENDIF
            RETURN

        /// Create an array and fill it with elements from an existing collection.
        CONSTRUCTOR( collection AS IEnumerable<T>)
            _internalList := List<T>{collection}
            RETURN

        /// Create an array and fill it with elements from an existing .Net array of objects. Note that the objects must be of the right type.
        CONSTRUCTOR( elements AS OBJECT[] )
            SELF()
            IF elements == NULL
                THROW Error{ArgumentNullException{NAMEOF(elements)}}
            ENDIF
            FOREACH element AS OBJECT IN elements
                IF element == NULL
                    _internalList:Add(SELF:DefaultValue)
                ELSEIF element IS T
                    _internalList:Add( (T) element)
                ELSE
                    THROW Error{ArgumentException{"Object array contains element of incorrect type "+element:GetType():FullName}}
                ENDIF
            NEXT
            RETURN

        /// Create an array and fill it with elements from an existing .Net array.
        CONSTRUCTOR( elements AS T[] )
            _internalList := List<T>{elements}
            RETURN
            #endregion

        #region properties
        /// Is the array empty.
        [DebuggerBrowsable(DebuggerBrowsableState.Never)];
        PUBLIC PROPERTY IsEmpty AS LOGIC GET _internalList:Count == 0
        /// Length of the array.
        PUBLIC PROPERTY Length AS DWORD GET (DWORD) _internalList:Count
        /// Length of the array as integer.
        [DebuggerBrowsable(DebuggerBrowsableState.Never)];
        PUBLIC PROPERTY Count AS INT GET _internalList:Count

        /// Returns the default value for array elements when arrays are resized or initialized.
        [DebuggerBrowsable(DebuggerBrowsableState.Never)];
        PUBLIC VIRTUAL PROPERTY DefaultValue AS T GET DEFAULT(T)
        #endregion

        #region Enumerators
        PUBLIC METHOD IEnumerable<T>.GetEnumerator() AS IEnumerator<T>
            RETURN ((IList<T> ) _internalList:ToArray()):GetEnumerator()

        PUBLIC METHOD IEnumerable.GetEnumerator() AS IEnumerator
            RETURN _internalList:ToArray():GetEnumerator()

            #endregion

        #region Cloning

        INTERNAL METHOD Clone() AS __ArrayBase<T>
            LOCAL aResult AS __ArrayBase<T>
            LOCAL nCount AS DWORD
            nCount := (DWORD) _internalList:Count
            aResult := (__ArrayBase<T>) Activator.CreateInstance(SELF:GetType(), NULL)
            aResult:Resize( _internalList:Count )
            // warning, nCount-1 below will become MAXDWORD for nCount == 0
            IF nCount == 0
                RETURN aResult
            ENDIF
            FOR VAR i := 0 TO nCount-1
                aResult:_internalList[i] := _internalList[i]
            NEXT
            RETURN aResult

            #endregion

        #region Indexers and TO GET / SET Elements.
        /// <include file="RTComments.xml" path="Comments/ZeroBasedIndexProperty/*" />
        /// <param name="index"><include file="RTComments.xml" path="Comments/ZeroBasedIndexParam/*" /></param>
        /// <returns>The element stored at the specified location in the array.</returns>
        PUBLIC VIRTUAL METHOD __GetElement(index AS INT) AS T
            RETURN SELF:_internalList[ index ]

        /// <include file="RTComments.xml" path="Comments/ZeroBasedIndexProperty/*" />
        /// <param name="index"><include file="RTComments.xml" path="Comments/ZeroBasedIndexParam/*" /></param>
        /// <param name='e'>New element to store in the array at the position specified</param>
        /// <returns>The new element</returns>
        PUBLIC METHOD __SetElement(e AS T,index AS INT) AS T
            IF SELF:CheckLock()
                _internalList[index]:=e
            ENDIF
            RETURN e

        PRIVATE METHOD __GetProperty(sName AS STRING) AS PropertyInfo
            LOCAL type AS System.Type
            LOCAL oProp AS PropertyInfo
            type := TYPEOF(T)
            oProp := type:GetProperty(sName, BindingFlags.IgnoreCase | BindingFlags.Instance | BindingFlags.Public)
            IF oProp == NULL_OBJECT
                THROW Error{ArgumentException{"Unknown property: "+sName}}
            ENDIF
            RETURN oProp

        PRIVATE METHOD __GetIndexer(lNumeric AS LOGIC) AS PropertyInfo
            LOCAL type AS System.Type
            LOCAL aProps AS PropertyInfo[]
            type := TYPEOF(T)
            aProps := type:GetProperties(BindingFlags.IgnoreCase | BindingFlags.Instance | BindingFlags.Public)
            FOREACH oProp AS PropertyInfo IN aProps
                IF !oProp:Name:ToLower() == "item"
                    LOOP
                ENDIF
                LOCAL pars := oProp:GetIndexParameters() AS ParameterInfo[]
                IF pars:Length > 0
                    LOCAL par := pars[__ARRAYBASE__] AS ParameterInfo
                    SWITCH Type.GetTypeCode(par:ParameterType)
                    CASE TypeCode.Int32
                    CASE TypeCode.Int64
                    CASE TypeCode.UInt32
                    CASE TypeCode.UInt64
                        IF (lNumeric)
                            RETURN oProp
                        ENDIF
                    CASE TypeCode.String
                        IF (!lNumeric)
                            RETURN oProp
                        ENDIF
                    END SWITCH
                ENDIF

            NEXT
            RETURN NULL

        /// <include file="RTComments.xml" path="Comments/ZeroBasedIndexProperty/*" />
        /// <param name="index"><include file="RTComments.xml" path="Comments/ZeroBasedIndexParam/*" /></param>
        /// <returns>The element stored at the indicated location in the collection.</returns>
        PUBLIC PROPERTY SELF[index AS INT] AS T
            GET
                IF  index > _internalList:Count-1
                    THROW Error{ArgumentOutOfRangeException{nameof(index)}}
                ENDIF
                RETURN _internalList[index ]
            END GET
            SET
                IF SELF:CheckLock()
                    IF index > _internalList:Count-1
                        THROW Error{ArgumentOutOfRangeException{nameof(index)}}
                    ENDIF
                    _internalList[index] := value
                ENDIF
            END SET
        END PROPERTY

        /// <include file="RTComments.xml" path="Comments/ZeroBasedIndexProperty/*" />
        /// <param name="index"><include file="RTComments.xml" path="Comments/ZeroBasedIndexParam/*" /></param>
        /// <param name="index2"><include file="RTComments.xml" path="Comments/ZeroBasedIndexParam/*" /></param>
        /// <returns>The value of the property of the element stored at the indicated location in the array.</returns>
        PUBLIC PROPERTY SELF[index AS INT, index2 AS INT] AS USUAL
            GET
                LOCAL oElement AS T
                IF  index > _internalList:Count-1
                    THROW Error{ArgumentOutOfRangeException{nameof(index)}}
                ENDIF
                oElement := _internalList[index ]
                IF oElement IS IIndexedProperties
                    VAR oIndex := (IIndexedProperties) oElement
                    RETURN oIndex[index2]
                ENDIF
                LOCAL oProp    AS PropertyInfo
                oProp    := SELF:__GetIndexer(TRUE)
                IF oProp != NULL
                    RETURN oProp:GetValue(oElement, <OBJECT>{index2})
                ENDIF
                THROW Error{ArgumentException{"Indexed property missing for type: "+oElement:GetType():FullName}}
            END GET
            SET
                IF  index > _internalList:Count-1
                    THROW Error{ArgumentOutOfRangeException{nameof(index)}}
                ENDIF
                IF SELF:CheckLock()
                    LOCAL oElement AS T
                    oElement := _internalList[index ]
                    IF oElement IS IIndexedProperties
                        VAR oIndex := (IIndexedProperties) oElement
                        oIndex[index2] := value
                    ENDIF
                    LOCAL oProp    AS PropertyInfo
                    oProp    := SELF:__GetIndexer(TRUE)
                    IF oProp != NULL
                        oProp:SetValue(oElement, OOPHelpers.VOConvert(value, oProp:PropertyType), <OBJECT>{index2} )
                        RETURN
                    ENDIF
                    THROW Error{ArgumentException{"Indexed property missing for type: "+oElement:GetType():FullName}}
                ENDIF
            END SET
        END PROPERTY

        /// <include file="RTComments.xml" path="Comments/ZeroBasedIndexProperty/*" />
        /// <param name="index"><include file="RTComments.xml" path="Comments/ZeroBasedIndexParam/*" /></param>
        /// <param name="name"><include file="RTComments.xml" path="Comments/NameBasedIndexParam/*" /></param>
        /// <returns>The value of the property of the element stored at the indicated location in the array.</returns>
        PUBLIC PROPERTY SELF[index AS INT, name AS STRING] AS USUAL
            GET
                LOCAL oElement AS T
                IF  index > _internalList:Count-1
                    THROW Error{ArgumentOutOfRangeException{}}
                ENDIF
                oElement := _internalList[index ]
                IF oElement IS IIndexedProperties
                    VAR oIndex := (IIndexedProperties) oElement
                    RETURN oIndex[name]
                ENDIF
                LOCAL oProp    AS PropertyInfo
                oProp    := SELF:__GetIndexer(FALSE)
                IF oProp != NULL
                    RETURN oProp:GetValue(oElement, <OBJECT>{name})
                ENDIF
                oProp	 := SELF:__GetProperty( name)
                RETURN oProp:GetValue(oElement, NULL)
            END GET
            SET
                IF  index > _internalList:Count-1
                    THROW Error{ArgumentOutOfRangeException{}}
                ENDIF
                IF SELF:CheckLock()
                    LOCAL oElement AS T
                    oElement := _internalList[index ]
                    IF oElement IS IIndexedProperties
                        VAR oIndex := (IIndexedProperties) oElement
                        oIndex[name] := value
                    ENDIF
                    LOCAL oProp    AS PropertyInfo
                    oProp    := SELF:__GetIndexer(FALSE)
                    IF oProp != NULL
                        oProp:SetValue(oElement, OOPHelpers.VOConvert(value, oProp:PropertyType), <OBJECT>{name} )
                        RETURN
                    ENDIF
                    oProp	 := SELF:__GetProperty( name)
                    oProp:SetValue(oElement, NULL, value)
                ENDIF
            END SET
        END PROPERTY

        #endregion

        #region Insert and Delete elements
        /// <exclude />
		PRIVATE METHOD __Add(u as T) AS VOID
            IF SELF:CheckLock()
                _internalList:Add(u)
            ENDIF

        PUBLIC VIRTUAL METHOD Add(u AS T) AS VOID
			SELF:__Add(u)
            RETURN

        /// <exclude />
        PUBLIC METHOD Delete(position AS INT) AS __ArrayBase<T>
            SELF:RemoveAt(position)
            SELF:__Add(SELF:DefaultValue)
            RETURN SELF

        /// <exclude />
        PUBLIC METHOD Insert(index AS INT,u AS T) AS VOID
            IF SELF:CheckLock()
                _internalList:RemoveAt(_internalList:Count - 1)
                _internalList:Insert((INT) index-__ARRAYBASE__ ,u)
            ENDIF
            RETURN

        /// <exclude />
        PUBLIC METHOD Insert(position AS INT) AS __ArrayBase<T>
            SELF:Insert( position, SELF:DefaultValue)
            RETURN SELF

        /// <exclude />
        PUBLIC METHOD RemoveAt(index AS INT) AS VOID
            IF SELF:CheckLock()
                _internalList:RemoveRange(index-__ARRAYBASE__,1 )
            ENDIF
            RETURN

        /// <exclude />
        PUBLIC VIRTUAL METHOD Resize(newSize AS INT) AS VOID
            IF SELF:CheckLock()
                IF newSize == 0
                    _internalList:Clear()
                ELSE
                    LOCAL count := _internalList:Count AS INT
                    IF newSize <= count
                        _internalList:RemoveRange(newSize, count - newSize)
                    ELSE
                        count+=1
                        DO WHILE count <= newSize
                            _internalList:Add(SELF:DefaultValue)
                            count++
                        ENDDO
                    ENDIF
                ENDIF
            ENDIF
            RETURN

            #endregion
        /// <inheritdoc />
        PUBLIC OVERRIDE METHOD ToString() AS STRING
            RETURN String.Format("[{0}]",_internalList:Count)

        INTERNAL METHOD Sort(startIndex AS INT, count AS INT, comparer AS IComparer<T>) AS VOID
            IF startIndex <= 0
                startIndex := 1
            ENDIF
            IF count < 0
                count := _internalList:Count - startIndex + __ARRAYBASE__
            ENDIF
            _internalList:Sort(startIndex-__ARRAYBASE__ ,count,comparer)
            RETURN

        INTERNAL METHOD Sort(comparer AS IComparer<T>) AS VOID
            _internalList:Sort(comparer)
            RETURN

        INTERNAL METHOD Swap(position AS INT, element AS T) AS T
            LOCAL original := _internalList[position - __ARRAYBASE__] AS T
            _internalList[ position - __ARRAYBASE__]:=element
            RETURN original

        INTERNAL METHOD Swap(position AS INT, element AS OBJECT) AS T
            //try
            VAR elementT := (T) (OBJECT) element
            RETURN SELF:Swap( position, elementT)
            //catch
            //	throw ArgumentException{"Parameter is of incorrect type "+element:GetType():FullName,nameof(element)}
            //end try

        INTERNAL METHOD Tail() AS T
            RETURN _internalList:LastOrDefault()

            #region locking
        INTERNAL METHOD Lock(lLocked AS LOGIC) AS LOGIC
            LOCAL wasLocked AS LOGIC
            wasLocked := SELF:_islocked
            SELF:_islocked := lLocked
            RETURN wasLocked
            /// Is the array locked?
        [DebuggerBrowsable(DebuggerBrowsableState.Never)];
        PROPERTY Locked AS LOGIC GET _islocked

        INTERNAL METHOD CheckLock AS LOGIC
            IF SELF:_islocked
                THROW Error{Gencode.EG_PROTECTION}
            ENDIF
            RETURN ! SELF:_islocked

            #endregion

        #region operators
        /// Implicitely convert an array of USUALs to a typed array. Note that the usuals must contain a value of the correct type.
        STATIC OPERATOR IMPLICIT ( a AS ARRAY) AS __ArrayBase<T>
            VAR aResult := __ArrayBase<T>{}
            LOCAL oErr AS Error
            FOREACH VAR u IN a
                LOCAL o := u AS OBJECT
                IF o IS T
                    aResult:Add( (T) o)
                ELSE
                    LOCAL nArg AS INT
                    LOCAL oActType AS System.Type
                    oActType := o:GetType()
                    nArg := a:_internalList:IndexOf(u)+1
                    oErr := Error{Gencode.EG_DATATYPE}
                    oErr:Arg := "Array Element : "+nArg:ToString()
                    oErr:Description := "Cannot convert array element " +nArg:ToString() + " from type "+oActType:ToString()+" to type "+TYPEOF(T):ToString()
                    THROW oErr
                ENDIF
            NEXT
            RETURN aResult

        /// Implicitely convert a typed array to an array of USUALs.
        STATIC OPERATOR IMPLICIT ( a AS __ArrayBase<T> ) AS ARRAY
            VAR aResult := __Array{}
            FOREACH VAR o IN a
                aResult:Add(  o)
            NEXT
            RETURN aResult

        /// Implicitely convert a typed Array to an OBJECT[].
        STATIC OPERATOR IMPLICIT ( a AS __ArrayBase<T> ) AS OBJECT[]
            LOCAL aResult := List<OBJECT>{} AS List<OBJECT>
            FOREACH VAR o IN a
                aResult:Add( o)
            NEXT
            RETURN aResult:ToArray()

    #endregion

        PROTECTED VIRTUAL METHOD DebuggerString() AS STRING
            LOCAL sb AS StringBuilder
            LOCAL cnt, tot AS LONG
            sb := StringBuilder{}
            sb:Append(SELF:ToString())
            sb:Append("{")
            tot := _internalList:Count
            cnt := 0
            FOREACH element AS T IN SELF:_internalList
                IF cnt > 0
                    sb:Append(",")
                ENDIF
                if element != null
                    sb:Append(element:ToString())
                else
                    sb:Append("NULL")
                endif
                cnt++
                IF cnt > 5
                    IF cnt < tot
                        sb:Append(",..")
                    ENDIF
                    EXIT
                ENDIF
            NEXT
            sb:Append("}")
            RETURN sb:ToString()

    #region ISerializable
        /// <inheritdoc/>
        PUBLIC VIRTUAL METHOD GetObjectData(info AS SerializationInfo, context AS StreamingContext) AS VOID
            IF info == NULL
                THROW System.ArgumentException{"info"}
            ENDIF
            info:AddValue("Count", SELF:Count)
            FOR VAR i := 1 TO SELF:Count
                info:AddValue("Item"+i:ToString(), _internalList[i-1])
            NEXT
            RETURN

        /// <include file="RTComments.xml" path="Comments/SerializeConstructor/*" />
        CONSTRUCTOR (info AS SerializationInfo, context AS StreamingContext)
            IF info == NULL
                THROW System.ArgumentException{"info"}
            ENDIF
            VAR count := info:GetInt32("Count")
            _internalList := List<T>{  }
            FOR VAR i := 1 TO count
                _internalList:Add( (T) info:GetValue("Item"+i:ToString(), typeof(T)))
            NEXT

            #endregion

    END	CLASS
END NAMESPACE

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
USING System.Collections
USING System.Collections.Generic
USING System.Linq
USING System.Text
USING System.Diagnostics
USING System.Reflection
USING XSharp
USING System.Runtime.Serialization
BEGIN NAMESPACE XSharp
    /// Internal type that implements the new TYPED ARRAY type.

    /// This type has methods and properties that normally are never directly called from user code.
    ///
    /// <typeparam name="T">Type of the elements inside the array </typeparam>
    [DebuggerDisplay("{DebuggerString(),nq}")] ;
    [Serializable];
    PUBLIC CLASS __ArrayBase<T> ;
        IMPLEMENTS INamedIndexer, IEnumerable<T>, ISerializable

        [DebuggerBrowsable(DebuggerBrowsableState.Never)];
        PROTECTED INTERNAL _internalList AS List<T>
        [DebuggerBrowsable(DebuggerBrowsableState.Never)];
        PRIVATE _islocked AS LOGIC
        #region constructors
        /// Create an empty array
        CONSTRUCTOR()
            _internalList := List<T>{}
            RETURN

        /// Create an array with a certain capacity.
        CONSTRUCTOR(capacity AS DWORD)
            _internalList := List<T>{ (INT) capacity}
            //_internalList:AddRange(Enumerable.Repeat(DEFAULT(T),(INT) capacity))
            RETURN

        /// Create an array with a certain capacity and specify if it should be filled with default values.
        CONSTRUCTOR(capacity AS DWORD, fill AS LOGIC)
            _internalList := List<T>{ (INT) capacity}
            IF fill
                _internalList:AddRange(Enumerable.Repeat(SELF:DefaultValue,(INT) capacity))
            ENDIF
            RETURN

        /// Create an array and fill it with elements from an existing collection.
        CONSTRUCTOR( collection AS IEnumerable<T>)
            _internalList := List<T>{collection}
            RETURN

        /// Create an array and fill it with elements from an existing .Net array of objects. Note that the objects must be of the right type.
        CONSTRUCTOR( elements AS OBJECT[] )
            SELF()
            IF elements == NULL
                THROW Error{ArgumentNullException{NAMEOF(elements)}}
            ENDIF
            FOREACH element AS OBJECT IN elements
                IF element == NULL
                    _internalList:Add(SELF:DefaultValue)
                ELSEIF element IS T
                    _internalList:Add( (T) element)
                ELSE
                    THROW Error{ArgumentException{"Object array contains element of incorrect type "+element:GetType():FullName}}
                ENDIF
            NEXT
            RETURN

        /// Create an array and fill it with elements from an existing .Net array.
        CONSTRUCTOR( elements AS T[] )
            _internalList := List<T>{elements}
            RETURN
            #endregion

        #region properties
        /// Is the array empty.
        [DebuggerBrowsable(DebuggerBrowsableState.Never)];
        PUBLIC PROPERTY IsEmpty AS LOGIC GET _internalList:Count == 0
        /// Length of the array.
        PUBLIC PROPERTY Length AS DWORD GET (DWORD) _internalList:Count
        /// Length of the array as integer.
        [DebuggerBrowsable(DebuggerBrowsableState.Never)];
        PUBLIC PROPERTY Count AS INT GET _internalList:Count

        /// Returns the default value for array elements when arrays are resized or initialized.
        [DebuggerBrowsable(DebuggerBrowsableState.Never)];
        PUBLIC VIRTUAL PROPERTY DefaultValue AS T GET DEFAULT(T)
        #endregion

        #region Enumerators
        PUBLIC METHOD IEnumerable<T>.GetEnumerator() AS IEnumerator<T>
            RETURN ((IList<T> ) _internalList:ToArray()):GetEnumerator()

        PUBLIC METHOD IEnumerable.GetEnumerator() AS IEnumerator
            RETURN _internalList:ToArray():GetEnumerator()

            #endregion

        #region Cloning

        INTERNAL METHOD Clone() AS __ArrayBase<T>
            LOCAL aResult AS __ArrayBase<T>
            LOCAL nCount AS DWORD
            nCount := (DWORD) _internalList:Count
            aResult := (__ArrayBase<T>) Activator.CreateInstance(SELF:GetType(), NULL)
            aResult:Resize( _internalList:Count )
            // warning, nCount-1 below will become MAXDWORD for nCount == 0
            IF nCount == 0
                RETURN aResult
            ENDIF
            FOR VAR i := 0 TO nCount-1
                aResult:_internalList[i] := _internalList[i]
            NEXT
            RETURN aResult

            #endregion

        #region Indexers and TO GET / SET Elements.
        /// <include file="RTComments.xml" path="Comments/ZeroBasedIndexProperty/*" />
        /// <param name="index"><include file="RTComments.xml" path="Comments/ZeroBasedIndexParam/*" /></param>
        /// <returns>The element stored at the specified location in the array.</returns>
        PUBLIC VIRTUAL METHOD __GetElement(index AS INT) AS T
            RETURN SELF:_internalList[ index ]

        /// <include file="RTComments.xml" path="Comments/ZeroBasedIndexProperty/*" />
        /// <param name="index"><include file="RTComments.xml" path="Comments/ZeroBasedIndexParam/*" /></param>
        /// <param name='e'>New element to store in the array at the position specified</param>
        /// <returns>The new element</returns>
        PUBLIC METHOD __SetElement(e AS T,index AS INT) AS T
            IF SELF:CheckLock()
                _internalList[index]:=e
            ENDIF
            RETURN e

        PRIVATE METHOD __GetProperty(sName AS STRING) AS PropertyInfo
            LOCAL type AS System.Type
            LOCAL oProp AS PropertyInfo
            type := TYPEOF(T)
            oProp := type:GetProperty(sName, BindingFlags.IgnoreCase | BindingFlags.Instance | BindingFlags.Public)
            IF oProp == NULL_OBJECT
                THROW Error{ArgumentException{"Unknown property: "+sName}}
            ENDIF
            RETURN oProp

        PRIVATE METHOD __GetIndexer(lNumeric AS LOGIC) AS PropertyInfo
            LOCAL type AS System.Type
            LOCAL aProps AS PropertyInfo[]
            type := TYPEOF(T)
            aProps := type:GetProperties(BindingFlags.IgnoreCase | BindingFlags.Instance | BindingFlags.Public)
            FOREACH oProp AS PropertyInfo IN aProps
                IF !oProp:Name:ToLower() == "item"
                    LOOP
                ENDIF
                LOCAL pars := oProp:GetIndexParameters() AS ParameterInfo[]
                IF pars:Length > 0
                    LOCAL par := pars[__ARRAYBASE__] AS ParameterInfo
                    SWITCH Type.GetTypeCode(par:ParameterType)
                    CASE TypeCode.Int32
                    CASE TypeCode.Int64
                    CASE TypeCode.UInt32
                    CASE TypeCode.UInt64
                        IF (lNumeric)
                            RETURN oProp
                        ENDIF
                    CASE TypeCode.String
                        IF (!lNumeric)
                            RETURN oProp
                        ENDIF
                    END SWITCH
                ENDIF

            NEXT
            RETURN NULL

        /// <include file="RTComments.xml" path="Comments/ZeroBasedIndexProperty/*" />
        /// <param name="index"><include file="RTComments.xml" path="Comments/ZeroBasedIndexParam/*" /></param>
        /// <returns>The element stored at the indicated location in the collection.</returns>
        PUBLIC PROPERTY SELF[index AS INT] AS T
            GET
                IF  index > _internalList:Count-1
                    THROW Error{ArgumentOutOfRangeException{nameof(index)}}
                ENDIF
                RETURN _internalList[index ]
            END GET
            SET
                IF SELF:CheckLock()
                    IF index > _internalList:Count-1
                        THROW Error{ArgumentOutOfRangeException{nameof(index)}}
                    ENDIF
                    _internalList[index] := value
                ENDIF
            END SET
        END PROPERTY

        /// <include file="RTComments.xml" path="Comments/ZeroBasedIndexProperty/*" />
        /// <param name="index"><include file="RTComments.xml" path="Comments/ZeroBasedIndexParam/*" /></param>
        /// <param name="index2"><include file="RTComments.xml" path="Comments/ZeroBasedIndexParam/*" /></param>
        /// <returns>The value of the property of the element stored at the indicated location in the array.</returns>
        PUBLIC PROPERTY SELF[index AS INT, index2 AS INT] AS USUAL
            GET
                LOCAL oElement AS T
                IF  index > _internalList:Count-1
                    THROW Error{ArgumentOutOfRangeException{nameof(index)}}
                ENDIF
                oElement := _internalList[index ]
                IF oElement IS IIndexedProperties
                    VAR oIndex := (IIndexedProperties) oElement
                    RETURN oIndex[index2]
                ENDIF
                LOCAL oProp    AS PropertyInfo
                oProp    := SELF:__GetIndexer(TRUE)
                IF oProp != NULL
                    RETURN oProp:GetValue(oElement, <OBJECT>{index2})
                ENDIF
                THROW Error{ArgumentException{"Indexed property missing for type: "+oElement:GetType():FullName}}
            END GET
            SET
                IF  index > _internalList:Count-1
                    THROW Error{ArgumentOutOfRangeException{nameof(index)}}
                ENDIF
                IF SELF:CheckLock()
                    LOCAL oElement AS T
                    oElement := _internalList[index ]
                    IF oElement IS IIndexedProperties
                        VAR oIndex := (IIndexedProperties) oElement
                        oIndex[index2] := value
                    ENDIF
                    LOCAL oProp    AS PropertyInfo
                    oProp    := SELF:__GetIndexer(TRUE)
                    IF oProp != NULL
                        oProp:SetValue(oElement, OOPHelpers.VOConvert(value, oProp:PropertyType), <OBJECT>{index2} )
                        RETURN
                    ENDIF
                    THROW Error{ArgumentException{"Indexed property missing for type: "+oElement:GetType():FullName}}
                ENDIF
            END SET
        END PROPERTY

        /// <include file="RTComments.xml" path="Comments/ZeroBasedIndexProperty/*" />
        /// <param name="index"><include file="RTComments.xml" path="Comments/ZeroBasedIndexParam/*" /></param>
        /// <param name="name"><include file="RTComments.xml" path="Comments/NameBasedIndexParam/*" /></param>
        /// <returns>The value of the property of the element stored at the indicated location in the array.</returns>
        PUBLIC PROPERTY SELF[index AS INT, name AS STRING] AS USUAL
            GET
                LOCAL oElement AS T
                IF  index > _internalList:Count-1
                    THROW Error{ArgumentOutOfRangeException{}}
                ENDIF
                oElement := _internalList[index ]
                IF oElement IS IIndexedProperties
                    VAR oIndex := (IIndexedProperties) oElement
                    RETURN oIndex[name]
                ENDIF
                LOCAL oProp    AS PropertyInfo
                oProp    := SELF:__GetIndexer(FALSE)
                IF oProp != NULL
                    RETURN oProp:GetValue(oElement, <OBJECT>{name})
                ENDIF
                oProp	 := SELF:__GetProperty( name)
                RETURN oProp:GetValue(oElement, NULL)
            END GET
            SET
                IF  index > _internalList:Count-1
                    THROW Error{ArgumentOutOfRangeException{}}
                ENDIF
                IF SELF:CheckLock()
                    LOCAL oElement AS T
                    oElement := _internalList[index ]
                    IF oElement IS IIndexedProperties
                        VAR oIndex := (IIndexedProperties) oElement
                        oIndex[name] := value
                    ENDIF
                    LOCAL oProp    AS PropertyInfo
                    oProp    := SELF:__GetIndexer(FALSE)
                    IF oProp != NULL
                        oProp:SetValue(oElement, OOPHelpers.VOConvert(value, oProp:PropertyType), <OBJECT>{name} )
                        RETURN
                    ENDIF
                    oProp	 := SELF:__GetProperty( name)
                    oProp:SetValue(oElement, NULL, value)
                ENDIF
            END SET
        END PROPERTY

        #endregion

        #region Insert and Delete elements
        /// <exclude />
        PUBLIC VIRTUAL METHOD Add(u AS T) AS VOID
            IF SELF:CheckLock()
                _internalList:Add(u)
            ENDIF
            RETURN

        /// <exclude />
        PUBLIC METHOD Delete(position AS INT) AS __ArrayBase<T>
            SELF:RemoveAt(position)
            SELF:Add(SELF:DefaultValue)
            RETURN SELF

        /// <exclude />
        PUBLIC METHOD Insert(index AS INT,u AS T) AS VOID
            IF SELF:CheckLock()
                _internalList:RemoveAt(_internalList:Count - 1)
                _internalList:Insert((INT) index-__ARRAYBASE__ ,u)
            ENDIF
            RETURN

        /// <exclude />
        PUBLIC METHOD Insert(position AS INT) AS __ArrayBase<T>
            SELF:Insert( position, SELF:DefaultValue)
            RETURN SELF

        /// <exclude />
        PUBLIC METHOD RemoveAt(index AS INT) AS VOID
            IF SELF:CheckLock()
                _internalList:RemoveRange(index-__ARRAYBASE__,1 )
            ENDIF
            RETURN

        /// <exclude />
        PUBLIC VIRTUAL METHOD Resize(newSize AS INT) AS VOID
            IF SELF:CheckLock()
                IF newSize == 0
                    _internalList:Clear()
                ELSE
                    LOCAL count := _internalList:Count AS INT
                    IF newSize <= count
                        _internalList:RemoveRange(newSize, count - newSize)
                    ELSE
                        count+=1
                        DO WHILE count <= newSize
                            _internalList:Add(SELF:DefaultValue)
                            count++
                        ENDDO
                    ENDIF
                ENDIF
            ENDIF
            RETURN

            #endregion
        /// <inheritdoc />
        PUBLIC OVERRIDE METHOD ToString() AS STRING
            RETURN String.Format("[{0}]",_internalList:Count)

        INTERNAL METHOD Sort(startIndex AS INT, count AS INT, comparer AS IComparer<T>) AS VOID
            IF startIndex <= 0
                startIndex := 1
            ENDIF
            IF count < 0
                count := _internalList:Count - startIndex + __ARRAYBASE__
            ENDIF
            _internalList:Sort(startIndex-__ARRAYBASE__ ,count,comparer)
            RETURN

        INTERNAL METHOD Sort(comparer AS IComparer<T>) AS VOID
            _internalList:Sort(comparer)
            RETURN

        INTERNAL METHOD Swap(position AS INT, element AS T) AS T
            LOCAL original := _internalList[position - __ARRAYBASE__] AS T
            _internalList[ position - __ARRAYBASE__]:=element
            RETURN original

        INTERNAL METHOD Swap(position AS INT, element AS OBJECT) AS T
            //try
            VAR elementT := (T) (OBJECT) element
            RETURN SELF:Swap( position, elementT)
            //catch
            //	throw ArgumentException{"Parameter is of incorrect type "+element:GetType():FullName,nameof(element)}
            //end try

        INTERNAL METHOD Tail() AS T
            RETURN _internalList:LastOrDefault()

            #region locking
        INTERNAL METHOD Lock(lLocked AS LOGIC) AS LOGIC
            LOCAL wasLocked AS LOGIC
            wasLocked := SELF:_islocked
            SELF:_islocked := lLocked
            RETURN wasLocked
            /// Is the array locked?
        [DebuggerBrowsable(DebuggerBrowsableState.Never)];
        PROPERTY Locked AS LOGIC GET _islocked

        INTERNAL METHOD CheckLock AS LOGIC
            IF SELF:_islocked
                THROW Error{Gencode.EG_PROTECTION}
            ENDIF
            RETURN ! SELF:_islocked

            #endregion

        #region operators
        /// Implicitely convert an array of USUALs to a typed array. Note that the usuals must contain a value of the correct type.
        STATIC OPERATOR IMPLICIT ( a AS ARRAY) AS __ArrayBase<T>
            VAR aResult := __ArrayBase<T>{}
            LOCAL oErr AS Error
            FOREACH VAR u IN a
                LOCAL o := u AS OBJECT
                IF o IS T
                    aResult:Add( (T) o)
                ELSE
                    LOCAL nArg AS INT
                    LOCAL oActType AS System.Type
                    oActType := o:GetType()
                    nArg := a:_internalList:IndexOf(u)+1
                    oErr := Error{Gencode.EG_DATATYPE}
                    oErr:Arg := "Array Element : "+nArg:ToString()
                    oErr:Description := "Cannot convert array element " +nArg:ToString() + " from type "+oActType:ToString()+" to type "+TYPEOF(T):ToString()
                    THROW oErr
                ENDIF
            NEXT
            RETURN aResult

        /// Implicitely convert a typed array to an array of USUALs.
        STATIC OPERATOR IMPLICIT ( a AS __ArrayBase<T> ) AS ARRAY
            VAR aResult := __Array{}
            FOREACH VAR o IN a
                aResult:Add(  o)
            NEXT
            RETURN aResult

        /// Implicitely convert a typed Array to an OBJECT[].
        STATIC OPERATOR IMPLICIT ( a AS __ArrayBase<T> ) AS OBJECT[]
            LOCAL aResult := List<OBJECT>{} AS List<OBJECT>
            FOREACH VAR o IN a
                aResult:Add( o)
            NEXT
            RETURN aResult:ToArray()

    #endregion

        PROTECTED VIRTUAL METHOD DebuggerString() AS STRING
            LOCAL sb AS StringBuilder
            LOCAL cnt, tot AS LONG
            sb := StringBuilder{}
            sb:Append(SELF:ToString())
            sb:Append("{")
            tot := _internalList:Count
            cnt := 0
            FOREACH element AS T IN SELF:_internalList
                IF cnt > 0
                    sb:Append(",")
                ENDIF
                if element != null
                    sb:Append(element:ToString())
                else
                    sb:Append("NULL")
                endif
                cnt++
                IF cnt > 5
                    IF cnt < tot
                        sb:Append(",..")
                    ENDIF
                    EXIT
                ENDIF
            NEXT
            sb:Append("}")
            RETURN sb:ToString()

    #region ISerializable
        /// <inheritdoc/>
        PUBLIC VIRTUAL METHOD GetObjectData(info AS SerializationInfo, context AS StreamingContext) AS VOID
            IF info == NULL
                THROW System.ArgumentException{"info"}
            ENDIF
            info:AddValue("Count", SELF:Count)
            FOR VAR i := 1 TO SELF:Count
                info:AddValue("Item"+i:ToString(), _internalList[i-1])
            NEXT
            RETURN

        /// <include file="RTComments.xml" path="Comments/SerializeConstructor/*" />
        CONSTRUCTOR (info AS SerializationInfo, context AS StreamingContext)
            IF info == NULL
                THROW System.ArgumentException{"info"}
            ENDIF
            VAR count := info:GetInt32("Count")
            _internalList := List<T>{  }
            FOR VAR i := 1 TO count
                _internalList:Add( (T) info:GetValue("Item"+i:ToString(), typeof(T)))
            NEXT

            #endregion

    END	CLASS
END NAMESPACE


QtX11Extras: deprecated 'class_id' property

/*

  Qt5xHb - bibliotecas de ligao entre Harbour/xHarbour e Qt Framework 5

  Copyright (C) 2012-2017 Marcos Antonio Gambeta <marcosgambeta@uol.com.br>

*/

#include "hbclass.ch"
#include "qt5xhb_clsid.ch"

#ifndef QT5XHB_NO_REQUESTS
REQUEST QBYTEARRAY
#endif

CLASS QX11Info

   DATA pointer
   //DATA class_id INIT Class_Id_QX11Info
   DATA class_flags INIT 0
   DATA self_destruction INIT .F.

   METHOD delete
   METHOD isPlatformX11
   METHOD appDpiX
   METHOD appDpiY
   METHOD appRootWindow
   METHOD appScreen
   METHOD appTime
   METHOD appUserTime
   METHOD setAppTime
   METHOD setAppUserTime
   METHOD getTimestamp
   METHOD display
   METHOD connection
   METHOD nextStartupId
   METHOD setNextStartupId

   METHOD newFrom
   METHOD newFromObject
   METHOD newFromPointer
   METHOD selfDestruction
   METHOD setSelfDestruction

   DESTRUCTOR destroyObject

END CLASS

PROCEDURE destroyObject () CLASS QX11Info
   IF ::self_destruction
      ::delete()
   ENDIF
RETURN

#pragma BEGINDUMP

#include <Qt>

#ifndef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
#include <QX11Info>
#endif
#endif

#include "qt5xhb_common.h"
#include "qt5xhb_clsid.h"
#include "qt5xhb_utils.h"

#ifdef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
#include <QX11Info>
#endif
#endif

HB_FUNC_STATIC( QX11INFO_DELETE )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  QX11Info * obj = (QX11Info *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    delete obj;
    obj = NULL;
    PHB_ITEM self = hb_stackSelfItem();
    PHB_ITEM ptr = hb_itemPutPtr( NULL, NULL );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
  }
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
static bool isPlatformX11()
*/
HB_FUNC_STATIC( QX11INFO_ISPLATFORMX11 )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retl( QX11Info::isPlatformX11 (  ) );
#endif
}

/*
static int appDpiX(int screen=-1)
*/
HB_FUNC_STATIC( QX11INFO_APPDPIX )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retni( QX11Info::appDpiX ( (int) ISNIL(1)? -1 : hb_parni(1) ) );
#endif
}

/*
static int appDpiY(int screen=-1)
*/
HB_FUNC_STATIC( QX11INFO_APPDPIY )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retni( QX11Info::appDpiY ( (int) ISNIL(1)? -1 : hb_parni(1) ) );
#endif
}

/*
static unsigned long appRootWindow(int screen=-1)
*/
HB_FUNC_STATIC( QX11INFO_APPROOTWINDOW )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::appRootWindow ( (int) ISNIL(1)? -1 : hb_parni(1) ) );
#endif
}

/*
static int appScreen()
*/
HB_FUNC_STATIC( QX11INFO_APPSCREEN )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retni( QX11Info::appScreen (  ) );
#endif
}

/*
static unsigned long appTime()
*/
HB_FUNC_STATIC( QX11INFO_APPTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::appTime (  ) );
#endif
}

/*
static unsigned long appUserTime()
*/
HB_FUNC_STATIC( QX11INFO_APPUSERTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::appUserTime (  ) );
#endif
}

/*
static void setAppTime(unsigned long time)
*/
HB_FUNC_STATIC( QX11INFO_SETAPPTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  unsigned long par1 = hb_parnl(1);
  QX11Info::setAppTime ( par1 );
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
static void setAppUserTime(unsigned long time)
*/
HB_FUNC_STATIC( QX11INFO_SETAPPUSERTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  unsigned long par1 = hb_parnl(1);
  QX11Info::setAppUserTime ( par1 );
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
static unsigned long getTimestamp()
*/
HB_FUNC_STATIC( QX11INFO_GETTIMESTAMP )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::getTimestamp (  ) );
#endif
}

/*
static Display *display()
*/
HB_FUNC_STATIC( QX11INFO_DISPLAY )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retptr( (Display *) QX11Info::display (  ) );
#endif
}

/*
static xcb_connection_t *connection()
*/
HB_FUNC_STATIC( QX11INFO_CONNECTION )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retptr( (xcb_connection_t *) QX11Info::connection (  ) );
#endif
}

/*
static QByteArray nextStartupId()
*/
HB_FUNC_STATIC( QX11INFO_NEXTSTARTUPID )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  QByteArray * ptr = new QByteArray( QX11Info::nextStartupId (  ) );
  _qt5xhb_createReturnClass ( ptr, "QBYTEARRAY" );
#endif
}

/*
static void setNextStartupId(const QByteArray &id)
*/
HB_FUNC_STATIC( QX11INFO_SETNEXTSTARTUPID )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  QByteArray * par1 = (QByteArray *) _qt5xhb_itemGetPtr(1);
  QX11Info::setNextStartupId ( *par1 );
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

HB_FUNC_STATIC( QX11INFO_NEWFROM )
{
  PHB_ITEM self = hb_stackSelfItem();
  if( hb_pcount() == 1 && ISOBJECT(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_objSendMsg( hb_param(1, HB_IT_OBJECT ), "POINTER", 0 ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  else if( hb_pcount() == 1 && ISPOINTER(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_param(1, HB_IT_POINTER ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  hb_itemReturn( self );
}

HB_FUNC_STATIC( QX11INFO_NEWFROMOBJECT )
{
  HB_FUNC_EXEC( QX11INFO_NEWFROM );
}

HB_FUNC_STATIC( QX11INFO_NEWFROMPOINTER )
{
  HB_FUNC_EXEC( QX11INFO_NEWFROM );
}

HB_FUNC_STATIC( QX11INFO_SELFDESTRUCTION )
{
  hb_retl( (bool) hb_itemGetL( hb_objSendMsg( hb_stackSelfItem(), "SELF_DESTRUCTION", 0 ) ) );
}

HB_FUNC_STATIC( QX11INFO_SETSELFDESTRUCTION )
{
  PHB_ITEM self = hb_stackSelfItem();
  if( hb_pcount() == 1 && ISLOG(1) )
  {
    PHB_ITEM des = hb_itemPutL( NULL, hb_parl(1) );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  hb_itemReturn( self );
}

#pragma ENDDUMP

/*

  Qt5xHb - bibliotecas de ligao entre Harbour/xHarbour e Qt Framework 5

  Copyright (C) 2012-2017 Marcos Antonio Gambeta <marcosgambeta@uol.com.br>

*/

#include "hbclass.ch"
#include "qt5xhb_clsid.ch"

#ifndef QT5XHB_NO_REQUESTS
REQUEST QBYTEARRAY
#endif

CLASS QX11Info

   DATA pointer
   DATA class_id INIT Class_Id_QX11Info
   DATA class_flags INIT 0
   DATA self_destruction INIT .F.

   METHOD delete
   METHOD isPlatformX11
   METHOD appDpiX
   METHOD appDpiY
   METHOD appRootWindow
   METHOD appScreen
   METHOD appTime
   METHOD appUserTime
   METHOD setAppTime
   METHOD setAppUserTime
   METHOD getTimestamp
   METHOD display
   METHOD connection
   METHOD nextStartupId
   METHOD setNextStartupId

   METHOD newFrom
   METHOD newFromObject
   METHOD newFromPointer
   METHOD selfDestruction
   METHOD setSelfDestruction

   DESTRUCTOR destroyObject

END CLASS

PROCEDURE destroyObject () CLASS QX11Info
   IF ::self_destruction
      ::delete()
   ENDIF
RETURN

#pragma BEGINDUMP

#include <Qt>

#ifndef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
#include <QX11Info>
#endif
#endif

#include "qt5xhb_common.h"
#include "qt5xhb_clsid.h"
#include "qt5xhb_utils.h"

#ifdef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
#include <QX11Info>
#endif
#endif

HB_FUNC_STATIC( QX11INFO_DELETE )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  QX11Info * obj = (QX11Info *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    delete obj;
    obj = NULL;
    PHB_ITEM self = hb_stackSelfItem();
    PHB_ITEM ptr = hb_itemPutPtr( NULL, NULL );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
  }
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
static bool isPlatformX11()
*/
HB_FUNC_STATIC( QX11INFO_ISPLATFORMX11 )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retl( QX11Info::isPlatformX11 (  ) );
#endif
}

/*
static int appDpiX(int screen=-1)
*/
HB_FUNC_STATIC( QX11INFO_APPDPIX )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retni( QX11Info::appDpiX ( (int) ISNIL(1)? -1 : hb_parni(1) ) );
#endif
}

/*
static int appDpiY(int screen=-1)
*/
HB_FUNC_STATIC( QX11INFO_APPDPIY )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retni( QX11Info::appDpiY ( (int) ISNIL(1)? -1 : hb_parni(1) ) );
#endif
}

/*
static unsigned long appRootWindow(int screen=-1)
*/
HB_FUNC_STATIC( QX11INFO_APPROOTWINDOW )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::appRootWindow ( (int) ISNIL(1)? -1 : hb_parni(1) ) );
#endif
}

/*
static int appScreen()
*/
HB_FUNC_STATIC( QX11INFO_APPSCREEN )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retni( QX11Info::appScreen (  ) );
#endif
}

/*
static unsigned long appTime()
*/
HB_FUNC_STATIC( QX11INFO_APPTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::appTime (  ) );
#endif
}

/*
static unsigned long appUserTime()
*/
HB_FUNC_STATIC( QX11INFO_APPUSERTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::appUserTime (  ) );
#endif
}

/*
static void setAppTime(unsigned long time)
*/
HB_FUNC_STATIC( QX11INFO_SETAPPTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  unsigned long par1 = hb_parnl(1);
  QX11Info::setAppTime ( par1 );
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
static void setAppUserTime(unsigned long time)
*/
HB_FUNC_STATIC( QX11INFO_SETAPPUSERTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  unsigned long par1 = hb_parnl(1);
  QX11Info::setAppUserTime ( par1 );
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
static unsigned long getTimestamp()
*/
HB_FUNC_STATIC( QX11INFO_GETTIMESTAMP )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::getTimestamp (  ) );
#endif
}

/*
static Display *display()
*/
HB_FUNC_STATIC( QX11INFO_DISPLAY )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retptr( (Display *) QX11Info::display (  ) );
#endif
}

/*
static xcb_connection_t *connection()
*/
HB_FUNC_STATIC( QX11INFO_CONNECTION )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retptr( (xcb_connection_t *) QX11Info::connection (  ) );
#endif
}

/*
static QByteArray nextStartupId()
*/
HB_FUNC_STATIC( QX11INFO_NEXTSTARTUPID )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  QByteArray * ptr = new QByteArray( QX11Info::nextStartupId (  ) );
  _qt5xhb_createReturnClass ( ptr, "QBYTEARRAY" );
#endif
}

/*
static void setNextStartupId(const QByteArray &id)
*/
HB_FUNC_STATIC( QX11INFO_SETNEXTSTARTUPID )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  QByteArray * par1 = (QByteArray *) _qt5xhb_itemGetPtr(1);
  QX11Info::setNextStartupId ( *par1 );
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

HB_FUNC_STATIC( QX11INFO_NEWFROM )
{
  PHB_ITEM self = hb_stackSelfItem();
  if( hb_pcount() == 1 && ISOBJECT(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_objSendMsg( hb_param(1, HB_IT_OBJECT ), "POINTER", 0 ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  else if( hb_pcount() == 1 && ISPOINTER(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_param(1, HB_IT_POINTER ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  hb_itemReturn( self );
}

HB_FUNC_STATIC( QX11INFO_NEWFROMOBJECT )
{
  HB_FUNC_EXEC( QX11INFO_NEWFROM );
}

HB_FUNC_STATIC( QX11INFO_NEWFROMPOINTER )
{
  HB_FUNC_EXEC( QX11INFO_NEWFROM );
}

HB_FUNC_STATIC( QX11INFO_SELFDESTRUCTION )
{
  hb_retl( (bool) hb_itemGetL( hb_objSendMsg( hb_stackSelfItem(), "SELF_DESTRUCTION", 0 ) ) );
}

HB_FUNC_STATIC( QX11INFO_SETSELFDESTRUCTION )
{
  PHB_ITEM self = hb_stackSelfItem();
  if( hb_pcount() == 1 && ISLOG(1) )
  {
    PHB_ITEM des = hb_itemPutL( NULL, hb_parl(1) );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  hb_itemReturn( self );
}

#pragma ENDDUMP


行末の改行を取り出した際、どの条件にも当てはまらずphase = NONEとなった状態で配列tk$, typeにpushされてしまう不具合を修正 phaseがNONEでないならばtk$, typeへの記録を行うようにした

' PROJECT SMILE++
' Smile++ Transpiler 2017.1

option strict

acls
prgEdit 1

' 配列の要素を検索する

def indexOf$(array$[], string$)
	var i
	for i = 0 to len(array$) - 1
		if array$[i] == string$ then return i
	next
	return -1
end

' 配列を生成する

def array(list$)
	dim arr[0]
	var tmp = ""
	var i
	var c$ = ""
	for i = 0 to len(list$) - 1
		c$ = mid$(list$, i, 1)
		if c$ == " " && tmp$ != "" then
			push arr, val(tmp$)
			tmp$ = ""
		endif
		tmp$ = tmp$ + c$
	next
	if tmp$ != "" && tmp$ != " " then push arr, val(tmp$)
	return arr
end

def array$(list$)
	dim arr$[0]
	var tmp$ = ""
	var i
	var c$ = ""
	for i = 0 to len(list$) - 1
		c$ = mid$(list$, i, 1)
		if c$ == " " && tmp$ != "" then
			push arr$, tmp$
			tmp$ = ""
		else
			tmp$ = tmp$ + c$
		endif
	next
	if tmp$ != "" && tmp$ != " " then push arr$, tmp$
	return arr$
end

' 配列の内容を出力する

def arrayDump arr[]
	var i
	for i = 0 to len(arr) - 1
		? str$(arr[i]) + " ";
	next
	? ""
end

def arrayDump arr$[]
	var i
	for i = 0 to len(arr$) - 1
		? arr$[i] + " ";
	next
	? ""
end

' 定数

var NONE = -1, UNKNOWN = 1, DIRECTION = 2, RESERVED = 3
var OPERATOR = 4, CONSTANT = 5, STRING = 6

' 演算子

dim operators$[0]
operators$ = array$("+ - * / DIV MOD << >> NOT ( ) == != < <= > >= && || AND OR XOR !")

' 予約語

dim reservedWords$[0]
reservedWords$ = array$("IF THEN ELSE ELSEIF ENDIF GOTO GOSUB RETURN ON FOR NEXT WHILE WEND REPEAT UNTIL BREAK CONTINUE DEF END VAR DIM DATA READ RESTORE PRINT INPUT LINPUT CALL SWAP OUT COMMON USE EXEC FILES SAVE RENAME DELETE CHKFILE PRGEDIT PRGGET$ PRGSET PRGINS PRGDEL PRGSIZE PRGNAME$ XSCREEN DISPLAY VISIBLE BACKCOLOR ACLS FADE CLS COLOR LOCATE PRINT ? ATTR SCROLL FONTDEF WIDTH SPPAGE SPCLIP SPDEF SPSET SPCLR SPSHOW SPHIDE SPHOME SPOFS SPROT SPSCALE SPCOLOR SPCHR SPLINK SPUNLINK SPANIM SPSTOP SPSTART SPCHK SPVAR SPCOL SPCOLVEC SPHITINFO SPFUNC BGPAGE BGSCREEN BGCLR BGSHOW BGHIDE BGCLIP BGHOME BGOFS BGROT BGSCALE BGPUT BGFILL BGSET BGANIM BGSTOP BGSTART BGCHK BGVAR BGLOAD BGSAVE BGCOORD BGCOLOR BGFUNC GPAGE GCOLOR RGBREAD GCLIP GPRIO GCLS GPSET GLINE GCIRCLE GBOX GFILL GPAINT GCOPY GSAVE GLOAD GTRI GPUTCHR GOFS GPUTCHR16 XON XOFF BUTTON BREPEAT STICK STICKX ACCEL GYROA GYROV GYROSYNC TOUCH MICSTART MICSTOP MICDATA MICSAVE CONTROLLER VIBLATE BEEP BGMCHK BGMCLEAR BGMPLAY BGMSET BGMSETD BGMVAR BGMSTOP BGMVOL WAVSET WAVSETA EFCOFF EFCON EFCSET EFCWET TALK TALKCHK TALKSTOP BGMPAUSE BGMCONT SNDSTOP BIQUAD BQPARAM FFT IFFT FFTWFN PCMCONT PCMSTOP PCMSTREAM PCMVOL RINGCOPY ARYOP MPSTART MPSEND MPRECV MPSTAT MPNAME$ MPGET MPSET INC DEC COPY SORT RSORT PUSH UNSHIFT FILL RANDOMIZE STOP OPTION WAIT VSYNC REM KEY DTREAD TMREAD DIALOG CLIPBOARD DLCOPEN")

' 組み込み定数

dim constants$[0]
constants$ = array$("ON OFF YES NO TRUE FALSE BLACK NAVY BLUE GREEN TEAL LIME AQUA CYAN MAROON PURPLE OLIVE GRAY SILVER RED FUCHSIA MAGENTA YELLOW WHITE TBLACK TMAROON TRED TGREEN TLIME TOLIVE TYELLOW TNAVY TBLUE TPURPLE TMAGENTA TTREAL TCYAN TGRAY TWHITE UP DOWN LEFT RIGHT A B X Y L R ZR ZL TROT0 TROT90 TROT180 TROT270 TREVH TREVV SPSHOW SPROT0 SPROT90 SPROT180 SPROT180 SPROT270 SPREVH SPREVV SPADD BGROT0 BGROT90 BGROT180 BGROT270 BGREVH BGREVV CHKXY CHKZ CHKUV CHKI CHKR CHKS CHKC CHKV BQAPF BQLPF BQHPF BQBPF BQBSF BQLSF BQHSF BQPEQ WFRECT WFHAMM WFHANN WFBLKM AOPADD AOPSUB AOPMUL AOPDIV AOPMAD AOPLIP AOPCLP")

' 字句解析

def lex string$, tk$[], type[]
	var record$ = ""
	var phase = NONE
	var index = 0
	var isRecorded = false

	while true
		var c$ = mid$(string$, index, 1)

		if c$ == chr$(34) && phase != NONE then
			phase = STRING
			isRecorded = true
			inc index
		elseif c$ == chr$(34) && phase == STRING then
			push type, phase : phase = NONE
			push tk$, record$ + chr$(34)
			record$ = ""
			isRecorded = false
			inc index
		elseif phase == STRING && index != len(string$) - 1 then
			inc index
		elseif c$ == chr$(34) && phase != STRING then
			if indexOf$(reservedWords$, record$) != -1 then phase = RESERVED
			if indexOf$(operators$, record$) != -1 then phase = OPERATOR
			if phase == DIRECTION && indexOf$(constants$, record$) != -1 then phase = CONSTANT
			push type, phase : phase = NONE
			push tk$, record$
			record$ = ""
			phase = STRING
			inc index
		elseif c$ == "#" then
			phase = DIRECTION
			isRecorded = true
			inc index
		elseif c$ == " " || index == len(string$) - 1 then
			if phase == UNKNOWN then
				if indexOf$(reservedWords$, record$) != -1 then phase = RESERVED
				if indexOf$(operators$, record$) != -1 then phase = OPERATOR
			endif
			if phase == DIRECTION && indexOf$(constants$, record$) != -1 then phase = CONSTANT
			if phase == STRING then ? "Error: 文字列定数がダブルクォートによって正しく閉じられていません" : break
			if phase != NONE then
				push type, phase : phase = NONE
				push tk$, record$
				record$ = ""
				isRecorded = false
			endif
			inc index
		elseif c$ != " " && !isRecorded then
			phase = UNKNOWN
			isRecorded = true
			inc index
		else
			inc index
		endif

		if isRecorded then record$ = record$ + c$
		if index >= len(string$) then break
	wend
end

var i, n
for n = 0 to prgSize(1) - 1
	dim tk$[0]
	dim type[0]
	lex prgGet$(), tk$, type
	for i = 0 to len(tk$)
		? tk$[i] + " " + str$(type[i])
	next
next

' PROJECT SMILE++
' Smile++ Transpiler 2017.1

option strict

acls
prgEdit 1

' 配列の要素を検索する

def indexOf$(array$[], string$)
	var i
	for i = 0 to len(array$) - 1
		if array$[i] == string$ then return i
	next
	return -1
end

' 配列を生成する

def array(list$)
	dim arr[0]
	var tmp = ""
	var i
	var c$ = ""
	for i = 0 to len(list$) - 1
		c$ = mid$(list$, i, 1)
		if c$ == " " && tmp$ != "" then
			push arr, val(tmp$)
			tmp$ = ""
		endif
		tmp$ = tmp$ + c$
	next
	if tmp$ != "" && tmp$ != " " then push arr, val(tmp$)
	return arr
end

def array$(list$)
	dim arr$[0]
	var tmp$ = ""
	var i
	var c$ = ""
	for i = 0 to len(list$) - 1
		c$ = mid$(list$, i, 1)
		if c$ == " " && tmp$ != "" then
			push arr$, tmp$
			tmp$ = ""
		else
			tmp$ = tmp$ + c$
		endif
	next
	if tmp$ != "" && tmp$ != " " then push arr$, tmp$
	return arr$
end

' 配列の内容を出力する

def arrayDump arr[]
	var i
	for i = 0 to len(arr) - 1
		? str$(arr[i]) + " ";
	next
	? ""
end

def arrayDump arr$[]
	var i
	for i = 0 to len(arr$) - 1
		? arr$[i] + " ";
	next
	? ""
end

' 定数

var NONE = -1, UNKNOWN = 1, DIRECTION = 2, RESERVED = 3
var OPERATOR = 4, CONSTANT = 5, STRING = 6

' 演算子

dim operators$[0]
operators$ = array$("+ - * / DIV MOD << >> NOT ( ) == != < <= > >= && || AND OR XOR !")

' 予約語

dim reservedWords$[0]
reservedWords$ = array$("IF THEN ELSE ELSEIF ENDIF GOTO GOSUB RETURN ON FOR NEXT WHILE WEND REPEAT UNTIL BREAK CONTINUE DEF END VAR DIM DATA READ RESTORE PRINT INPUT LINPUT CALL SWAP OUT COMMON USE EXEC FILES SAVE RENAME DELETE CHKFILE PRGEDIT PRGGET$ PRGSET PRGINS PRGDEL PRGSIZE PRGNAME$ XSCREEN DISPLAY VISIBLE BACKCOLOR ACLS FADE CLS COLOR LOCATE PRINT ? ATTR SCROLL FONTDEF WIDTH SPPAGE SPCLIP SPDEF SPSET SPCLR SPSHOW SPHIDE SPHOME SPOFS SPROT SPSCALE SPCOLOR SPCHR SPLINK SPUNLINK SPANIM SPSTOP SPSTART SPCHK SPVAR SPCOL SPCOLVEC SPHITINFO SPFUNC BGPAGE BGSCREEN BGCLR BGSHOW BGHIDE BGCLIP BGHOME BGOFS BGROT BGSCALE BGPUT BGFILL BGSET BGANIM BGSTOP BGSTART BGCHK BGVAR BGLOAD BGSAVE BGCOORD BGCOLOR BGFUNC GPAGE GCOLOR RGBREAD GCLIP GPRIO GCLS GPSET GLINE GCIRCLE GBOX GFILL GPAINT GCOPY GSAVE GLOAD GTRI GPUTCHR GOFS GPUTCHR16 XON XOFF BUTTON BREPEAT STICK STICKX ACCEL GYROA GYROV GYROSYNC TOUCH MICSTART MICSTOP MICDATA MICSAVE CONTROLLER VIBLATE BEEP BGMCHK BGMCLEAR BGMPLAY BGMSET BGMSETD BGMVAR BGMSTOP BGMVOL WAVSET WAVSETA EFCOFF EFCON EFCSET EFCWET TALK TALKCHK TALKSTOP BGMPAUSE BGMCONT SNDSTOP BIQUAD BQPARAM FFT IFFT FFTWFN PCMCONT PCMSTOP PCMSTREAM PCMVOL RINGCOPY ARYOP MPSTART MPSEND MPRECV MPSTAT MPNAME$ MPGET MPSET INC DEC COPY SORT RSORT PUSH UNSHIFT FILL RANDOMIZE STOP OPTION WAIT VSYNC REM KEY DTREAD TMREAD DIALOG CLIPBOARD DLCOPEN")

' 組み込み定数

dim constants$[0]
constants$ = array$("ON OFF YES NO TRUE FALSE BLACK NAVY BLUE GREEN TEAL LIME AQUA CYAN MAROON PURPLE OLIVE GRAY SILVER RED FUCHSIA MAGENTA YELLOW WHITE TBLACK TMAROON TRED TGREEN TLIME TOLIVE TYELLOW TNAVY TBLUE TPURPLE TMAGENTA TTREAL TCYAN TGRAY TWHITE UP DOWN LEFT RIGHT A B X Y L R ZR ZL TROT0 TROT90 TROT180 TROT270 TREVH TREVV SPSHOW SPROT0 SPROT90 SPROT180 SPROT180 SPROT270 SPREVH SPREVV SPADD BGROT0 BGROT90 BGROT180 BGROT270 BGREVH BGREVV CHKXY CHKZ CHKUV CHKI CHKR CHKS CHKC CHKV BQAPF BQLPF BQHPF BQBPF BQBSF BQLSF BQHSF BQPEQ WFRECT WFHAMM WFHANN WFBLKM AOPADD AOPSUB AOPMUL AOPDIV AOPMAD AOPLIP AOPCLP")

' 字句解析

def lex string$, tk$[], type[]
	var record$ = ""
	var phase = NONE
	var index = 0
	var isRecorded = false

	while true
		var c$ = mid$(string$, index, 1)

		if c$ == chr$(34) && phase != NONE then
			phase = STRING
			isRecorded = true
			inc index
		elseif c$ == chr$(34) && phase == STRING then
			push type, phase : phase = NONE
			push tk$, record$ + chr$(34)
			record$ = ""
			isRecorded = false
			inc index
		elseif phase == STRING && index != len(string$) - 1 then
			inc index
		elseif c$ == chr$(34) && phase != STRING then
			if indexOf$(reservedWords$, record$) != -1 then phase = RESERVED
			if indexOf$(operators$, record$) != -1 then phase = OPERATOR
			if phase == DIRECTION && indexOf$(constants$, record$) != -1 then phase = CONSTANT
			push type, phase : phase = NONE
			push tk$, record$
			record$ = ""
			phase = STRING
			inc index
		elseif c$ == "#" then
			phase = DIRECTION
			isRecorded = true
			inc index
		elseif c$ == " " || index == len(string$) - 1 then
			if phase == UNKNOWN then
				if indexOf$(reservedWords$, record$) != -1 then phase = RESERVED
				if indexOf$(operators$, record$) != -1 then phase = OPERATOR
			endif
			if phase == DIRECTION && indexOf$(constants$, record$) != -1 then phase = CONSTANT
			if phase == STRING then ? "Error: 文字列定数がダブルクォートによって正しく閉じられていません" : break
			push type, phase : phase = NONE
			push tk$, record$
			record$ = ""
			isRecorded = false
			inc index
		elseif c$ != " " && !isRecorded then
			phase = UNKNOWN
			isRecorded = true
			inc index
		else
			inc index
		endif

		if isRecorded then record$ = record$ + c$
		if index >= len(string$) then break
	wend
end

var i, n
for n = 0 to prgSize(1) - 1
	dim tk$[0]
	dim type[0]
	lex prgGet$(), tk$, type
	for i = 0 to len(tk$)
		? tk$[i] + " " + str$(type[i])
	next
next


this is order preserving now and always detects duplicates (by algorithm, not by constraint)

import "../src/LangPrelude.prg" (maybeM)

kind Inventory = Empty | More Inventory Nat deriving LeftList(i)

data NatList :: Inventory ~> * where
  Nope :: NatList []i
  Augment :: NatList i -> Nat' n -> NatList [i; n]i
 deriving LeftList(nl)

data LeftThrist :: forall (l :: *1) . (l ~> l ~> *)  ~> l ~> l ~> * where
  LNil :: LeftThrist k a a
  LCons :: LeftThrist k a b -> k b c -> LeftThrist k a c
 deriving LeftList(lt)

data Elem :: Inventory ~> Inventory ~> * where
  Single :: NatList nl -> Elem i {merge i nl}

monad maybeM

merge :: Inventory ~> Inventory ~> Inventory
{merge []i i} = i
{merge [as; a]i []i} = [as; a]i
{merge [as; a]i [bs; b]i} = {arrange as bs a b a b}

mergeNL :: NatList i -> NatList j -> Maybe (NatList {merge i j})
mergeNL []nl j = Just j
mergeNL (i@[as; a]nl) []nl = Just i
mergeNL [as; a]nl [bs; b]nl = arrNL as bs a b a b
mergeNL _ _ = Nothing

arrange :: Inventory ~> Inventory ~> Nat ~> Nat ~> Nat ~> Nat ~> Inventory
{arrange i j 0t (1+b')t a b} = [{merge [i; a]i j}; b]i
{arrange i j (1+a')t 0t a b} = [{merge i [j; b]i}; a]i
{arrange i j (1+a')t (1+b')t a b} = {arrange i j a' b' a b}

arrNL :: NatList i -> NatList j -> Nat' a' -> Nat' b' -> Nat' a -> Nat' b -> Maybe (NatList {arrange i j a' b' a b})
arrNL i j 0v (1+b')v a b = do { iaj <- mergeNL [i; a]nl j; return [iaj; b]nl }
arrNL i j (1+a')v 0v a b = do { ijb <- mergeNL i [j; b]nl; return [ijb; a]nl }
arrNL i j (1+a')v (1+b')v a b = arrNL i j a' b' a b
arrNL _ _ _ _ _ _ = Nothing

join :: NatList i -> LeftThrist Elem []i i -> NatList j -> Maybe (LeftThrist Elem []i {merge i j}, NatList {merge i j})
join i thr j = do { ij <- mergeNL i j
                  ; return ([thr; Single j]lt, ij) }

Just (t1, e1) = join [0v, 2v, 4v]nl [Single [0v, 2v, 4v]nl]lt [3v]nl
Just (t2, e2) = join e1 t1 [1v, 5v]nl

import "../src/LangPrelude.prg" (maybeM)

kind Inventory = Empty | More Inventory Nat deriving LeftList(i)

data NatList :: Inventory ~> * where
  Nope :: NatList []i
  Augment :: NatList i -> Nat' n -> NatList [i; n]i
 deriving LeftList(nl)

data LeftThrist :: forall (l :: *1) . (l ~> l ~> *)  ~> l ~> l ~> * where
  LNil :: LeftThrist k a a
  LCons :: LeftThrist k a b -> k b c -> LeftThrist k a c
 deriving LeftList(lt)

data Elem :: Inventory ~> Inventory ~> * where
  Single :: NatList nl -> Elem i {merge i nl}

monad maybeM

merge :: Inventory ~> Inventory ~> Inventory
{merge []i i} = i
{merge [as; a]i []i} = [as; a]i
{merge [as; a]i [bs; b]i} = {arrange {merge as bs} a b a b}

mergeNL :: NatList i -> NatList j -> Maybe (NatList {merge i j})
mergeNL []nl j = Just j
mergeNL (i@[as; a]nl) []nl = Just i
mergeNL [as; a]nl [bs; b]nl = do { abs <- mergeNL as bs
                                 ; arrNL abs a b a b }
mergeNL _ _ = Nothing

arrange :: Inventory ~> Nat ~> Nat ~> Nat ~> Nat ~> Inventory
{arrange i 0t (S b') a b} = [i; a, b]i
{arrange i (S a') 0t a b} = [i; b, a]i
{arrange i (S a') (S b') a b} = {arrange i a' b' a b}

arrNL :: NatList i -> Nat' a' -> Nat' b' -> Nat' a -> Nat' b -> Maybe (NatList {arrange i a' b' a b})
arrNL i 0v (1+b')v a b = Just [i; a, b]nl
arrNL i (1+a')v 0v a b = Just [i; b, a]nl
arrNL i (1+a')v (1+b')v a b = arrNL i a' b' a b
arrNL _ _ _ _ _ = Nothing

join :: NatList i -> LeftThrist Elem []i i -> NatList j -> Maybe (LeftThrist Elem []i {merge i j}, NatList {merge i j})
join i thr j = do { ij <- mergeNL i j
                  ; return ([thr; Single j]lt, ij) }

Just (t1, e1) = join [0v, 2v, 4v]nl [Single [0v, 2v, 4v]nl]lt [3v]nl
Just (t2, e2) = join e1 t1 [8v]nl