Improvements to object system.

2 files changed, 80 insertions, 43 deletions

diff --git a/lib/object.nom b/lib/object.nom
index 27ef6c9..37f661c 100644
--- a/lib/object.nom
+++ b/lib/object.nom
@@ -1,49 +1,59 @@
-use "core"
+#
+    This file contains the implementation of an Object-Oriented programming system.
 
-lua> "CLASSES = {}"
+use "core"
 
 immediately
     compile [@, me] to: Lua value "self"
-action [new %classname %inst]
-    =lua "setmetatable(\%inst, CLASSES[\%classname])"
+    compile [set methods %methods] to
+        %lua <- (Lua "")
+        for %m in %methods
+            to %lua write "\nclass.\(%m as lua id) = \(%m as lua id)"
+        return %lua
+
 immediately
-    parse [new %classname] as: new %classname {}
+    parse [method %actions %body] as
+        with local %actions
+            action %actions %body
+            set methods %actions
 
 immediately
-    compile [call method %method] to: Lua value "self:\(%method as lua expr)"
-
-parse [as %instance %body] as
-    result of
-        %old_self <- (me)
-        (me) <- %instance
-        try
-            %body
-        ..and if it barfs %msg
-            (me) <- %old_self
-            barf %msg
-        ..or if it succeeds
-            (me) <- %old_self
-
-compile [object %classname %class_body] to
-    %lua <-
+    parse [as %instance %body] as
+        result of
+            %old_self <- (me)
+            (me) <- %instance
+            try
+                %body
+            ..and if it barfs %msg
+                (me) <- %old_self
+                barf %msg
+            ..or if it succeeds
+                (me) <- %old_self
+
+    compile [object %classname extends %parent %class_body] to
         Lua ".."
             do
                 local class = {name=\(%classname as lua expr)}
-                setmetatable(class, {__tostring=function(cls) return cls.name end})
-                CLASSES[class.name] = class
+                setmetatable(class, {
+                    __index=\(%parent as lua expr),
+                    __tostring=function(cls) return cls.name end,
+                    __call=function(cls, inst)
+                        inst = setmetatable(inst or {}, cls)
+                        if cls.A_initialize_1 then
+                            cls.A_initialize_1(inst)
+                        end
+                        return inst
+                    end,
+                })
+                _ENV["A"..string.as_lua_id("new "..class.name)] = class
+                _ENV["A"..string.as_lua_id("new "..class.name.." 1")] = class
+                _ENV["A"..string.as_lua_id("class "..class.name)] = function() return class end
                 class.__index = class
                 class.class = class
 
-    if: %class_body.type != "Block"
-        %class_body <- [%class_body]
-    for %statement in %class_body
-        assume: (%statement.type is "Action") and (%statement.stub is "action % %")
-        to %lua write "\n    class."
-        to %lua write (%statement as lua)
-    
-    to %lua write ".."
-            
-            class.__tostring = class["A"..string.as_lua_id("as text")]
-        end
-    
-    return %lua
+                \(%class_body as lua statements)
+
+                class.__tostring = class["A"..string.as_lua_id("as text")]
+            end
+
+parse [object %classname %class_body] as: object %classname extends (nil) %class_body
diff --git a/tests/object.nom b/tests/object.nom
index b3e8164..4848bf9 100644
--- a/tests/object.nom
+++ b/tests/object.nom
@@ -5,39 +5,66 @@ use "core"
 use "lib/object.nom"
 
 object "Dog"
-    action [bark]
+    (class Dog).genus <- "Canus"
+    method [initialize %]
+        %.barks or<- 0
+
+    method [bark, woof]
         %barks <- ("Bark!" for % in 1 to ((me).barks))
         return: %barks joined with " "
 
-    action [get pissed off]
+    method [get pissed off]
         ((me).barks) +<- 1
 
-%d <-: new "Dog" {barks:2}
+%d <-: new Dog {barks:2}
 as %d
     assume: (me) = %d
     assume: ((me).barks) = 2
     assume: (bark) = "Bark! Bark!"
+    assume: (woof) = "Bark! Bark!"
     get pissed off
     assume: ((me).barks) = 3
     assume: (bark) = "Bark! Bark! Bark!"
+    assume: (me).genus = "Canus"
 assume: "\(%d.class)" = "Dog"
+assume: %d.genus = "Canus"
 assume: %d.barks = 3
 
-as: new "Dog" {barks:1}
+as: new Dog
+    assume: ((me).barks) = 0
+    ..or barf "Default initializer failed"
+
+as: new Dog {barks:1}
     assume: (bark) = "Bark!"
 
 action [foo]
-    as: new "Dog" {barks:23}
+    as: new Dog {barks:23}
         return: (me).barks
 
 assume: (foo) = 23
 ..or barf: "Oops, \(foo) != 23"
 
-as: new "Dog" {barks:101}
-    try: as (new "Dog" {barks:8}) (barf)
+as: new Dog {barks:101}
+    try: as (new Dog {barks:8}) (barf)
     ..and if it succeeds: barf
 
     assume: (me).barks = 101
     ..or barf "Error in nested 'as % %' failed to properly reset 'self'"
 
+
+object "Corgi" extends: class Dog
+    method [sploot]
+        "splooted"
+
+%corg <- (new Corgi)
+assume: %corg.barks = 0
+as: new Corgi {barks:1}
+    assume: (sploot) = "splooted"
+    ..or barf "subclass method failed"
+
+    assume: (bark) = "Bark!"
+    ..or barf "inheritance failed"
+
+    assume: (woof) = "Bark!"
+
 say "Object test passed."