str-function generated for structs

core/Double.carp

@@ -7,4 +7,5 @@
   (register fromInt (Fn [Int] Double))
   (register sin (Fn [Double] Double))
   (register cos (Fn [Double] Double))
+  (register str (Fn [Double] String))
   )

core/Float.carp

@@ -3,4 +3,5 @@
   (register - (Fn [Float Float] Float))
   (register * (Fn [Float Float] Float))
   (register / (Fn [Float Float] Float))
-  (register toInt (Fn [Float] Int)))
+  (register toInt (Fn [Float] Int))
+  (register str (Fn [Float] String)))

core/String.carp

@@ -6,4 +6,5 @@
   (register count (Fn [(Ref String)] Int))
   (register duplicate (Fn [(Ref String)] String))
   (register cstr (Fn [(Ref String)] (Ptr Char)))
+  (register str (Fn [(Ref String)] String))
   )

core/prelude.h

@@ -72,12 +72,6 @@ string IO_get_MINUS_line() {
     return buffer;
 }
 
-string str(int x) {
-    char *buffer = CARP_MALLOC(64);
-    snprintf(buffer, 64, "%d", x);
-    return buffer;
-}
-
 int Int_from_MINUS_string(string *s) {
     return atoi(*s);
 }
@@ -100,7 +94,9 @@ int Int_random_MINUS_between(int lower, int upper) {
 }
 
 string Int_str(int x) {
-    return str(x);
+    char *buffer = CARP_MALLOC(64);
+    snprintf(buffer, 64, "%d", x);
+    return buffer;
 }
 
 bool Int_mask(int a, int b) {
@@ -147,9 +143,16 @@ char* String_cstr(string *s) {
     return *s;
 }
 
+string String_str(string *s) {
+    int n = strlen(*s) + 3;
+    string buffer = malloc(n);
+    snprintf(buffer, n, "\"%s\"", *s);
+    return buffer;
+}
+
 string Char_str(char c) {
-    char *buffer = CARP_MALLOC(2);
-    snprintf(buffer, 2, "%c", c);
+    char *buffer = CARP_MALLOC(3);
+    snprintf(buffer, 3, "\\%c", c);
     return buffer;
 }
 
@@ -174,10 +177,22 @@ double Double_cos(double x) {
     return cos(x);
 }
 
+string Double_str(double x) {
+    char *buffer = CARP_MALLOC(32);
+    snprintf(buffer, 32, "%f", x);
+    return buffer;
+}
+
 int Float_toInt(double x) {
     return (int)x;
 }
 
+string Float_str(float x) {
+    char *buffer = CARP_MALLOC(32);
+    snprintf(buffer, 32, "%f", x);
+    return buffer;
+}
+
 // Array
 typedef struct {
     int len;

docs/Todo.md

@@ -14,6 +14,7 @@
 * The type of the variable in a set!-form, i.e. (set! &x 10)
 * 'copy' should probably be a special form, just like 'ref'?
 * Is some kind of interface/typeclass construct worthwhile?
+* How should passing primitive types (that do not care about being referenced) as ref:ed parameters be handled?
 
 ## Code generation
 * LLVM backend
@@ -22,3 +23,4 @@
 ## Tooling
 * Built in REPL history (without using rlwrap)
 * Stop evalutaion of forms after errors to avoid "Trying to refer to undefined symbol" error
+* Proper error handling when defining invalid struct types (right now it crashes)

examples/temp.carp

@@ -7,3 +7,12 @@
 (use String)
 (use Char)
 
+(deftype Simple [])
+(deftype Complex [x Int f Float d Double s String c Char])
+
+(defn main []
+  (let [s (Simple.init)
+        a &(Complex.init 12345 3.14f 99.99 @"yo" \x)]
+    (do
+      (println (ref (Complex.str a)))
+      (println (ref (Simple.str &s))))))

src/Deftype.hs

@@ -10,6 +10,7 @@ import Util
 import Template
 import Infer
 import Concretize
+import Polymorphism
 
 data AllocationMode = StackAlloc | HeapAlloc
 
@@ -30,10 +31,11 @@ moduleForDeftype typeEnv env pathStrings typeName rest i =
          case
            do okInit <- templateForInit insidePath typeName rest
               okNew <- templateForNew insidePath typeName rest
+              okStr <- templateForStr typeEnv env insidePath typeName rest
               (okDelete, deleteDeps) <- templateForDelete typeEnv env insidePath typeName rest
               (okCopy, copyDeps) <- templateForCopy typeEnv env insidePath typeName rest
               (okMembers, membersDeps) <- templatesForMembers typeEnv env insidePath typeName rest
-              let funcs = okInit : okNew : okDelete : okCopy : okMembers
+              let funcs = okInit : okNew : okStr : okDelete : okCopy : okMembers
                   moduleEnvWithBindings = addListOfBindings emptyTypeModuleEnv funcs
                   typeModuleXObj = XObj (Mod moduleEnvWithBindings) i (Just ModuleTy)
                   deps = deleteDeps ++ membersDeps ++ copyDeps
@@ -97,6 +99,14 @@ templateForNew insidePath typeName [XObj (Arr membersXObjs) _ _] =
                         (templateInit HeapAlloc typeName (memberXObjsToPairs membersXObjs))
 templateForNew _ _ _ = Nothing
 
+-- | Helper function to create the binder for the 'str' template.
+templateForStr :: Env -> Env -> [String] -> String -> [XObj] -> Maybe (String, Binder)
+templateForStr typeEnv env insidePath typeName [XObj (Arr membersXObjs) _ _] =
+  Just $ instanceBinder (SymPath insidePath "str")
+                        (FuncTy [(RefTy (StructTy typeName []))] StringTy)
+                        (templateStr typeEnv env typeName (memberXObjsToPairs membersXObjs))
+templateForStr _ _ _ _ _ = Nothing
+
 -- | Generate a list of types from a deftype declaration.
 initArgListTypes :: [XObj] -> [Ty]
 initArgListTypes xobjs = map (\(_, x) -> fromJust (xobjToTy x)) (pairwise xobjs)
@@ -156,6 +166,43 @@ templateInit allocationMode typeName members =
                                  , "}"]))
     (const [])
 
