tests/mainwindow.prg: updated

tests/mainwindow.prg: updated

Modified:
tests/mainwindow.prg

/*

  Qt4xHb Project - Test Program

  Copyright (C) 2017 Marcos Antonio Gambeta

  E-mail:
  marcosgambeta AT outlook DOT com

  Website:
  https://github.com/marcosgambeta/Qt4xHb

*/

/*
  Exemplo de criao da janela principal de uma aplicao
*/

#include "qt4xhb.ch"

STATIC oApp
STATIC oMainWindow

/*
  a funo principal (main) cria um objeto da classe QApplication,
  um objeto da classe HMainWindow e inicia o loop de eventos
*/

PROCEDURE Main ()

   oApp := QApplication():new()

   oMainWindow := HMainWindow():new()

   oMainWindow:show()

   oApp:exec()

   oMainWindow:delete()

   oApp:delete()

RETURN

/*
  a classe HMainWindow  uma classe derivada da classe QMainWindow, com mtodos para:
  . definir as propriedades da janela
  . criar a barra de menus e as aes
  . criar a barra de ferramentas
  . criar a barra de status
  . confirmar se o usurio quer realmente sair do programa
  . exibir mensagens
*/

#include "hbclass.ch"

CLASS HMainWindow INHERIT QMainWindow

   DATA oMenuBar
   DATA oMenu1
   DATA oActionNew
   DATA oActionOpen
   DATA oActionSave
   DATA oMenu2
   DATA oActionCut
   DATA oActionCopy
   DATA oActionPaste
   DATA oMenu3
   DATA oActionAbout
   DATA oActionAboutxH
   DATA oActionAboutCC
   DATA oActionAboutQt
   DATA oToolBar
   DATA oStatusBar

   METHOD new
   METHOD defineProperties
   METHOD createMenuBar
   METHOD createToolBar
   METHOD createStatusBar
   METHOD defineEvents
   METHOD closeMainWindow
   METHOD showMessage

END CLASS

/*
 o mtodo 'new' executa o mtodo 'new' da classe QMainWindow
 e configura a janela principal
*/

METHOD new () CLASS HMainWindow

   #ifdef __XHARBOUR__
   super:new()
   #else
   ::super:new()
   #endif

   ::defineProperties()
   ::createMenuBar()
   ::createToolBar()
   ::createStatusBar()
   ::defineEvents()

RETURN self

/*
  o mtodo 'defineProperties' define as propriedades
  'title' e 'size' da janela principal
*/

METHOD defineProperties () CLASS HMainWindow

   ::setWindowTitle("Qt4xHb - exemplo de criao da janela principal")
   ::resize(800,600)

RETURN self

/*
  o mtodo 'createMenuBar' cria os menus da janela principal
  e configura a ao que cada item do menu ir executar
*/

METHOD createMenuBar () CLASS HMainWindow

   ::oMenuBar := ::menuBar()

   ::oMenu1 := ::oMenuBar:addMenu("&Arquivo")

   ::oActionNew := ::oMenu1:AddAction(QIcon():new("images\new.png"),"&Novo")
   ::oActionNew:setStatusTip("Executa a opo NOVO")
   ::oActionNew:onTriggered( {||::showMessage("Arquivo/Novo")} )

   ::oActionOpen := ::oMenu1:AddAction(QIcon():new("images\open.png"),"&Abrir")
   ::oActionOpen:setStatusTip("Executa a opo ABRIR")
   ::oActionOpen:onTriggered({||::showMessage("Arquivo/Abrir")})

   ::oActionSave := ::oMenu1:AddAction(QIcon():new("images\save.png"),"&Salvar")
   ::oActionSave:setStatusTip("Executa a opo SALVAR")
   ::oActionSave:onTriggered({||::showMessage("Arquivo/Salvar")})

   ::oMenu2 := ::oMenuBar:AddMenu("&Editar")

   ::oActionCut := ::oMenu2:AddAction(QIcon():New("images\cut.png"),"&Recortar")
   ::oActionCut:setStatusTip("Executa a opo RECORTAR")
   ::oActionCut:onTriggered({||::showMessage("Editar/Recortar")})

   ::oActionCopy := ::oMenu2:AddAction(QIcon():new("images\copy.png"),"&Copiar")
   ::oActionCopy:setStatusTip("Executa a opo COPIAR")
   ::oActionCopy:onTriggered( {||::showMessage("Editar/Copiar")})

   ::oActionPaste := ::oMenu2:AddAction(QIcon():New("images\paste.png"),"C&olar")
   ::oActionPaste:setStatusTip("Executa a opo COLAR")
   ::oActionPaste:onTriggered({||::showMessage("Editar/Colar")})

   ::oMenu3 := ::oMenuBar:AddMenu("&Sobre")

   ::oActionAbout := ::oMenu3:AddAction("&Exemplo")
   ::oActionAbout:setStatusTip("Exibe informaes sobre este exemplo")
   ::oActionAbout:onTriggered({||::showMessage("Este exemplo demonstra a criao da janela principal de uma aplicao")})

   ::oActionAboutxH := ::oMenu3:AddAction("&xHarbour")
   ::oActionAboutxH:setStatusTip("Exibe a verso do Harbour/xHarbour")
   ::oActionAboutxH:onTriggered({||::showMessage(version())})

   ::oActionAboutCC := ::oMenu3:AddAction("&C/C++ Compiler")
   ::oActionAboutCC:setStatusTip("Exibe informaes sobre o compilador C/C++")
   ::oActionAboutCC:onTriggered({||::showMessage(hb_compiler())})

   ::oActionAboutQt := ::oMenu3:AddAction("&Qt Framework")
   ::oActionAboutQt:setStatusTip("Exibe informaes sobre o Qt Framework")
   ::oActionAboutQt:onTriggered( {||oApp:aboutQt()})

