[truffle] Implement nqp::tclc

nqp-truffle.nqp

@@ -148,6 +148,8 @@ class QAST::OperationsTruffle {
         });
     }
 
+    add_simple_op('tclc', $STR, [$STR]);
+
     # explicit takeclosure is used by the JVM backend we no-op it.
     add_op('takeclosure', sub ($comp, $node, :$want) {
         $comp.as_truffle($node[0], :want($want));

src/vm/jvm/runtime/org/perl6/nqp/truffle/nodes/expression/NQPTclcNode.java

@@ -0,0 +1,30 @@
+package org.perl6.nqp.truffle.nodes.expression;
+import com.oracle.truffle.api.frame.VirtualFrame;
+import com.oracle.truffle.api.nodes.NodeInfo;
+import org.perl6.nqp.truffle.nodes.NQPNode;
+import org.perl6.nqp.dsl.Deserializer;
+
+@NodeInfo(shortName = "tclc")
+public final class NQPTclcNode extends NQPNode {
+    @Child private NQPNode argNode;
+
+    @Deserializer
+    public NQPTclcNode(NQPNode argNode) {
+        this.argNode = argNode;
+    }
+
+    static String codepointToTitleCase(int codepoint) {
+        if (codepoint == 223) return "Ss";
+        return new String(Character.toChars(Character.toTitleCase(codepoint)));
+    }
+
+    @Override
+    public String executeStr(VirtualFrame frame) {
+        String in = argNode.executeStr(frame);
+        if (in.length() == 0)
+            return in;
+        int first = in.codePointAt(0);
+        return codepointToTitleCase(first)
+            + in.substring(Character.charCount(first)).toLowerCase();
+    }
+}