Implemented all but one (RAN) of the intrinsic functions in appendix N by mapping them directly to the C versions
This commit is contained in:
parent
63d558df20
commit
9b1368ffe7
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
@ -73,6 +75,11 @@ intrinsicFunctions =
|
|||
, ("SCALEB", ([A.Real32], [(A.Real32, "X"), (A.Int, "n")]))
|
||||
, 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")])
|
||||
|
|
Loading…
Reference in New Issue
Block a user