RETURN self

/*
  o mtodo 'createToolBar' cria a barra de ferramentas da janela principal
  e configura a ao que cada boto ir executar
*/

METHOD createToolBar () CLASS HMainWindow

   ::oToolBar := ::addToolBar("")

   ::oToolBar:addAction(::oActionNew)
   ::oToolBar:addAction(::oActionOpen)
   ::oToolBar:addAction(::oActionSave)

   ::oToolBar:addSeparator()

   ::oToolBar:addAction(::oActionCut)
   ::oToolBar:addAction(::oActionCopy)
   ::oToolBar:addAction(::oActionPaste)

RETURN self

/*
  o mtodo 'createStatusBar' cria a barra de status
*/

METHOD createStatusBar () CLASS HMainWindow

   ::oStatusBar := ::statusBar()

RETURN self

/*
 o mtodo 'defineEvent' define os eventos que sero processados
*/

METHOD defineEvents () CLASS HMainWindow

   ::onCloseEvent({|oSender,oEvent|::CloseMainWindow(oSender,oEvent)})

RETURN self

/*
 o mtodo 'closeMainWindow' confirma, com o usurio, se quer
 realmente sair do programa
*/

METHOD closeMainWindow (oSender,oCloseEvent) CLASS HMainWindow

   LOCAL oMB
   LOCAL nRet

   oMB := QMessageBox():new(QMessageBox_Question,;
                            "Ateno",;
                            "Quer realmente sair do programa ?",;
                            QMessageBox_Yes+QMessageBox_No,;
                            self,;
                            Qt_Dialog+Qt_MSWindowsFixedSizeDialogHint)

   nRet := oMB:exec()

   oMB:delete()

   IF nRet == QMessageBox_Yes
      oCloseEvent:accept()
   endif

   IF nRet == QMessageBox_No
      oCloseEvent:ignore()
   endif

RETURN .T.

/*
  o mtodo 'showMessage' exibe uma janela com uma mensagem,
  usando a classe QMessageBox
*/

METHOD showMessage (cText) CLASS HMainWindow

   LOCAL oMB

   oMB := QMessageBox():new(QMessageBox_Information,"Informao",cText,QMessageBox_Ok,self)

   oMB:exec()

   oMB:delete()

RETURN NIL

/*

  Qt4xHb Project - Test Program

  Copyright (C) 2017 Marcos Antonio Gambeta

  E-mail:
  marcosgambeta AT outlook DOT com

  Website:
  https://github.com/marcosgambeta/Qt4xHb

*/

/*
  Exemplo de criao da janela principal de uma aplicao
*/

#include "qt4xhb.ch"

STATIC oApp
STATIC oMainWindow

/*
  a funo principal (main) cria um objeto da classe QApplication,
  um objeto da classe HMainWindow e inicia o loop de eventos
*/

PROCEDURE Main ()

   oApp := QApplication():new()

   oMainWindow := HMainWindow():new()

   oMainWindow:show()

   oApp:exec()

   oMainWindow:delete()

   oApp:delete()

RETURN

/*
  a classe HMainWindow  uma classe derivada da classe QMainWindow, com mtodos para:
  . definir as propriedades da janela
  . criar a barra de menus e as aes
  . criar a barra de ferramentas
  . criar a barra de status
  . confirmar se o usurio quer realmente sair do programa
  . exibir mensagens
*/

#include "hbclass.ch"

