diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs index 178cb14..54fe948 100644 --- a/fco2/GenerateC.hs +++ b/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 diff --git a/fco2/TODO b/fco2/TODO index 9bef7ad..94e2010 100644 --- a/fco2/TODO +++ b/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 diff --git a/fco2/Types.hs b/fco2/Types.hs index 6c58ccc..822c121 100644 --- a/fco2/Types.hs +++ b/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 diff --git a/fco2/testcases/real-conversions.occ b/fco2/testcases/real-conversions.occ new file mode 100644 index 0000000..ecd77a0 --- /dev/null +++ b/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 +: diff --git a/fco2/testcases/val-retypes.occ b/fco2/testcases/val-retypes.occ new file mode 100644 index 0000000..451b638 --- /dev/null +++ b/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] +: diff --git a/fco2/tock_support.h b/fco2/tock_support.h index 2390896..9d86083 100644 --- a/fco2/tock_support.h +++ b/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.