Conversions to and from and between reals

fco2/GenerateC.hs

@@ -180,26 +180,72 @@ genDecl am t n
 --}}}
 
 --{{{  conversions
-genConversion :: Meta -> A.ConversionMode -> A.Type -> A.Expression -> CGen ()
-genConversion m A.DefaultConversion t e
+genCheckedConversion :: Meta -> A.Type -> A.Type -> CGen () -> CGen ()
+genCheckedConversion m fromT toT exp
     =  do tell ["(("]
-          genType t
+          genType toT
           tell [") "]
-          origT <- typeOfExpression e
-          if isSafeConversion origT t
-            then genExpression e
-            else do genTypeSymbol "range_check" origT
+          if isSafeConversion fromT toT
+            then exp
+            else do genTypeSymbol "range_check" fromT
                     tell [" ("]
-                    genTypeSymbol "mostneg" t
+                    genTypeSymbol "mostneg" toT
                     tell [", "]
-                    genTypeSymbol "mostpos" t
+                    genTypeSymbol "mostpos" toT
                     tell [", "]
-                    genExpression e
+                    exp
                     tell [", "]
                     genMeta m
                     tell [")"]
           tell [")"]
-genConversion m cm t e = missing $ "genConversion " ++ show cm
+
+genConversion :: Meta -> A.ConversionMode -> A.Type -> A.Expression -> CGen ()
+genConversion m A.DefaultConversion toT e
+    =  do fromT <- typeOfExpression e
+          genCheckedConversion m fromT toT (genExpression e)
+genConversion m cm toT e
+    =  do fromT <- typeOfExpression e
+          case (isSafeConversion fromT toT, isRealType fromT, isRealType toT) of
+            (True, _, _) ->
+              -- A safe conversion -- no need for a check.
+              genCheckedConversion m fromT toT (genExpression e)
+            (_, True, True) ->
+              -- Real to real.
+              do genConversionSymbol fromT toT cm
+                 tell [" ("]
+                 genExpression e
+                 tell [", "]
+                 genMeta m
+                 tell [")"]
+            (_, True, False) ->
+              -- Real to integer -- do real -> int64_t -> int.
+              do let exp = do genConversionSymbol fromT A.Int64 cm
+                              tell [" ("]
+                              genExpression e
+                              tell [", "]
+                              genMeta m
+                              tell [")"]
+                 genCheckedConversion m A.Int64 toT exp
+            (_, False, True) ->
+              -- Integer to real -- do int -> int64_t -> real.
+              do genConversionSymbol A.Int64 toT cm
+                 tell [" ("]
+                 genCheckedConversion m fromT A.Int64 (genExpression e)
+                 tell [", "]
+                 genMeta m
+                 tell [")"]
+            _ -> missing $ "genConversion " ++ show cm
+
+genConversionSymbol :: A.Type -> A.Type -> A.ConversionMode -> CGen ()
+genConversionSymbol fromT toT cm
+    =  do tell ["occam_convert_"]
+          genType fromT
+          tell ["_"]
+          genType toT
+          tell ["_"]
+          case cm of
+            A.Round -> tell ["round"]
+            A.Trunc -> tell ["trunc"]
 --}}}
 
 --{{{  literals

fco2/TODO

@@ -29,6 +29,9 @@ Add an option for whether to compile out overflow/bounds checks.
 
 Record literals aren't implemented.
 
+Inline PROCs should be marked with a flag in the AST (i.e. they should be
+ignored at the C generation stage, rather than in the parser).
+
 ## Passes
 
 Come up with an approach to combining simple passes to avoid multiple tree
@@ -47,9 +50,15 @@ directives to their real types.
 Pass to turn subscripted expressions into subscripted variables. (Need to write
 a test for this -- use a function that returns an array?)
 
+Pass to turn complicated conversions into simpler ones (currently done in
+GenerateC).
+
 Have a final pass that checks all the mangling has been done -- i.e. function
 calls have been removed, and so on.
 
+In the PAR wrapping pass, wrapper procs should not be generated for things that
+are already PROC calls.
+
 ## C backend
 
 We could have genSpec generate {} around specs if it's not immediately inside

fco2/Types.hs

@@ -247,7 +247,8 @@ isPreciseConversion fromT toT
 
 -- | Will a conversion between two types always succeed?
 isSafeConversion :: A.Type -> A.Type -> Bool
-isSafeConversion fromT toT = (fromP /= -1) && (toP /= -1) && (fromP <= toP)
+isSafeConversion A.Real32 A.Real64 = True
+isSafeConversion fromT toT = (fromT == toT) || ((fromP /= -1) && (toP /= -1) && (fromP <= toP))
   where
     fromP = precNum fromT
     toP = precNum toT

fco2/testcases/real-conversions.occ

@@ -0,0 +1,20 @@
+PROC P ()
+  INT i:
+  REAL32 f:
+  REAL64 d:
+  SEQ
+    i := 42
+    f := REAL32 ROUND i
+    f := REAL32 TRUNC i
+    i := INT ROUND f
+    i := INT TRUNC f
+    d := REAL64 ROUND i
+    d := REAL64 TRUNC i
+    i := INT ROUND d
+    i := INT TRUNC d
+    d := REAL64 f
+    f := REAL32 ROUND d
+    f := REAL32 TRUNC d
+    f := REAL32 f
+    d := REAL64 d
+:

fco2/testcases/val-retypes.occ

@@ -0,0 +1,12 @@
+PROC P ()
+  VAL INT x IS 42:
+  INT y:
+  SEQ
+    VAL INT32 r RETYPES x + 19:
+    y := INT r
+    VAL [2]INT16 r RETYPES 45 * x:
+    SEQ
+      y := INT r[0]
+      VAL [4]BYTE rr RETYPES [r FOR 2]:
+      y := INT rr[3]
+:

fco2/tock_support.h

@@ -174,6 +174,63 @@ MAKE_DIV(double)
 #undef MAKE_REM
 //}}}
 
+//{{{ conversions to and from reals
+// FIXME: Again, all these should check.
+
+//{{{ float
+float occam_convert_int64_t_float_round (int64_t, const char *) occam_unused;
+float occam_convert_int64_t_float_round (int64_t v, const char *pos) {
+	return (float) v;
+}
+
+float occam_convert_int64_t_float_trunc (int64_t, const char *) occam_unused;
+float occam_convert_int64_t_float_trunc (int64_t v, const char *pos) {
+	return (float) v;
+}
+
+int64_t occam_convert_float_int64_t_round (float, const char *) occam_unused;
+int64_t occam_convert_float_int64_t_round (float v, const char *pos) {
+	return (int64_t) v;
+}
+
+int64_t occam_convert_float_int64_t_trunc (float, const char *) occam_unused;
+int64_t occam_convert_float_int64_t_trunc (float v, const char *pos) {
+	return (int64_t) v;
+}
+
+float occam_convert_double_float_round (double, const char *) occam_unused;
+float occam_convert_double_float_round (double v, const char *pos) {
+	return (float) v;
+}
+
+float occam_convert_double_float_trunc (double, const char *) occam_unused;
+float occam_convert_double_float_trunc (double v, const char *pos) {
+	return (float) v;
+}
+//}}}
+//{{{ double
+double occam_convert_int64_t_double_round (int64_t, const char *) occam_unused;
+double occam_convert_int64_t_double_round (int64_t v, const char *pos) {
+	return (double) v;
+}
+
+double occam_convert_int64_t_double_trunc (int64_t, const char *) occam_unused;
+double occam_convert_int64_t_double_trunc (int64_t v, const char *pos) {
+	return (double) v;
+}
+
+int64_t occam_convert_double_int64_t_round (double, const char *) occam_unused;
+int64_t occam_convert_double_int64_t_round (double v, const char *pos) {
+	return (int64_t) v;
+}
+
+int64_t occam_convert_double_int64_t_trunc (double, const char *) occam_unused;
+int64_t occam_convert_double_int64_t_trunc (double v, const char *pos) {
+	return (int64_t) v;
+}
+//}}}
+//}}}
+
 //{{{ intrinsics
 // FIXME These should do range checks.