diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index 19c23fe..aa7462a 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -53,6 +53,7 @@ import CompState import Errors import EvalConstants import EvalLiterals +import Intrinsics import GenerateCBased import Metadata import Pass @@ -940,9 +941,12 @@ cgenTypeSymbol s t cgenIntrinsicFunction :: Meta -> String -> [A.Expression] -> CGen () cgenIntrinsicFunction m s es - = do tell ["occam_", [if c == '.' then '_' else c | c <- s], "("] - sequence [call genExpression e >> genComma | e <- es] - genMeta m + = do let (funcName, giveMeta) = case lookup s simpleFloatIntrinsics of + Just (_,cName) -> (cName, False) + Nothing -> ("occam_" ++ [if c == '.' then '_' else c | c <- s], True) + tell [funcName, "("] + seqComma [call genExpression e | e <- es] + when (giveMeta) $ genComma >> genMeta m tell [")"] --}}} @@ -1542,12 +1546,14 @@ cgenAssign m [v] (A.ExpressionList _ [e]) tell [";"] cgenAssign m (v:vs) (A.IntrinsicFunctionCallList _ n es) = do call genVariable v - tell ["=occam_",[if c == '.' then '_' else c | c <- n],"("] + let (funcName, giveMeta) = case lookup n simpleFloatIntrinsics of + Just (_,cName) -> (cName, False) + Nothing -> ("occam_" ++ [if c == '.' then '_' else c | c <- n], True) + tell ["=",funcName,"("] seqComma $ map (call genExpression) es mapM (\v -> tell [","] >> call genActual (A.Formal A.Abbrev A.Int (A.Name emptyMeta "dummy_intrinsic_param")) (A.ActualVariable v)) vs - tell [","] - genMeta m + when giveMeta $ genComma >> genMeta m tell [");"] cgenAssign m _ _ = call genMissing "Cannot perform assignment with multiple destinations or multiple sources" diff --git a/common/Intrinsics.hs b/common/Intrinsics.hs index e7ca841..9b8e3ac 100644 --- a/common/Intrinsics.hs +++ b/common/Intrinsics.hs @@ -21,6 +21,8 @@ module Intrinsics where import qualified AST as A +import Data.Char + intrinsicFunctions :: [(String, ([A.Type], [(A.Type, String)]))] intrinsicFunctions = [ -- Multiple length arithmetic functions @@ -71,8 +73,13 @@ intrinsicFunctions = , query "NOTFINITE" , ("ORDERED", ([A.Bool], [(A.Real32, "X"), (A.Real32, "Y")])) , ("SCALEB", ([A.Real32], [(A.Real32, "X"), (A.Int, "n")])) - , simple "SQRT" + , simple "SQRT" ] + + -- Elementary floating point functions + -- Appendix N of the occam 2 manual (and section J.4) + ++ [(n, ts) | (n, (ts, _)) <- simpleFloatIntrinsics] + ++ [("RAN", ([A.Real32, A.Int32], [(A.Int32, "N")]))] where query n = (n, ([A.Bool], [(A.Real32, "X")])) simple n = (n, ([A.Real32], [(A.Real32, "X")])) @@ -90,6 +97,34 @@ intrinsicFunctions = dt A.Int32 = A.Int64 dt t = t +simpleFloatIntrinsics :: [(String, (([A.Type], [(A.Type, String)]), String))] +simpleFloatIntrinsics = concatMap double $ + -- Same order as occam manual: + [("ALOG", ([A.Real32], [(A.Real32, "X")]), "log") + ,("ALOG10", ([A.Real32], [(A.Real32, "X")]), "log10") + ] ++ map s [ + "EXP", + "TAN", + "SIN", + "ASIN", + "COS", + "ACOS", + "SINH", + "COSH", + "TANH", + "ATAN", + "ATAN2" + ] + ++ [("POWER", ([A.Real32], [(A.Real32, "X"), (A.Real32, "Y")]), "pow")] + where + s n = (n, ([A.Real32], [(A.Real32, "X")]), map toLower n) + + double (occn, ts@(rts, pts), cn) = [(occn, (ts, cn++"f")), + ("D"++occn, ((map dt rts, zip (map (dt . fst) pts) (map snd pts)), cn))] + dt A.Real32 = A.Real64 + dt A.Int32 = A.Int64 + dt t = t + intrinsicProcs :: [(String, [(A.AbbrevMode, A.Type, String)])] intrinsicProcs = [ ("ASSERT", [(A.ValAbbrev, A.Bool, "value")])