CLASS HMainWindow INHERIT QMainWindow

   DATA oMenuBar
   DATA oMenu1
   DATA oActionNew
   DATA oActionOpen
   DATA oActionSave
   DATA oMenu2
   DATA oActionCut
   DATA oActionCopy
   DATA oActionPaste
   DATA oMenu3
   DATA oActionAbout
   DATA oActionAboutxH
   DATA oActionAboutCC
   DATA oActionAboutQt
   DATA oToolBar
   DATA oStatusBar

   METHOD new
   METHOD defineProperties
   METHOD createMenuBar
   METHOD createToolBar
   METHOD createStatusBar
   METHOD defineEvents
   METHOD closeMainWindow
   METHOD showMessage

END CLASS

/*
 o mtodo 'new' executa o mtodo 'new' da classe QMainWindow
 e configura a janela principal
*/

METHOD new () CLASS HMainWindow

   #ifdef __XHARBOUR__
   super:new()
   #else
   ::super:new()
   #endif

   ::defineProperties()
   ::createMenuBar()
   ::createToolBar()
   ::createStatusBar()
   ::defineEvents()

RETURN self

/*
  o mtodo 'defineProperties' define as propriedades
  'title' e 'size' da janela principal
*/

METHOD defineProperties () CLASS HMainWindow

   ::setWindowTitle("Qt4xHb - exemplo de criao da janela principal")
   ::resize(800,600)

RETURN self

/*
  o mtodo 'createMenuBar' cria os menus da janela principal
  e configura a ao que cada item do menu ir executar
*/

METHOD createMenuBar () CLASS HMainWindow

   ::oMenuBar := ::menuBar()

   ::oMenu1 := ::oMenuBar:addMenu("&Arquivo")

   ::oActionNew := ::oMenu1:AddAction(QIcon():new("images\new.png"),"&Novo")
   ::oActionNew:setStatusTip("Executa a opo NOVO")
   ::oActionNew:onTriggered( {||::showMessage("Arquivo/Novo")} )

   ::oActionOpen := ::oMenu1:AddAction(QIcon():new("images\open.png"),"&Abrir")
   ::oActionOpen:setStatusTip("Executa a opo ABRIR")
   ::oActionOpen:onTriggered({||::showMessage("Arquivo/Abrir")})

   ::oActionSave := ::oMenu1:AddAction(QIcon():new("images\save.png"),"&Salvar")
   ::oActionSave:setStatusTip("Executa a opo SALVAR")
   ::oActionSave:onTriggered({||::showMessage("Arquivo/Salvar")})

   ::oMenu2 := ::oMenuBar:AddMenu("&Editar")

   ::oActionCut := ::oMenu2:AddAction(QIcon():New("images\cut.png"),"&Recortar")
   ::oActionCut:setStatusTip("Executa a opo RECORTAR")
   ::oActionCut:onTriggered({||::showMessage("Editar/Recortar")})

   ::oActionCopy := ::oMenu2:AddAction(QIcon():new("images\copy.png"),"&Copiar")
   ::oActionCopy:setStatusTip("Executa a opo COPIAR")
   ::oActionCopy:onTriggered( {||::showMessage("Editar/Copiar")})

   ::oActionPaste := ::oMenu2:AddAction(QIcon():New("images\paste.png"),"C&olar")
   ::oActionPaste:setStatusTip("Executa a opo COLAR")
   ::oActionPaste:onTriggered({||::showMessage("Editar/Colar")})

   ::oMenu3 := ::oMenuBar:AddMenu("&Sobre")

   ::oActionAbout := ::oMenu3:AddAction("&Exemplo")
   ::oActionAbout:setStatusTip("Exibe informaes sobre este exemplo")
   ::oActionAbout:onTriggered({||::showMessage("Este exemplo demonstra a criao da janela principal de uma aplicao")})

   ::oActionAboutxH := ::oMenu3:AddAction("&xHarbour")
   ::oActionAboutxH:setStatusTip("Exibe a verso do Harbour/xHarbour")
   ::oActionAboutxH:onTriggered({||::showMessage(version())})

   ::oActionAboutCC := ::oMenu3:AddAction("&C/C++ Compiler")
   ::oActionAboutCC:setStatusTip("Exibe informaes sobre o compilador C/C++")
   ::oActionAboutCC:onTriggered({||::showMessage(hb_compiler())})

   ::oActionAboutQt := ::oMenu3:AddAction("&Qt Framework")
   ::oActionAboutQt:setStatusTip("Exibe informaes sobre o Qt Framework")
   ::oActionAboutQt:onTriggered( {||oApp:aboutQt()})

RETURN self

/*
  o mtodo 'createToolBar' cria a barra de ferramentas da janela principal
  e configura a ao que cada boto ir executar
*/

