kc3-lang/kc3

diff --git a/libc3/c3.h b/libc3/c3.h
index 3b32b24..3474df4 100644
--- a/libc3/c3.h
+++ b/libc3/c3.h
@@ -68,6 +68,7 @@
 #include "io.h"
 #include "list.h"
 #include "ptag.h"
+#include "ptr.h"
 #include "module.h"
 #include "operator.h"
 #include "quote.h"
diff --git a/libc3/list_init.c b/libc3/list_init.c
index 540a0f0..4eaffa3 100644
--- a/libc3/list_init.c
+++ b/libc3/list_init.c
@@ -183,13 +183,13 @@ s_list * list_init_map_1 (s_list *list, const s8 *p, s_list *next)
   return list;
 }
 
-s_list * list_init_ptr (s_list *list, const s_sym *type, void *p, 
-                        s_list *next)
+s_list * list_init_ptr (s_list *list, bool free_p, const s_sym *type, 
+                        void *p, s_list *next)
 {
   s_list tmp;
   assert(list);
   list_init(&tmp, next);
-  if (! tag_init_ptr(&tmp.tag, type, p))
+  if (! tag_init_ptr(&tmp.tag, free_p, type, p))
     return NULL;
   *list = tmp;
   return list;
@@ -566,13 +566,14 @@ s_list * list_new_map_1 (const s8 *p, s_list *next)
   return list;
 }
 
