bytes

kklib/include/kklib/bytes.h

@@ -92,6 +92,7 @@ static inline kk_bytes_t kk_bytes_dup(kk_bytes_t b, kk_context_t* ctx) {
 // Adds a terminating zero at the end. Return the raw buffer pointer in `buf` if non-NULL
 kk_decl_export kk_bytes_t kk_bytes_alloc_len(kk_ssize_t len, kk_ssize_t plen, const uint8_t* p, uint8_t** buf, kk_context_t* ctx);
 kk_decl_export kk_bytes_t kk_bytes_adjust_length(kk_bytes_t p, kk_ssize_t newlen, kk_context_t* ctx);
+kk_decl_export kk_bytes_t kk_bytes_advance(kk_bytes_t p, kk_ssize_t count, kk_context_t* ctx);
 
 // allocate uninitialized bytes
 static inline kk_bytes_t kk_bytes_alloc_buf(kk_ssize_t len, uint8_t** buf, kk_context_t* ctx) {
@@ -157,7 +158,15 @@ static inline const char* kk_bytes_cbuf_borrow(const kk_bytes_t b, kk_ssize_t* l
   return (const char*)kk_bytes_buf_borrow(b, len, ctx);
 }
 
+static inline int8_t kk_bytes_at(kk_bytes_t p, uint64_t i, kk_context_t* ctx){
+  const uint8_t* buf = kk_bytes_buf_borrow(p, NULL, ctx);
+  return (int8_t)buf[i];
+}
 
+static inline void kk_bytes_set(kk_bytes_t p, uint64_t i, int8_t b, kk_context_t* ctx){
+  uint8_t* buf = (uint8_t*)kk_bytes_buf_borrow(p, NULL, ctx);
+  buf[i] = (uint8_t)b;
+}
 
 /*--------------------------------------------------------------------------------------------------
   Length, compare

kklib/src/bytes.c

@@ -85,6 +85,21 @@ kk_bytes_t kk_bytes_adjust_length(kk_bytes_t b, kk_ssize_t newlen, kk_context_t*
   }
 }
 
+kk_bytes_t kk_bytes_advance(kk_bytes_t b, kk_ssize_t count, kk_context_t* ctx) {
+  kk_ssize_t len;
+  const uint8_t* s = kk_bytes_buf_borrow(b,&len,ctx);
+  if (len == count) {
+    kk_bytes_drop(b, ctx);
+    return kk_bytes_empty();
+  } else {
+    // copy the rest
+    kk_ssize_t newlen = len - count;
+    kk_bytes_t tb = kk_bytes_alloc_dupn(newlen, s + count, ctx);
+    kk_bytes_drop(b, ctx);
+    return tb;
+  }
+}
+
 
 /*--------------------------------------------------------------------------------------------------
   Compare

lib/std/core/types.kk

@@ -101,6 +101,12 @@ pub value type float32
 // See `module std/core/vector` for vector operations.
 pub type vector<a>
 
+// A raw wrapper around a uint8 character array.
+pub type bytes
+
+// A raw wrapper around a uint8 character array.
+pub type bytes
+
 // An any type. Used for external calls.
 pub type any
 

lib/std/data/bytes.kk

@@ -0,0 +1,45 @@
+
+// ----------------------------------------------------------------------------
+// Bytes
+// ----------------------------------------------------------------------------
+
+pub extern bytes/empty(): bytes
+  c  inline "kk_bytes_empty()"
+  cs "Primitive.BytesEmpty"
+  js inline "new Uint8Array(0)"
+
+pub extern bytes/alloc( n : ssize_t ) : bytes
+  c  inline "kk_bytes_alloc_buf(#1, NULL, kk_context())"
+  cs "Primitive.BytesAlloc"
+  js inline "new Uint8Array(#1).fill(#2)"
+
+pub extern bytes/string( n : bytes ) : string
+  c  "kk_string_convert_from_qutf8"
+  cs "Primitive.BytesToString"
+  js inline "String.fromCharCode.apply(null, #1)"
+
+pub extern string/bytes( s : string ) : bytes
+  c  inline "#1.bytes"
+  cs "Primitive.BytesFromString"
+  js inline "new TextEncoder().encode(#1)"
+
+pub extern bytes/length( ^b : bytes ) : ssize_t
+  c  "kk_bytes_len_borrow"
+  cs "Primitive.BytesLen"
+  js inline "#1.length"
+
+pub extern bytes/adjust-length(b: bytes, len: ssize_t): bytes
+  c  "kk_bytes_adjust_length"
+
+pub extern bytes/advance(b: bytes, count: ssize_t): bytes
+  c  "kk_bytes_advance"
+
+pub extern bytes/index( ^b : bytes, ^i : ssize_t ) : int8
+  c  "kk_bytes_at"
+  cs "Primitive.BytesAt"
+  js inline "#1[#2]"
+
+pub extern bytes/int8/assign( ^b : bytes, ^i : ssize_t, x : int8 ) : ()
+  c  "kk_bytes_set"
+  cs "Primitive.BytesSet"
+  js inline "#1[#2] = #3"

lib/toc.kk

@@ -18,6 +18,8 @@ pub import std/core/unsafe
 pub import std/core/undiv
 pub import std/core
 
+pub import std/data/bytes
+
 pub import std/os/env
 pub import std/os/flags
 pub import std/os/path

src/Backend/C/FromCore.hs

@@ -413,7 +413,7 @@ unitSemi tp
 genTopLevelStringLiteral :: Name -> Visibility -> String -> Asm ()
 genTopLevelStringLiteral name vis s
   =  do let (cstr,clen) = cstring s
-            decl = if (isPublic vis) then empty else text "static"
+            decl = if (isPublic vis) then empty else text ""
         if (clen > 0)
           then do emitToC (text "kk_declare_string_literal" <.> tupled [decl,ppName name,pretty clen,cstr] {- <.> semi -})
                   emitToInit (text "kk_init_string_literal" <.> arguments [ppName name])
@@ -763,7 +763,7 @@ genBoxCall tp arg
         ctx  = contextDoc
     in case cType tp of
       CFun _ _   -> primName_t prim "function_t" <.> tupled ([arg,ctx])
-      CPrim val  | val == "kk_unit_t" || val == "bool" || val == "kk_string_t" -- || val == "kk_integer_t"
+      CPrim val  | val == "kk_unit_t" || val == "bool" || val == "kk_string_t" || val == "kk_bytes_t" -- || val == "kk_integer_t" 
                  -> primName_t prim val <.> parens arg  -- no context
       CData name -> primName prim (ppName name) <.> tupled [arg,ctx]
       _          -> primName_t prim (show (ppType tp)) <.> tupled [arg,ctx]  -- kk_box_t, int32_t
@@ -780,7 +780,7 @@ genUnboxCall tp arg argBorrow
         ctx  = contextDoc
     in case cType tp of
       CFun _ _   -> primName_t prim "function_t" <.> tupled [arg,ctx] -- no borrow
-      CPrim val  | val == "kk_unit_t" || val == "bool" || val == "kk_string_t"
+      CPrim val  | val == "kk_unit_t" || val == "bool" || val == "kk_string_t" || val == "kk_bytes_t"
                     -> primName_t prim val <.> parens arg  -- no borrow, no context
                  | otherwise
                     -> primName_t prim val <.>  tupled ([arg] ++ (if (cPrimCanBeBoxed val) then [argBorrow] else []) ++ [ctx])
@@ -1054,7 +1054,7 @@ genDupDropCallX prim tp args
   = case cType tp of
       CFun _ _   -> [(primName_t prim "function_t") <.> args]
       CBox       -> [(primName_t prim "box_t") <.> args]
-      CPrim val   | val == "kk_integer_t" || val == "kk_string_t" || val == "kk_vector_t" || val == "kk_evv_t" || val == "kk_ref_t" || val == "kk_reuse_t" || val == "kk_box_t"
+      CPrim val   | val == "kk_integer_t" || val == "kk_bytes_t" || val == "kk_string_t" || val == "kk_vector_t" || val == "kk_evv_t" || val == "kk_ref_t" || val == "kk_reuse_t" || val == "kk_box_t"
                   -> [(primName_t prim val) <.> args]
                   | otherwise
                   -> -- trace ("** skip dup/drop call: " ++ prim ++ ": " ++ show args) $
@@ -1105,6 +1105,7 @@ genHoleCall tp        = --  ppType tp <.> text "_hole()")
                         case cType tp of
                           CPrim "kk_integer_t" -> text "kk_integer_zero"
                           CPrim "kk_string_t"  -> text "kk_string_empty()"
+                          CPrim "kk_bytes_t"  -> text "kk_bytes_empty()"
                           CPrim "kk_vector_t"  -> text "kk_vector_empty()"
                           _      -> text "kk_datatype_null()"
 
@@ -1292,6 +1293,8 @@ cTypeCon c
          then CPrim "kk_integer_t"
         else if (name == nameTpString)
          then CPrim "kk_string_t"
+        else if (name == nameTpBytes)
+         then CPrim "kk_bytes_t"
         else if (name == nameTpVector)
          then CPrim "kk_vector_t"
         else if (name ==  nameTpEvv)
@@ -2185,7 +2188,7 @@ getFormat :: TName -> [(Target,String)] -> String
 getFormat tname formats
   = case lookupTarget (C CDefault) formats of  -- TODO: pass real ctarget from flags
       Nothing -> -- failure ("backend does not support external in " ++ show tname ++ ": " ++ show formats)
-                 trace( "warning: C backend does not support external in " ++ show tname ) $
+                 trace( "warning: C backend does not support external in " ++ show tname ++ " looking in " ++ show formats ) $
                       ("kk_unsupported_external(\"" ++ (show tname) ++ "\")")
       Just s -> s
 

src/Common/NamePrim.hs

@@ -115,7 +115,7 @@ module Common.NamePrim
 
           , nameTpBool, nameTpInt, nameTpChar
           , nameTpFloat, nameTpFloat32, nameTpFloat16
-          , nameTpString
+          , nameTpString, nameTpBytes
           -- , nameTpByte
           , nameTpInt8, nameTpInt16, nameTpInt32, nameTpInt64
           , nameTpSSizeT,nameTpIntPtrT
@@ -440,6 +440,7 @@ nameTpFloat16   = coreTypesName "float16"
 
 nameTpChar      = coreTypesName "char"
 nameTpString    = coreTypesName "string"
+nameTpBytes     = coreTypesName "bytes"
 nameTpAny       = coreTypesName "any"
 nameTpVector    = coreTypesName "vector"