METHOD createToolBar () CLASS HMainWindow

   ::oToolBar := ::addToolBar("")

   ::oToolBar:addAction(::oActionNew)
   ::oToolBar:addAction(::oActionOpen)
   ::oToolBar:addAction(::oActionSave)

   ::oToolBar:addSeparator()

   ::oToolBar:addAction(::oActionCut)
   ::oToolBar:addAction(::oActionCopy)
   ::oToolBar:addAction(::oActionPaste)

RETURN self

/*
  o mtodo 'createStatusBar' cria a barra de status
*/

METHOD createStatusBar () CLASS HMainWindow

   ::oStatusBar := ::statusBar()

RETURN self

/*
 o mtodo 'defineEvent' define os eventos que sero processados
*/

METHOD defineEvents () CLASS HMainWindow

   ::onCloseEvent({|w,e|::CloseMainWindow(w,e)})

RETURN self

/*
 o mtodo 'closeMainWindow' confirma, com o usurio, se quer
 realmente sair do programa
*/

METHOD closeMainWindow (w,e) CLASS HMainWindow

   LOCAL oMB
   LOCAL nRet
   LOCAL oEvent := QEvent():newfrom(e)

   oMB := QMessageBox():new(QMessageBox_Question,;
                            "Ateno",;
                            "Quer realmente sair do programa ?",;
                            QMessageBox_Yes+QMessageBox_No,;
                            self,;
                            Qt_Dialog+Qt_MSWindowsFixedSizeDialogHint)

   nRet := oMB:exec()

   oMB:delete()

   IF nRet == QMessageBox_Yes
      oEvent:accept()
   endif

   IF nRet == QMessageBox_No
      oEvent:ignore()
   endif

RETURN .T.

/*
  o mtodo 'showMessage' exibe uma janela com uma mensagem,
  usando a classe QMessageBox
*/

METHOD showMessage (cText) CLASS HMainWindow

   LOCAL oMB

   oMB := QMessageBox():new(QMessageBox_Information,"Informao",cText,QMessageBox_Ok,self)

   oMB:exec()

   oMB:delete()

RETURN NIL


[Runtime] Added new TypesChangedAttribute that is used to mark classes where property types have been changed

