[plt-scheme] cons in VB6, algorithm as variable value in VB6 and CLOS in VB6????

Some time ago 
I asked Shrirham  if it is possible to implement ideas from
HTDP using an imperative language  as VB6 . 
The answer was thet it is possible but there is no one to 
lose time wit this. 

As a teacher who wanted to teach principles of HTDP
but not able to neglect imperative style and most important
not able to throw away VB6 GUI builder  
I wrote some small VB6 classes : 
function.cls and cons.cls 
They are ugly and not perfect but 
I hope that you can give me some ideas to improve them.
And is it possible to implement some object suystem imitating CLOS in VB6?
Thank you.


'function.cls
Option Explicit
Public Event code(inputarg, outputarg)
Public Function execute(inputarg)
   RaiseEvent code(inputarg, execute)
End Function
Public Function args(ParamArray argum() As Variant)
   Dim i, rez As New Collection
   For i = LBound(argum) To UBound(argum) Step 2
       rez.Add argum(i), argum(i + 1)
   Next i
   Set args = rez
End Function
Public Function execarg(ParamArray argum() As Variant)
  Dim i, arg As New Collection
   For i = LBound(argum) To UBound(argum) Step 2
       arg.Add argum(i + 1), argum(i)
   Next i
   RaiseEvent code(arg, execarg)
End Function
---------------
dim withevents function1 as function
set fuction1= new function
x=function1.execute(array(arg1,arg2,...))
..............
sub function1_code(inputarg, outputarg)
.....
outputarg = .........
end sub
=====================================
'cons.sls
Option Explicit
Public car, cdr
Public Function make(ByRef elem1, ByVal elem2)
  If IsEmpty(elem1) Then
     If IsObject(elem2) Then
        Set elem1 = elem2: Set make = elem2
     Else
        elem1 = elem2: make = elem2
     End If
  ElseIf IsObject(elem1) And IsObject(elem2) Then
      Set elem1 = elem2: Set make = elem2
  ElseIf Not (IsObject(elem1)) And Not (IsObject(elem2)) Then
     elem1 = elem2: make = elem2
  ElseIf IsEmpty(elem2) Then
     Set elem1 = New cons 'Empty 'Null
  Else
    MsgBox "oooopssss"
  End If
End Function
Public Function init(elem)
  Set init = New cons
  Set init = append(elem, init)
End Function
Public Function append(elem, ByVal llist) As cons
  Set append = New cons
  If Not IsEmpty(llist) Then
      Set append.cdr = llist
    If IsObject(elem) Then
      Set append.car = elem
    Else
      append.car = elem
    End If
  Else
    Set append = append.init(elem)
  End If
End Function
Public Function emptyp(llist)
 If IsEmpty(llist) Then
   emptyp = True
 ElseIf (TypeOf llist Is cons) Then
      If (IsEmpty(llist.cdr)) Then
         emptyp = True
      End If
 Else
   emptyp = False
 End If
End Function
Public Function lastp(llist)
   lastp = emptyp(llist.cdr)
End Function
Public Function l(ParamArray elements() As Variant) As cons
 Dim i
 Set l = New cons
 Set l = l.init(elements(UBound(elements)))
 For i = UBound(elements) - 1 To LBound(elements) Step -1
    Set l = append(elements(i), l)
 Next i
End Function
Public Function totext(llist)
   If Not lastp(llist) Then
      totext = llist.car & "  ,  " & totext(llist.cdr)
   Else
      totext = llist.car & "  .  "
   End If
End Function
Public Function treetotext(llist As cons)
   If Not emptyp(llist) Then
     If TypeOf llist.car Is cons Then
     treetotext = " [ " & treetotext(llist.car) & " ] , " & _
                                   treetotext(llist.cdr)
     Else
       treetotext = llist.car & " , " & treetotext(llist.cdr)
     End If
   Else
       treetotext = " . "
   End If
End Function
Public Function remove(elem, ByVal llist) As cons
   If Not emptyp(llist) Then
    If equalp(elem, llist.car) Then
         make remove, llist.cdr
      Else
         make remove, append(llist.car, remove(elem, llist.cdr))
      End If
   Else
      make remove, llist
   End If
End Function
Public Function removebranch(elem, ByVal llist, Optional all = False)
   If Not emptyp(llist) Then
     If TypeOf llist.car Is cons And Not equalp(elem, llist.car) Then
         make removebranch, append(mahniklon(elem, llist.car, all) _
                                , removebranch(elem, llist.cdr, all))
     Else
       If equalp(elem, llist.car) Then
           If all Then
              make removebranch, removebranch(elem, llist.cdr, all)
           Else
              make removebranch, llist.cdr
           End If
       Else
           make removebranch, append(llist.car, _
                    removebranch(elem, llist.cdr, all))
       End If
     End If
   Else
      make removebranch, Empty 'llist
   End If
End Function
Public Function find(elem, ByVal llist)
   If Not emptyp(llist) Then
    If equalp(elem, llist.car) Then
         make find, llist 'elem
      Else
         make find, find(elem, llist.cdr)
      End If
   Else
      make find, ""
   End If
End Function
Public Function equalp(elem1, elem2)
If TypeOf elem1 Is cons And TypeOf elem2 Is cons Then
  equalp = equalp(elem1.car, elem2.car) And _
              equalp(elem1.cdr, elem2.cdr)
ElseIf IsObject(elem1) And IsObject(elem2) Then
      equalp = (elem1 Is elem2)
  ElseIf Not (IsObject(elem1)) And Not (IsObject(elem2)) Then
     equalp = (elem1 = elem2)
  Else
     equalp = False
  End If
End Function
Public Function treefind(elem, ByVal llist)
   If Not emptyp(llist) Then
     If TypeOf llist.car Is cons Then
        make treefind, treefind(elem, llist.car)
        If emptyp(treefind) Then
           make treefind, treefind(elem, llist.cdr)
        End If
     Else
       If equalp(elem, llist.car) Then
           make treefind, llist.car
       Else
           make treefind, treefind(elem, llist.cdr)
       End If
     End If
   Else
     make treefind, Empty
   End If
End Function
Public Function treetolist(llist As cons, list, Optional level = "", _
                  Optional sign = "- ")
  If Not emptyp(llist) Then
     If TypeOf llist.car Is cons Then
      treetolist append("\", llist.car), list, level & "- |----- ", sign
     treetolist llist.cdr, list, level, sign
     Else
       list.AddItem level & sign & llist.car ', 0
       treetolist llist.cdr, list, level, sign
     End If
  Else
    'list.AddItem level
  End If
End Function
Public Function dialog(frm As Form2)
  frm.Show vbModal
  make dialog, frm.llistuk
  Unload frm
End Function
Public Function stick(List1, list2)
  If Not emptyp(List1) Then
    make stick, append(List1.car, stick(List1.cdr, list2))
  Else
    make stick, list2
  End If
End Function



________________________
http://mail.tu-sofia.bg/