From 10ae0b1089e5b218bda48b10f19f881de99cdb63 Mon Sep 17 00:00:00 2001
From: Nat Quayle Nelson <natquaylenelson@gmail.com>
Date: Thu, 19 Nov 2020 20:08:33 -0700
Subject: [PATCH] (new [type] ...)

---
 src/kiss/FieldForms.hx            |  6 +++---
 src/kiss/Helpers.hx               | 11 ++++++++---
 src/kiss/SpecialForms.hx          | 17 +++++++++++++----
 src/test/cases/BasicTestCase.hx   |  4 ++++
 src/test/cases/BasicTestCase.kiss |  4 +++-
 5 files changed, 31 insertions(+), 11 deletions(-)

diff --git a/src/kiss/FieldForms.hx b/src/kiss/FieldForms.hx
index 9f1d630b..94140b35 100644
--- a/src/kiss/FieldForms.hx
+++ b/src/kiss/FieldForms.hx
@@ -55,7 +55,7 @@ class FieldForms {
             access: access,
             kind: FVar(switch (args[0]) {
                 case TypedExp(type, _):
-                    Helpers.parseTypePath(type);
+                    Helpers.parseComplexType(type);
                 default: null;
             }, convert(args[1])),
             pos: Context.currentPos()
@@ -90,7 +90,7 @@ class FieldForms {
                                     },
                                     type: switch (funcArg) {
                                         case TypedExp(type, _):
-                                            Helpers.parseTypePath(type);
+                                            Helpers.parseComplexType(type);
                                         default: null;
                                     }
                                 }
@@ -101,7 +101,7 @@ class FieldForms {
                         throw '${args[1]} should be an argument list';
                 },
                 ret: switch (args[0]) {
-                    case TypedExp(type, _): Helpers.parseTypePath(type);
+                    case TypedExp(type, _): Helpers.parseComplexType(type);
                     default: null;
                 },
                 expr: {
diff --git a/src/kiss/Helpers.hx b/src/kiss/Helpers.hx
index 5d5b7185..847c5d8a 100644
--- a/src/kiss/Helpers.hx
+++ b/src/kiss/Helpers.hx
@@ -18,7 +18,7 @@ class Helpers {
     }
 
     // TODO this doesn't parse generic typeparams yet
-    public static function parseTypePath(path:String):ComplexType {
+    public static function parseTypePath(path:String):TypePath {
         var parts:List<String> = path.split(".");
         var uppercaseParts:List<Bool> = parts.map(startsWithUpperCase);
         for (isUpcase in uppercaseParts.slice(0, -2)) {
@@ -28,7 +28,8 @@ class Helpers {
         }
         var lastIsCap = uppercaseParts[-1];
         var penultIsCap = uppercaseParts[-2];
-        return TPath(if (lastIsCap && penultIsCap) {
+
+        return if (lastIsCap && penultIsCap) {
             {
                 sub: parts[-1],
                 name: parts[-2],
@@ -41,6 +42,10 @@ class Helpers {
             };
         } else {
             throw 'Type path $path should end with a capitalized type';
-        });
+        };
+    }
+
+    public static function parseComplexType(path:String):ComplexType {
+        return TPath(parseTypePath(path));
     }
 }
diff --git a/src/kiss/SpecialForms.hx b/src/kiss/SpecialForms.hx
index ae6464c1..997dfc10 100644
--- a/src/kiss/SpecialForms.hx
+++ b/src/kiss/SpecialForms.hx
@@ -29,7 +29,16 @@ class SpecialForms {
 
         // TODO special form for object declaration
 
-        // TODO special form for new
+        map["new"] = (args:Array<ReaderExp>, convert:ExprConversion) -> {
+            if (args.length < 1) {
+                throw '(new [type] constructorArgs...) is missing a type!';
+            }
+            var classType = switch (args[0]) {
+                case Symbol(name): name;
+                default: throw 'first arg in (new [type] ...) should be a class to instantiate';
+            };
+            ENew(Helpers.parseTypePath(classType), args.slice(1).map(convert)).withPos();
+        };
 
         // TODO special form for assignment
 
@@ -54,7 +63,7 @@ class SpecialForms {
                         },
                         type: switch (bindingPair[0]) {
                             case TypedExp(type, _):
-                                Helpers.parseTypePath(type);
+                                Helpers.parseComplexType(type);
                             default: null;
                         },
                         isFinal: true, // Let's give (let...) variable immutability a try
@@ -88,7 +97,7 @@ class SpecialForms {
                 throw '(the [type] [value]) expression has wrong number of arguments: ${args.length}';
             }
             ECheckType(convert(args[1]), switch (args[0]) {
-                case Symbol(type): Helpers.parseTypePath(type);
+                case Symbol(type): Helpers.parseComplexType(type);
                 default: throw 'first argument to (the... ) should be a valid type';
             }).withPos();
         };
@@ -110,7 +119,7 @@ class SpecialForms {
                                 },
                                 type: switch (catchArgs[0]) {
                                     case ListExp([TypedExp(type, _)]):
-                                        Helpers.parseTypePath(type);
+                                        Helpers.parseComplexType(type);
                                     default: null;
                                 },
                                 expr: convert(CallExp(Symbol("begin"), catchArgs.slice(1)))
diff --git a/src/test/cases/BasicTestCase.hx b/src/test/cases/BasicTestCase.hx
index 6fb50aa0..bd0596ed 100644
--- a/src/test/cases/BasicTestCase.hx
+++ b/src/test/cases/BasicTestCase.hx
@@ -151,4 +151,8 @@ class BasicTestCase extends Test {
     function testLet() {
         _testLet();
     }
+
+    function testConstructors() {
+        Assert.equals("sup", BasicTestCase.myConstructedString);
+    }
 }
diff --git a/src/test/cases/BasicTestCase.kiss b/src/test/cases/BasicTestCase.kiss
index a3aff4f5..342885c8 100644
--- a/src/test/cases/BasicTestCase.kiss
+++ b/src/test/cases/BasicTestCase.kiss
@@ -99,4 +99,6 @@
             :String c "stuff"]
         (Assert.equals 5 a)
         (Assert.equals 6 b)
-        (Assert.equals "stuff" c)))
\ No newline at end of file
+        (Assert.equals "stuff" c)))
+
+(defvar myConstructedString (new String "sup"))
\ No newline at end of file