-s_list * list_new_ptr (const s_sym *type, void *p, s_list *next)
+s_list * list_new_ptr (bool free_p, const s_sym *type, void *p, 
+                       s_list *next)
 {
   s_list *list;
   list = list_new(next);
   if (! list)
     return NULL;
-  if (! tag_init_ptr(&list->tag, type, p)) {
+  if (! tag_init_ptr(&list->tag, free_p, type, p)) {
     free(list);
     return NULL;
   }
diff --git a/libc3/list_init.h b/libc3/list_init.h
index ce79ec4..86c2629 100644
--- a/libc3/list_init.h
+++ b/libc3/list_init.h
@@ -35,8 +35,8 @@ s_list * list_init_integer_zero (s_list *list, s_list *next);
 
 s_list * list_init_map (s_list *list, uw count, s_list *next);
 s_list * list_init_map_1 (s_list *list, const s8 *p, s_list *next);
-s_list * list_init_ptr (s_list *list, const s_sym *type, void *p, 
-                        s_list *next);
+s_list * list_init_ptr (s_list *list, bool free_p, const s_sym *type, 
+                        void *p, s_list *next);
 s_list * list_init_s8 (s_list *list, s8 i, s_list *next);
 s_list * list_init_s16 (s_list *list, s16 i, s_list *next);
 s_list * list_init_s32 (s_list *list, s32 i, s_list *next);
@@ -77,7 +77,8 @@ s_list * list_new_integer_zero (s_list *next);
 
 s_list * list_new_map (uw count, s_list *next);
 s_list * list_new_map_1 (const s8 *p, s_list *next);
-s_list * list_new_ptr (const s_sym *type, void *p, s_list *next);
+s_list * list_new_ptr (bool free_p, const s_sym *type, void *p, 
+                       s_list *next);
 s_list * list_new_s8 (s8 i, s_list *next);
 s_list * list_new_s16 (s16 i, s_list *next);
 s_list * list_new_s32 (s32 i, s_list *next);
@@ -116,7 +117,8 @@ s_list * list_integer_zero (s_list *list);
 
 s_list * list_map (s_list *list, uw count);
 s_list * list_map_1 (s_list *list, const s8 *p);
-s_list * list_ptr (s_list *list, const s_sym *type, void *p);
+s_list * list_ptr (s_list *list, bool free_p, const s_sym *type, 
+                   void *p);
 s_list * list_s8 (s_list *list, s8 i);
 s_list * list_s16 (s_list *list, s16 i);
 s_list * list_s32 (s_list *list, s32 i);
diff --git a/libc3/ptr.c b/libc3/ptr.c
index 50cbb0a..8887862 100644
--- a/libc3/ptr.c
+++ b/libc3/ptr.c
@@ -15,20 +15,32 @@
 #include <stdlib.h>
 #include "ptr.h"
 
+void ptr_clean (s_ptr *ptr)
+{
+  assert(ptr);
+  if (ptr->free)
+    free(ptr->p);
+}
+
 void ptr_delete (s_ptr *ptr)
 {
+  assert(ptr);
+  ptr_clean(ptr);
   free(ptr);
 }
 
-s_ptr * ptr_init (s_ptr *ptr, const s_sym *type, void *p)
+s_ptr * ptr_init (s_ptr *ptr, bool free_p, const s_sym *type, void *p)
 {
+  s_ptr tmp = {0};
   assert(ptr);
-  ptr->type = type;
-  ptr->p = p;
+  tmp.p = p;
+  tmp.type = type;
+  tmp.free = free_p;
+  *ptr = tmp;
   return ptr;
 }
 
-s_ptr * ptr_new (const s_sym *type, void *p)
+s_ptr * ptr_new (bool free_p, const s_sym *type, void *p)
 {
   s_ptr *ptr;
   ptr = calloc(1, sizeof(s_ptr));
@@ -36,7 +48,7 @@ s_ptr * ptr_new (const s_sym *type, void *p)
     warn("ptr_new: ptr");
     return NULL;
   }
-  if (! ptr_init(ptr, type, p)) {
+  if (! ptr_init(ptr, free_p, type, p)) {
     free(ptr);
     return NULL;
   }
diff --git a/libc3/ptr.h b/libc3/ptr.h
index 92e93d0..a45ca5a 100644
--- a/libc3/ptr.h
+++ b/libc3/ptr.h
@@ -15,11 +15,12 @@
 
 #include "types.h"
 
-/* Stack-allocation compatible functions. */
-s_ptr * ptr_init (s_ptr *ptr, const s_sym *type, void *p);
+/* Stack-allocation compatible functions, call ptr_clean after use. */
+void    ptr_clean (s_ptr *ptr);
+s_ptr * ptr_init (s_ptr *ptr, bool free, const s_sym *type, void *p);
 
 /* Heap-allocation functions, call ptr_delete after use. */
 void    ptr_delete (s_ptr *ptr);
-s_ptr * ptr_new (const s_sym *type, void *p);
+s_ptr * ptr_new (bool free, const s_sym *type, void *p);
 
 #endif /* LIBC3_PTR_H */
diff --git a/libc3/sym.c b/libc3/sym.c
index 874b7e0..d48d11f 100644
--- a/libc3/sym.c
+++ b/libc3/sym.c
@@ -342,6 +342,8 @@ f_clean sym_to_clean (const s_sym *type)
     return (f_clean) list_clean;
   if (type == sym_1("Ptag"))
     return NULL;
+  if (type == sym_1("Ptr"))
+    return (f_clean) ptr_clean;
   if (type == sym_1("Quote"))
     return (f_clean) quote_clean;
   if (type == sym_1("Str"))
diff --git a/libc3/tag.c b/libc3/tag.c
index ce3c549..9920a49 100644
--- a/libc3/tag.c
+++ b/libc3/tag.c
@@ -31,6 +31,7 @@
 #include "integer.h"
 #include "list.h"
 #include "map.h"
+#include "ptr.h"
 #include "quote.h"
 #include "str.h"
 #include "tag.h"
@@ -178,6 +179,7 @@ void tag_clean (s_tag *tag)
   case TAG_INTEGER: integer_clean(&tag->data.integer); break;
   case TAG_LIST:    list_delete_all(tag->data.list);   break;
   case TAG_MAP:     map_clean(&tag->data.map);         break;
+  case TAG_PTR:     ptr_clean(&tag->data.ptr);         break;
   case TAG_QUOTE:   quote_clean(&tag->data.quote);     break;
   case TAG_STR:     str_clean(&tag->data.str);         break;
   case TAG_TUPLE:   tuple_clean(&tag->data.tuple);     break;
@@ -188,7 +190,6 @@ void tag_clean (s_tag *tag)
   case TAG_FACT:
   case TAG_IDENT:
   case TAG_PTAG:
-  case TAG_PTR:
   case TAG_S8:
   case TAG_S16:
   case TAG_S32:
diff --git a/libc3/tag_init.c b/libc3/tag_init.c
index 1fd9448..346e4e8 100644
--- a/libc3/tag_init.c
+++ b/libc3/tag_init.c
@@ -185,12 +185,13 @@ s_tag * tag_init_map_1 (s_tag *tag, const s8 *p)
   return tag;
 }
 
-s_tag * tag_init_ptr (s_tag *tag, const s_sym *type, void *p)
+s_tag * tag_init_ptr (s_tag *tag, bool free_p, const s_sym *type, 
+                      void *p)
 {
   s_tag tmp = {0};
   assert(tag);
   tmp.type = TAG_PTR;
-  if (! ptr_init(&tmp.data.ptr, type, p))
+  if (! ptr_init(&tmp.data.ptr, free_p, type, p))
     return NULL;
   *tag = tmp;
   return tag;
@@ -572,7 +573,7 @@ s_tag * tag_new_map_1 (const s8 *p)
   return tag;
 }
 
-s_tag * tag_new_ptr (const s_sym *type, void *p)
+s_tag * tag_new_ptr (bool free_p, const s_sym *type, void *p)
 {
   s_tag *tag;
   if (! (tag = calloc(1, sizeof(s_tag)))) {
@@ -580,7 +581,7 @@ s_tag * tag_new_ptr (const s_sym *type, void *p)
     return NULL;
   }
   tag->type = TAG_PTR;
-  if (! ptr_init(&tag->data.ptr, type, p)) {
+  if (! ptr_init(&tag->data.ptr, free_p, type, p)) {
     free(tag);
     return NULL;
   }
@@ -979,13 +980,13 @@ s_tag * tag_map_1 (s_tag *tag, const s8 *p)
   return tag;
 }
 
-s_tag * tag_ptr (s_tag *tag, const s_sym *type, void *p)
+s_tag * tag_ptr (s_tag *tag, bool free_p, const s_sym *type, void *p)
 {
   s_tag tmp = {0};
   assert(tag);
   tag_clean(tag);
   tmp.type = TAG_PTR;
-  if (! ptr_init(&tmp.data.ptr, type, p))
+  if (! ptr_init(&tmp.data.ptr, free_p, type, p))
     return NULL;
   *tag = tmp;
   return tag;
diff --git a/libc3/tag_init.h b/libc3/tag_init.h
index 7d77294..c4c48b2 100644
--- a/libc3/tag_init.h
+++ b/libc3/tag_init.h
@@ -32,7 +32,8 @@ s_tag * tag_init_integer_zero (s_tag *tag);
 s_tag * tag_init_list (s_tag *tag, s_list *list);
 s_tag * tag_init_map (s_tag *tag, uw count);
 s_tag * tag_init_map_1 (s_tag *tag, const s8 *p);
-s_tag * tag_init_ptr (s_tag *tag, const s_sym *type, void *p);
+s_tag * tag_init_ptr (s_tag *tag, bool free_p, const s_sym *type, 
+                      void *p);
 s_tag * tag_init_s8 (s_tag *tag, s8 i);
 s_tag * tag_init_s16 (s_tag *tag, s16 i);
 s_tag * tag_init_s32 (s_tag *tag, s32 i);
@@ -70,7 +71,7 @@ s_tag * tag_new_integer_zero (void);
 s_tag * tag_new_list (s_list *list);
 s_tag * tag_new_map (uw count);
 s_tag * tag_new_map_1 (const s8 *p);
-s_tag * tag_new_ptr (const s_sym *type, void *p);
+s_tag * tag_new_ptr (bool free_p, const s_sym *type, void *p);
 s_tag * tag_new_s8 (s8 i);
 s_tag * tag_new_s16 (s16 i);
 s_tag * tag_new_s32 (s32 i);
@@ -108,7 +109,7 @@ s_tag * tag_integer_zero (s_tag *tag);
 s_tag * tag_list (s_tag *tag, s_list *list);
 s_tag * tag_map (s_tag *tag, uw count);
 s_tag * tag_map_1 (s_tag *tag, const s8 *p);
-s_tag * tag_ptr (s_tag *tag, const s_sym *type, void *p);
+s_tag * tag_ptr (s_tag *tag, bool free_p, const s_sym *type, void *p);
 s_tag * tag_s8 (s_tag *tag, s8 i);
 s_tag * tag_s16 (s_tag *tag, s16 i);
 s_tag * tag_s32 (s_tag *tag, s32 i);
diff --git a/libc3/tag_init.rb b/libc3/tag_init.rb
index 46b9b92..6b23b32 100644
--- a/libc3/tag_init.rb
+++ b/libc3/tag_init.rb
@@ -331,7 +331,8 @@ class TagInitList
                    [Arg.new("uw", "count")]),
        TagInit1.new("map", "1", "TAG_MAP", :init_mode_init),
        TagInit.new("ptr", "TAG_PTR", :init_mode_init,
-                   [Arg.new("const s_sym *", "type"),
+                   [Arg.new("bool", "free_p"),
+                    Arg.new("const s_sym *", "type"),
                     Arg.new("void *", "p")]),
        TagInit.new("s8", "TAG_S8", :init_mode_direct,
                    [Arg.new("s8", "i")]),
diff --git a/libc3/types.h b/libc3/types.h
index 5573ea5..74f148a 100644
--- a/libc3/types.h
+++ b/libc3/types.h
@@ -235,8 +235,9 @@ struct map {
 };
 
 struct ptr {
-  const s_sym *type;
   void *p;
+  const s_sym *type;
+  bool free;
 };
 
 union ptr_ {
diff --git a/libc3/window/sdl2/demo/earth.c b/libc3/window/sdl2/demo/earth.c
index 7b87b2d..4452656 100644
--- a/libc3/window/sdl2/demo/earth.c
+++ b/libc3/window/sdl2/demo/earth.c
@@ -43,11 +43,11 @@ bool earth_load (s_sequence *seq,
     return false;
   map = &seq->tag.data.map;
   tag_init_sym_1(map->key + 0, "camera");
-  tag_init_ptr(map->value + 0, sym_1("GL.Camera"), camera);
+  tag_init_ptr(map->value + 0, true, sym_1("GL.Camera"), camera);
   tag_init_sym_1(map->key + 1, "camera_rot_x_speed");
   tag_init_f64(map->value + 1, 0.01);
   tag_init_sym_1(map->key + 2, "sphere");
-  tag_init_ptr(map->value + 2, sym_1("GL.Sphere"), sphere);
+  tag_init_ptr(map->value + 2, true, sym_1("GL.Sphere"), sphere);
   return true;
 }