Added str->vec to enable more powerful string handling (issue #102).

Added a new unsafe-cast primitive that lets us write conversion functions in the library.

harlan/front/expand-primitives.scm

@@ -112,6 +112,7 @@
     ((var ,t ,x) `(var ,t ,x))
     ((int->float ,[e]) `(int->float ,e))
     ((float->int ,[e]) `(float->int ,e))
+    ((cast ,t ,[e]) `(cast ,t ,e))
     ((iota ,[e])
      `(iota ,e))
     ((iota-r ,r ,[e])

harlan/front/parser.scm

@@ -129,6 +129,9 @@
   ((unsafe-vec-ptr ,[v]) `(unsafe-vec-ptr ,v))
   ((length ,[e])
    `(length ,e))
+  ((unsafe-explicit-cast
+    (,[(parse-type env) -> t1] -> ,[(parse-type env) -> t2]) ,[e])
+   `(unsafe-explicit-cast (,t1 -> ,t2) ,e))
   ((int->float ,[e]) `(int->float ,e))
   ((float->int ,[e]) `(float->int ,e))
   ((lambda (,x* ...) ,stmt* ... ,expr)

harlan/front/typecheck.scm

@@ -349,6 +349,9 @@
               (r (make-rvar (gensym 'rvref))))
           (do* (((v _) (require-type v env `(vec ,r ,t))))
                (return `(unsafe-vec-ptr (ptr ,t) ,v) `(ptr ,t)))))
+       ((unsafe-explicit-cast (,t1 -> ,t2) ,e)
+        (do* (((e _) (require-type e env t1)))
+             (return `(cast ,t2 ,e) t2)))
        ((,+ ,a ,b) (guard (binop? +))
         (do* (((a t) (infer-expr a env))
               ((b t) (require-type b env t))
@@ -760,6 +763,8 @@
         ((length ,[e]) `(length ,e))
         ((vector-ref ,[ground-type -> t] ,[v] ,[i])
          `(vector-ref ,t ,v ,i))
+        ((cast ,[ground-type -> t] ,[e])
+         `(cast ,t ,e))
         ((unsafe-vector-ref ,[ground-type -> t] ,[v] ,[i])
          `(unsafe-vector-ref ,t ,v ,i))
         ((unsafe-vec-ptr ,[ground-type -> t] ,[v])
@@ -805,6 +810,8 @@
     ((vector ,[free-regions-type -> t] ,[e*] ...)
      (union t (apply union e*)))
     ((length ,[e]) e)
+    ((cast ,[free-regions-type -> t] ,[e])
+     (union t e))
     ((vector-ref ,[free-regions-type -> t] ,[x] ,[i]) (union t x i))
     ((unsafe-vector-ref ,[free-regions-type -> t] ,[x] ,[i]) (union t x i))
     ((unsafe-vec-ptr ,[free-regions-type -> t] ,[v])

harlan/middle/annotate-free-vars.scm

@@ -82,6 +82,7 @@
   ((var ,t ,x) `((var ,t ,x)))
   ((int->float ,[fv*]) fv*)
   ((float->int ,[fv*]) fv*)
+  ((cast ,t ,[e]) e)
   ((length ,[fv*]) fv*)
   ((addressof ,[fv*]) fv*)
   ((not ,[e]) e)

harlan/middle/desugar-match.scm

@@ -135,6 +135,7 @@
          ((char ,c) `(char ,c))
          ((int->float ,[i]) `(int->float ,i))
          ((float->int ,[f]) `(float->int ,f))
+         ((cast ,t ,[e]) `(cast ,t ,e))
          ((begin ,[desugar-stmt -> s] ... ,[e])
           `(begin ,s ... ,e))
          ((call ,[e*] ...) `(call ,e* ...))

harlan/middle/languages.scm

@@ -99,6 +99,7 @@
      (char c)
      (str str-t)
      (vector t r e* ...)
+     (cast t e)
      (do e)
      (print e)
      (print e1 e2)
@@ -340,8 +341,7 @@
 
     (Expr
      (e)
-     (+ (cast t e)
-        (sizeof t)
+     (+ (sizeof t)
         (alloc e1 e2)
         (region-ref t e1 e2))
      (- (box r t)

harlan/middle/lift-complex.scm

@@ -17,6 +17,8 @@
        (lift-expr e (lambda (e) (finish `(int->float ,e)))))
       ((float->int ,e)
        (lift-expr e (lambda (e) (finish `(float->int ,e)))))
+      ((cast ,t ,e)
+       (lift-expr e (lambda (e) (finish `(cast ,t ,e)))))
       ((not ,e)
        (lift-expr e (lambda (e) (finish `(not ,e)))))
       ((begin ,[lift-stmt -> stmt*] ... ,e)

harlan/middle/make-vector-refs-explicit.scm

@@ -70,6 +70,7 @@
   ((length ,[e]) `(length ,e))
   ((int->float ,[e]) `(int->float ,e))
   ((float->int ,[e]) `(float->int ,e))
+  ((cast ,t ,[e]) `(cast ,t ,e))
   ((not ,[e]) `(not ,e))
   ((make-vector ,t ,r ,[e]) `(make-vector ,t ,r ,e))
   ((vector ,t ,r ,[e*] ...) `(vector ,t ,r . ,e*))

harlan/middle/optimize-fuse-kernels.scm

@@ -56,6 +56,7 @@
     ((var ,t ,x) `(var ,t ,x))
     ((int->float ,[e]) `(int->float ,e))
     ((float->int ,[e]) `(float->int ,e))
+    ((cast ,t ,[e]) `(cast ,t ,e))
     ((make-vector ,t ,r ,[e])
      `(make-vector ,t ,r ,e))
     ((vector ,t ,r ,[e] ...)

harlan/middle/remove-danger.scm

@@ -98,6 +98,7 @@
     ((var ,t ,x) `(var ,t ,x))
     ((int->float ,[e]) `(int->float ,e))
     ((float->int ,[e]) `(float->int ,e))
+    ((cast ,t ,[e]) `(cast ,t ,e))
     ((make-vector ,t ,r ,[e])
      `(make-vector ,t ,r ,e))
     ((vector-ref ,t ,[v] ,[i])

harlan/middle/remove-nested-kernels.scm

@@ -74,6 +74,7 @@
    `(call ,fn . ,args))
   ((int->float ,[e]) `(int->float ,e))
   ((float->int ,[e]) `(float->int ,e))
+  ((cast ,t ,[e]) `(cast ,t ,e))
   ((length ,[e]) `(length ,e))
   ((,t ,x) (guard (scalar-type? t)) `(,t ,x))
   ((var ,t ,x) `(var ,t ,x))

harlan/middle/returnify-kernels.scm

@@ -71,6 +71,7 @@
   ((length ,[e]) `(length ,e))
   ((int->float ,[e]) `(int->float ,e))
   ((float->int ,[e]) `(float->int ,e))
+  ((cast ,t ,[e]) `(cast ,t ,e))
   ((make-vector ,t ,r ,[e]) `(make-vector ,t ,r ,e))
   ((vector ,t ,r ,[e*] ...) `(vector ,t ,r . ,e*))
   ((,op ,[lhs] ,[rhs])
@@ -234,6 +235,7 @@
   ((bool ,b) `(bool ,b))
   ((var ,t ,x) `(var ,t ,x))
   ((int->float ,[e]) `(int->float ,e))
+  ((cast ,t ,[e]) `(cast ,t ,e))
   ((vector-ref ,t ,[v] ,[i])
    `(vector-ref ,t ,v ,i))
   ((unsafe-vec-ptr ,t ,[v])

harlan/middle/uglify-vectors.scm

@@ -235,6 +235,7 @@
    (values `(cast float ,e) r*))
   ((float->int ,[e r*])
    (values `(cast int ,e) r*))
+  ((cast ,t ,[e r]) (values `(cast ,t ,e) r))
   ((call ,[name nr*] ,[args ar**] ...)
    (values `(call ,name
                   ,@args

lib/harlan/core.kfc

@@ -2,12 +2,11 @@
 
 (module
 
-  (extern open_outfile (str) -> (ptr ofstream))
   (extern close_outfile ((ptr ofstream)) -> void)
-
-  (extern time-s () -> float)
-
   (extern command-line () -> (vec str))
+  (extern open_outfile (str) -> (ptr ofstream))
+  (extern str->vec (str) -> (vec char))
+  (extern time-s () -> float)
 
   (define-macro cond (else)
     ((_ (else body))
@@ -139,4 +138,7 @@
   (define-macro println-vec ()
     ((_ v)
      (begin (print-vec v) (println ""))))
+
+  (define (char->int c)
+    (unsafe-explicit-cast (char -> int) c))
   )

rt/builtin.cpp

@@ -40,7 +40,7 @@ uint64_t nanotime() {
 // () -> float
 //
 // Retuns the value of a timer in seconds.
-float time$s() {
+float time$ds() {
 	return float(nanotime() / 1000) / 1e6;
 }
 
@@ -70,17 +70,21 @@ float sqrt(float x) {
 }
 template<typename T>
 struct harlan_vector {
-	int length;
+	int64_t length;
 	T data[];
 };
 
 // in harlan.cpp
 extern int ARGC;
 extern char **ARGV;
 
+#define VECTOR_LENGTH_OFFSET 8
+
 // () -> (vec str)
-region_ptr command$line(region *&r) {
-	region_ptr ptr = alloc_in_region(&r, sizeof(int) + ARGC * sizeof(char *));
+region_ptr command$dline(region *&r) {
+	region_ptr ptr = alloc_in_region(&r,
+									 VECTOR_LENGTH_OFFSET 
+									 + ARGC * sizeof(char *));
 	harlan_vector<char *> *vec
 		= (harlan_vector<char *> *)get_region_ptr(r, ptr);
 
@@ -92,3 +96,22 @@ region_ptr command$line(region *&r) {
 
 	return ptr;
 }
+
+// (str) -> (vec char)
+region_ptr str$d$vvec(const char *str, region *&r) {
+	int length = strlen(str);
+
+	region_ptr ptr = alloc_in_region(&r,
+									 VECTOR_LENGTH_OFFSET
+									 + length * sizeof(char));
+	harlan_vector<char> *vec
+		= (harlan_vector<char> *)get_region_ptr(r, ptr);
+
+	vec->length = length;
+
+	for(int i = 0; i < length; ++i) {
+		vec->data[i] = str[i];
+	}
+
+	return ptr;
+}

rt/harlan.hpp

@@ -71,8 +71,8 @@ inline void *get_region_ptr(region *r, region_ptr i) {
 // probably be open-coded by the compiler.
 
 #define mk_refs(T) \
-    inline T unsafe$deref$##T(T *p, int i) { return p[i]; } \
-    inline void unsafe$set$b$##T(T *p, int i, T x) { p[i] = x; }
+    inline T unsafe$dderef$d##T(T *p, int i) { return p[i]; } \
+    inline void unsafe$dset$b$d##T(T *p, int i, T x) { p[i] = x; }
 
 mk_refs(float)
 mk_refs(int)