//
// 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.
//
BEGIN NAMESPACE XSharp.Internal

	///
	/// This class is used to mark IntPtr _DLL arguments with the actual type
	///
	[AttributeUsage(AttributeTargets.Parameter)];
	SEALED CLASS ActualTypeAttribute INHERIT Attribute
		PRIVATE INITONLY _value AS System.Type
		///The actual type of the parameter.
		PROPERTY @@Value AS System.Type GET _value
		///
		CONSTRUCTOR(@@Value AS System.Type)
			_value := @@Value

	END CLASS

	///
	/// This class exposes the namespace and globalclass in an assembly
	///
	[AttributeUsage(AttributeTargets.Assembly)];
	SEALED CLASS ClassLibraryAttribute INHERIT Attribute
		PRIVATE INITONLY _globalClassName AS STRING
		PRIVATE INITONLY _defaultNameSpace AS STRING
		///Name of the class where functions, defines and globals are stored.
		PROPERTY GlobalClassName AS STRING GET _globalClassName
        ///Default namespace of the assembly.
		PROPERTY DefaultNameSpace AS STRING GET _defaultNameSpace
		///
		CONSTRUCTOR(globalClassName AS STRING, defaultNameSpace AS STRING)
			_globalClassName := globalClassName
			_defaultNameSpace := defaultNameSpace

	END CLASS

	///
	/// This class documents the parameter names for methods and functions
	/// with Clipper calling convention
	///

	[AttributeUsage(AttributeTargets.Method|AttributeTargets.Constructor)];
	SEALED CLASS ClipperCallingConventionAttribute INHERIT Attribute
		PRIVATE INITONLY _parameterNames AS STRING[]
		///List of parameter names for the method or constructor
		PROPERTY ParameterNames AS STRING[] GET _parameterNames
		///
		CONSTRUCTOR(parameterNames AS STRING[])
			_parameterNames := parameterNames

	END CLASS

	///
	/// This class records the compiler version used to build an assembly
	///
	[AttributeUsage(AttributeTargets.Assembly)];
	SEALED CLASS CompilerVersionAttribute INHERIT Attribute
		PRIVATE INITONLY _version AS STRING
	    ///The version and dialect of the compiler that created the assembly.
		PROPERTY Version AS STRING GET _version

		///
		CONSTRUCTOR(version AS STRING)
			_version := version

	END CLASS

	///
	/// this class is used to mark default parameter values in the middle of a parameter list.
    ///
    /// <remarks>
    /// It is used when compiling in VO or Vulcan mode.
    /// And only for parameters that are followed by parameters without default value (because that is not supported by the .Net framework).

    /// The X# compiler will find this attribute at compile time and will insert its value into the argument list.
    /// </remarks>
	SEALED CLASS DefaultParameterValueAttribute INHERIT Attribute
		PRIVATE INITONLY _value AS OBJECT
		PRIVATE INITONLY _flag  AS INT
		/// Value of the default parameter
		PROPERTY @@Value AS OBJECT GET _value
        /// Flag indicating the type of the default parameter
        /// <remarks>
	    /// 0 = Regular .Net default value
	    /// 1 = NIL
	    /// 2 = Date (value is LONG ticks, empty for NULL_DATE)
	    /// 3 = Symbol, value can be empty or a string
	    /// 4 = PSZ, null = empty, or a string
	    /// 5 = IntPtr (can be 0 for NullPtr)
	    /// </remarks>
		PROPERTY Flag  AS INT    GET _flag

		///
		CONSTRUCTOR(oValue AS OBJECT, flag AS INT)
			_value := oValue
			_flag  := flag

	END CLASS

	///
	/// This class is used to describe VOSTRUCT and UNION structures which have a different semantics
	/// AS actually means Struct PTR. IS means Struct
	/// Please note that the size assumes x86 (32 bits) OS.
	///
	[AttributeUsage(AttributeTargets.Struct)];
	SEALED CLASS VoStructAttribute INHERIT Attribute
		PRIVATE _size				AS INT
		PRIVATE _largestMemberSize  AS INT
		///Total size of the VOSTRUCT or UNION.
		PROPERTY Size				AS INT GET _size
        ///Size of the largest member.
		PROPERTY LargestMemberSize	AS INT GET _largestMemberSize

		///
		CONSTRUCTOR(size AS INT, largestMemberSize AS INT)
			_size := size
			_largestMemberSize := largestMemberSize

	END CLASS

	///
	/// This class is used to describe fields that have been declared with the INSTANCE modifier
    ///
	[AttributeUsage(AttributeTargets.Field)];
	SEALED CLASS IsInstanceAttribute INHERIT Attribute

		///
		CONSTRUCTOR()
			SUPER()
			RETURN

	END CLASS

    ///
	/// This class is used to mark type that allow LateBound calls without the need of the /lb compiler option
	///
	[AttributeUsage(AttributeTargets.Class|AttributeTargets.Struct)];
	SEALED CLASS AllowLateBindingAttribute INHERIT Attribute
		CONSTRUCTOR()
			SUPER()

	END CLASS

    ///
	/// This class is used to mark methods, properties etc. that want access to Local Variables by name.
	///
    /// <remarks>
    /// In FoxPro several built-in functions have access to locals "by name". We can't do that because it violates
    /// the normal rules of encapsulation. However we can "emulate" this behavior by adding this attribute to a function or
    /// method that wants access to locals.
    /// At runtime we will then populate a table in the runtime with the names and values of local variables
	/// And we can access this table with the normal MemVarGet() and MemVarPut() functions.
    /// </remarks>
    /// <seealso cref="O:XSharp.RT.Functions.Type" />
    /// <seealso cref="O:XSharp.RT.Functions.MExec" />
    /// <seealso cref="O:XSharp.RT.Functions.Evaluate" />
    /// <seealso cref="O:XSharp.RT.Functions.StrEvaluate" />
    /// <seealso cref="O:XSharp.VFP.Functions.SqlExec" />
    /// <seealso cref="O:XSharp.VFP.Functions.SqlPrepare" />
	[AttributeUsage(AttributeTargets.Method | AttributeTargets.Property | AttributeTargets.Constructor) ];
	SEALED CLASS NeedsAccessToLocalsAttribute INHERIT Attribute
		CONSTRUCTOR()
			SUPER()

	END CLASS

    ///
	/// This class is used to mark a class and indicate that the property types and or parameter types in this class were changed.
    /// When the compiler detects that a subclass does not have the right parameter or property types then the subclass will be automatically
    /// adjusted to preserved the types from the parent class.
	///
    [AttributeUsage(AttributeTargets.Class) ];
    SEALED CLASS TypesChangedAttribute INHERIT Attribute
		CONSTRUCTOR()
			SUPER()
	END CLASS

END NAMESPACE

BEGIN NAMESPACE XSharp
	///
	/// This class is used to tell the compiler that the assembly has types in a specific namespace.
    /// When the compiler is called with the /ins command line option, then the names specified with this attribute
    /// will be automatically included in the USING list when compiling.
    ///
    /// <remarks>
	/// This type is not in the internal namespace because it is supposed to be used by 3rd party vendors as well
	/// </remarks>
	[AttributeUsage(AttributeTargets.Assembly, AllowMultiple := true)];
	SEALED CLASS ImplicitNamespaceAttribute INHERIT Attribute
		PRIVATE INITONLY _namespace AS STRING
	    ///Name of the implicit namespace.
		PROPERTY Namespace AS STRING GET _namespace

		///
		CONSTRUCTOR(namespace AS STRING)
			_namespace := namespace

	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.
