mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
str-function generated for structs
This commit is contained in:
parent
2f4b187d5b
commit
8573098dca
@ -7,4 +7,5 @@
|
||||
(register fromInt (Fn [Int] Double))
|
||||
(register sin (Fn [Double] Double))
|
||||
(register cos (Fn [Double] Double))
|
||||
(register str (Fn [Double] String))
|
||||
)
|
||||
|
@ -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)))
|
||||
|
@ -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))
|
||||
)
|
||||
|
@ -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;
|
||||
|
@ -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)
|
||||
|
@ -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))))))
|
||||
|
@ -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)"
|
||||
|
Loading…
Reference in New Issue
Block a user