+-- | The template for the 'str' function for a deftype.
+-- | TODO: Handle all lengths of members, now the string can be at most 1024 characters long.
+templateStr :: Env -> Env -> String -> [(String, Ty)] -> Template
+templateStr typeEnv env typeName members =
+  Template
+    (FuncTy [(RefTy (StructTy typeName []))] StringTy)
+    (const (toTemplate $ "string $NAME(" ++ typeName ++ " *p)"))
+    (const (toTemplate $ unlines [ "$DECL {"
+                                 , "  // convert members to string here:"
+                                 , "  string buffer = calloc(1024, 1); // TODO: dynamic length"
+                                 , "  string bufferPtr = buffer;"
+                                 , "  string temp = calloc(1024, 1);"
+                                 , ""
+                                 , "  snprintf(bufferPtr, 1024, \"(%s \", \"" ++ typeName ++ "\");"
+                                 , "  bufferPtr += strlen(\"" ++ typeName ++ "\") + 2;\n"
+                                 , joinWith "\n" (map (memberStr typeEnv env) members)
+                                 , "  bufferPtr--;"
+                                 , "  snprintf(bufferPtr, 1024, \")\");"
+                                 , "  return buffer;"
+                                 , "}"]))
+    (const [])
+
+-- | Generate C code for converting a member variable to a string and appending it to a buffer.
+memberStr :: Env -> Env -> (String, Ty) -> String
+memberStr typeEnv env (memberName, memberTy) =
+  let refOrNotRefType = if isManaged typeEnv memberTy then RefTy memberTy else memberTy
+      maybeTakeAddress = if isManaged typeEnv memberTy then "&" else ""
+      strFuncType = (FuncTy [refOrNotRefType] StringTy)
+  in case nameOfPolymorphicFunction env typeEnv strFuncType "str" of
+       Just strFunctionPath ->
+         unlines [("  snprintf(temp, 1024, \"%s\", " ++ pathToC strFunctionPath ++ "(" ++ maybeTakeAddress ++ "p->" ++ memberName ++ "));")
+                 , "  snprintf(bufferPtr, 1024, \"%s \", temp);"
+                 , "  bufferPtr += strlen(temp) + 1;"
+                 ]
+       Nothing ->
+         "  // Failed to find str function for " ++ memberName ++ " : " ++ show memberTy ++ "\n"
+
 -- | Creates the C code for an arg to the init function.
 -- | i.e. "(deftype A [x Int])" will generate "int x" which
 -- | will be used in the init function like this: "A_init(int x)"