//
BEGIN NAMESPACE XSharp.Internal

	///
	/// This class is used to mark IntPtr _DLL arguments with the actual type
	///
	[AttributeUsage(AttributeTargets.Parameter)];
	SEALED CLASS ActualTypeAttribute INHERIT Attribute
		PRIVATE INITONLY _value AS System.Type
		///The actual type of the parameter.
		PROPERTY @@Value AS System.Type GET _value
		///
		CONSTRUCTOR(@@Value AS System.Type)
			_value := @@Value

	END CLASS

	///
	/// This class exposes the namespace and globalclass in an assembly
	///
	[AttributeUsage(AttributeTargets.Assembly)];
	SEALED CLASS ClassLibraryAttribute INHERIT Attribute
		PRIVATE INITONLY _globalClassName AS STRING
		PRIVATE INITONLY _defaultNameSpace AS STRING
		///Name of the class where functions, defines and globals are stored.
		PROPERTY GlobalClassName AS STRING GET _globalClassName
        ///Default namespace of the assembly.
		PROPERTY DefaultNameSpace AS STRING GET _defaultNameSpace
		///
		CONSTRUCTOR(globalClassName AS STRING, defaultNameSpace AS STRING)
			_globalClassName := globalClassName
			_defaultNameSpace := defaultNameSpace

	END CLASS

	///
	/// This class documents the parameter names for methods and functions
	/// with Clipper calling convention
	///

	[AttributeUsage(AttributeTargets.Method|AttributeTargets.Constructor)];
	SEALED CLASS ClipperCallingConventionAttribute INHERIT Attribute
		PRIVATE INITONLY _parameterNames AS STRING[]
		///List of parameter names for the method or constructor
		PROPERTY ParameterNames AS STRING[] GET _parameterNames
		///
		CONSTRUCTOR(parameterNames AS STRING[])
			_parameterNames := parameterNames

	END CLASS

	///
	/// This class records the compiler version used to build an assembly
	///
	[AttributeUsage(AttributeTargets.Assembly)];
	SEALED CLASS CompilerVersionAttribute INHERIT Attribute
		PRIVATE INITONLY _version AS STRING
	    ///The version and dialect of the compiler that created the assembly.
		PROPERTY Version AS STRING GET _version

		///
		CONSTRUCTOR(version AS STRING)
			_version := version

	END CLASS

	///
	/// this class is used to mark default parameter values in the middle of a parameter list.
    ///
    /// <remarks>
    /// It is used when compiling in VO or Vulcan mode.
    /// And only for parameters that are followed by parameters without default value (because that is not supported by the .Net framework).

    /// The X# compiler will find this attribute at compile time and will insert its value into the argument list.
    /// </remarks>
	SEALED CLASS DefaultParameterValueAttribute INHERIT Attribute
		PRIVATE INITONLY _value AS OBJECT
		PRIVATE INITONLY _flag  AS INT
		/// Value of the default parameter
		PROPERTY @@Value AS OBJECT GET _value
        /// Flag indicating the type of the default parameter
        /// <remarks>
	    /// 0 = Regular .Net default value
	    /// 1 = NIL
	    /// 2 = Date (value is LONG ticks, empty for NULL_DATE)
	    /// 3 = Symbol, value can be empty or a string
	    /// 4 = PSZ, null = empty, or a string
	    /// 5 = IntPtr (can be 0 for NullPtr)
	    /// </remarks>
		PROPERTY Flag  AS INT    GET _flag

		///
		CONSTRUCTOR(oValue AS OBJECT, flag AS INT)
			_value := oValue
			_flag  := flag

	END CLASS

	///
	/// This class is used to describe VOSTRUCT and UNION structures which have a different semantics
	/// AS actually means Struct PTR. IS means Struct
	/// Please note that the size assumes x86 (32 bits) OS.
	///
	[AttributeUsage(AttributeTargets.Struct)];
	SEALED CLASS VoStructAttribute INHERIT Attribute
		PRIVATE _size				AS INT
		PRIVATE _largestMemberSize  AS INT
		///Total size of the VOSTRUCT or UNION.
		PROPERTY Size				AS INT GET _size
        ///Size of the largest member.
		PROPERTY LargestMemberSize	AS INT GET _largestMemberSize

		///
		CONSTRUCTOR(size AS INT, largestMemberSize AS INT)
			_size := size
			_largestMemberSize := largestMemberSize

	END CLASS

	///
	/// This class is used to describe fields that have been declared with the INSTANCE modifier
    ///
	[AttributeUsage(AttributeTargets.Field)];
	SEALED CLASS IsInstanceAttribute INHERIT Attribute

		///
		CONSTRUCTOR()
			SUPER()
			RETURN

	END CLASS

    ///
	/// This class is used to mark type that allow LateBound calls without the need of the /lb compiler option
	///
	[AttributeUsage(AttributeTargets.Class|AttributeTargets.Struct)];
	SEALED CLASS AllowLateBindingAttribute INHERIT Attribute
		CONSTRUCTOR()
			SUPER()

	END CLASS

    ///
	/// This class is used to mark methods, properties etc. that want access to Local Variables by name.
	///
    /// <remarks>
    /// In FoxPro several built-in functions have access to locals "by name". We can't do that because it violates
    /// the normal rules of encapsulation. However we can "emulate" this behavior by adding this attribute to a function or
    /// method that wants access to locals.
    /// At runtime we will then populate a table in the runtime with the names and values of local variables
	/// And we can access this table with the normal MemVarGet() and MemVarPut() functions.
    /// </remarks>
    /// <seealso cref="O:XSharp.RT.Functions.Type" />
    /// <seealso cref="O:XSharp.RT.Functions.MExec" />
    /// <seealso cref="O:XSharp.RT.Functions.Evaluate" />
    /// <seealso cref="O:XSharp.RT.Functions.StrEvaluate" />
    /// <seealso cref="O:XSharp.VFP.Functions.SqlExec" />
    /// <seealso cref="O:XSharp.VFP.Functions.SqlPrepare" />
	[AttributeUsage(AttributeTargets.Method | AttributeTargets.Property | AttributeTargets.Constructor) ];
	SEALED CLASS NeedsAccessToLocalsAttribute INHERIT Attribute
		CONSTRUCTOR()
			SUPER()

	END CLASS

END NAMESPACE

BEGIN NAMESPACE XSharp
	///
	/// This class is used to tell the compiler that the assembly has types in a specific namespace.
    /// When the compiler is called with the /ins command line option, then the names specified with this attribute
    /// will be automatically included in the USING list when compiling.
    ///
    /// <remarks>
	/// This type is not in the internal namespace because it is supposed to be used by 3rd party vendors as well
	/// </remarks>
	[AttributeUsage(AttributeTargets.Assembly, AllowMultiple := true)];
	SEALED CLASS ImplicitNamespaceAttribute INHERIT Attribute
		PRIVATE INITONLY _namespace AS STRING
	    ///Name of the implicit namespace.
		PROPERTY Namespace AS STRING GET _namespace

		///
		CONSTRUCTOR(namespace AS STRING)
			_namespace := namespace

	END CLASS

END NAMESPACE


rename proposition

rename proposition

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

data NatList :: Inventory Nat ~> * 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 Nat ~> Inventory Nat ~> * where
  Single :: NatList nl -> Elem i {merge i nl}

monad maybeM

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

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) = let start = [0v, 2v, 4v]nl in join start [Single start]lt [3v]nl
Just (t2, e2) = join e1 t1 [1v, 5v]nl

-- proposition for mergability
--
prop Disjoint :: Inventory Nat ~> Inventory Nat ~> * where
  WithEmpty :: Disjoint []i i
  WithLastAndRest :: Excluded n i -> Disjoint j i -> Disjoint [j; n]i i

-- exclusivity
--
prop Excluded :: Nat ~> Inventory Nat ~> * where
  NotInEmpty :: Excluded n []i
  NoZero :: Excluded 0t x -> Excluded 0t [x; (1+y)t]i
  NoHigher :: Excluded (1+n)t x -> Excluded (1+n)t [x; 0t]i
  ReduceToLower :: Excluded (1+n)t x -> Excluded n [y]i -> Excluded (1+n)t [x; (1+y)t]i

-- the total version of mergeNL
--
mergeNL' :: Disjoint i j => NatList i -> NatList j -> NatList {merge i j}
mergeNL' i j = let Just m = mergeNL i j in m

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

data NatList :: Inventory Nat ~> * 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 Nat ~> Inventory Nat ~> * where
  Single :: NatList nl -> Elem i {merge i nl}

monad maybeM

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

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) = let start = [0v, 2v, 4v]nl in join start [Single start]lt [3v]nl
Just (t2, e2) = join e1 t1 [1v, 5v]nl

-- proposition for mergability
--
prop Disjoint :: Inventory Nat ~> Inventory Nat ~> * where
  WithEmpty :: Disjoint []i i
  WithLastAndRest :: NotIncluded n i -> Disjoint j i -> Disjoint [j; n]i i

-- exclusivity
--
prop NotIncluded :: Nat ~> Inventory Nat ~> * where
  NotInEmpty :: NotIncluded n []i
  NoZero :: NotIncluded 0t x -> NotIncluded 0t [x; (1+y)t]i
  NoHigher :: NotIncluded (1+n)t x -> NotIncluded (1+n)t [x; 0t]i
  ReduceToLower :: NotIncluded (1+n)t x -> NotIncluded n [y]i -> NotIncluded (1+n)t [x; (1+y)t]i

-- the total version of mergeNL
--
mergeNL' :: Disjoint i j => NatList i -> NatList j -> NatList {merge i j}
mergeNL' i j = let Just m = mergeNL i j in m


another little gem: the neverstopetope!

another little gem: the neverstopetope!

-- 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 'output cards', so
--          - (output) cards   <-->  lines
--          - space between stacked cards <--> output cards
--          - lines disappear
--          -                (regular) cards appear

import "../tests/Nat.prg"

data ZoomComplex :: Tree e ~> Tree f ~> * where
  Nil :: ZoomComplex a a
  Cons :: Stack a b -> ZoomComplex b c -> ZoomComplex a c
 deriving List(cplx)

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

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

data Stack :: Tree d ~> Tree e ~> * where
  Empty :: Corolla tr => Tree' tr -> Stack tr ()tr
  SubDone :: Stack ()tr []tr
  SubCont :: Stack ()tr tr -> Stack ()tr [tr]tr
  --Subdivision :: Stack ()tr sub -> Stack tr rest -> Stack tr [sub; rest]tr
  Encompass :: Subtree consumed tr => Stack consumed prod -> Stack tr prod
  -- 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
  -- we need a way to sequence cards
  -- MultiCard :: ??? Disjoint a b 0 => Subtree a -> Subtree b -> Stack tr a [proda, prodb]tr

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

-- it remains to define corollas

prop Corolla :: Tree d ~> * where
  None' :: Corolla []tr
  One' :: Corolla tail -> Corolla [()tr; tail]tr

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

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

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

dolliCell :: Stack [()tr]tr ()tr
dolliCell = Empty $ 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]cplx
nopetope = [crossed, lolliFrame; dolliForever]cplx

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

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

drossed :: Stack ()tr [[]tr]tr
drossed = SubCont SubDone
-- drossed = (SubDone `On` NodeDone) In
-- Note: can we find a way to graft here? Then On would be feasible

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

--cyclops :: Stack [()tr]tr [[]tr, ()tr]tr
--cyclops = Subdivision SubDone (Exclude NodeDone)

-- 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

-- 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

{- 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

-- 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 'output cards', so
--          - (output) cards   <-->  lines
--          - space between stacked cards <--> output cards
--          - lines disappear
--          -                (regular) cards appear

import "../tests/Nat.prg"

data ZoomComplex :: Tree e ~> Tree f ~> * where
  Nil :: ZoomComplex a a
  Cons :: Stack a b -> ZoomComplex b c -> ZoomComplex a c
 deriving List(cplx)

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

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

data Stack :: Tree d ~> Tree e ~> * where
  Empty :: Corolla tr => Tree' tr -> Stack tr ()tr
  SubDone :: Stack ()tr []tr
  SubCont :: Stack ()tr tr -> Stack ()tr [tr]tr
  --Subdivision :: Stack ()tr sub -> Stack tr rest -> Stack tr [sub; rest]tr
  Encompass :: Subtree consumed tr => Stack consumed prod -> Stack tr prod
  -- 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
  -- we need a way to sequence cards
  -- MultiCard :: ??? Disjoint a b 0 => Subtree a -> Subtree b -> Stack tr a [proda, prodb]tr

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

-- it remains to define corollas

prop Corolla :: Tree d ~> * where
  None' :: Corolla []tr
  One' :: Corolla tail -> Corolla [()tr; tail]tr

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

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

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

dolliCell :: Stack [()tr]tr ()tr
dolliCell = Empty $ 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]cplx
nopetope = [crossed, lolliFrame; dolliForever]cplx

-- back to unit as fast as possible...
--
stopetope = [crossed, lolliFrame, dolliCell]cplx

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

drossed :: Stack ()tr [[]tr]tr
drossed = SubCont SubDone
-- drossed = (SubDone `On` NodeDone) In
-- Note: can we find a way to graft here? Then On would be feasible

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

--cyclops :: Stack [()tr]tr [[]tr, ()tr]tr
--cyclops = Subdivision SubDone (Exclude NodeDone)

-- 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

-- 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

{- 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