From ff705c1b13103921649870a8a1e2401eb8bd7756 Mon Sep 17 00:00:00 2001 From: Apostolis Xekoukoulotakis Date: Tue, 11 Oct 2016 23:38:36 +0300 Subject: [PATCH] Added the supported by malfunction operators --- src/IRTS/CodegenMalfunction.hs | 72 +++++++++++++++++++++++++++++++++- 1 file changed, 70 insertions(+), 2 deletions(-) diff --git a/src/IRTS/CodegenMalfunction.hs b/src/IRTS/CodegenMalfunction.hs index 59db023..de9e1e9 100644 --- a/src/IRTS/CodegenMalfunction.hs +++ b/src/IRTS/CodegenMalfunction.hs @@ -153,6 +153,8 @@ cgSwitch e cases = arithSuffix (ATInt ITNative) = "" arithSuffix (ATInt ITChar) = "" +arithSuffix (ATInt (ITFixed IT32)) = ".32" +arithSuffix (ATInt (ITFixed IT64)) = ".64" arithSuffix (ATInt ITBig) = ".big" arithSuffix s = error $ "unsupported arithmetic type: " ++ show s @@ -170,15 +172,78 @@ cgOp LStrCons [c, r] = cgOp LWriteStr [_, str] = S [A "apply", S [A "global", A "$Pervasives", A "$print_string"], cgVar str] cgOp LReadStr [_] = S [A "apply", S [A "global", A "$Pervasives", A "$read_line"], KInt 0] + +cgOp p@(LPlus (ATInt (ITFixed IT8))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] +cgOp p@(LPlus (ATInt (ITFixed IT16))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] cgOp (LPlus t) args = S (A ("+" ++ arithSuffix t) : map cgVar args) +cgOp p@(LMinus (ATInt (ITFixed IT8))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] +cgOp p@(LMinus (ATInt (ITFixed IT16))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] cgOp (LMinus t) args = S (A ("-" ++ arithSuffix t) : map cgVar args) +cgOp p@(LTimes (ATInt (ITFixed IT8))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] +cgOp p@(LTimes (ATInt (ITFixed IT16))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] cgOp (LTimes t) args = S (A ("*" ++ arithSuffix t) : map cgVar args) +cgOp p@(LSDiv (ATInt (ITFixed IT8))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] +cgOp p@(LSDiv (ATInt (ITFixed IT16))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] +cgOp (LSDiv t) args = S (A ("/" ++ arithSuffix t) : map cgVar args) +cgOp p@(LSRem (ATInt (ITFixed IT8))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] +cgOp p@(LSRem (ATInt (ITFixed IT16))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] cgOp (LSRem t) args = S (A ("%" ++ arithSuffix t) : map cgVar args) + +cgOp p@(LEq (ATInt (ITFixed IT8))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] +cgOp p@(LEq (ATInt (ITFixed IT16))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] cgOp (LEq t) args = S (A ("==" ++ arithSuffix t) : map cgVar args) +cgOp p@(LSLt (ATInt (ITFixed IT8))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] +cgOp p@(LSLt (ATInt (ITFixed IT32))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] cgOp (LSLt t) args = S (A ("<" ++ arithSuffix t) : map cgVar args) +cgOp p@(LSGt (ATInt (ITFixed IT8))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] +cgOp p@(LSGt (ATInt (ITFixed IT16))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] cgOp (LSGt t) args = S (A (">" ++ arithSuffix t) : map cgVar args) +cgOp p@(LSLe (ATInt (ITFixed IT8))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] +cgOp p@(LSLe (ATInt (ITFixed IT16))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] cgOp (LSLe t) args = S (A ("<=" ++ arithSuffix t) : map cgVar args) +cgOp p@(LSGe (ATInt (ITFixed IT8))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] +cgOp p@(LSGe (ATInt (ITFixed IT16))) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] cgOp (LSGe t) args = S (A (">=" ++ arithSuffix t) : map cgVar args) + +cgOp (LSHL ITNative) args = S (A "<<" : map cgVar args) +cgOp (LSHL ITChar) args = S (A "<<" : map cgVar args) +cgOp (LSHL ITBig) args = S (A "<<.big" : map cgVar args) +cgOp (LSHL (ITFixed IT32)) args = S (A "<<.32" : map cgVar args) +cgOp (LSHL (ITFixed IT64)) args = S (A "<<.64" : map cgVar args) +cgOp p@(LSHL _) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] +cgOp (LLSHR ITNative) args = S (A ">>" : map cgVar args) +cgOp (LLSHR ITChar) args = S (A ">>" : map cgVar args) +cgOp (LLSHR ITBig) args = S (A ">>.big" : map cgVar args) +cgOp (LLSHR (ITFixed IT32)) args = S (A ">>.32" : map cgVar args) +cgOp (LLSHR (ITFixed IT64)) args = S (A ">>.64" : map cgVar args) +cgOp p@(LLSHR _) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] +cgOp (LASHR ITNative) args = S (A "a>" : map cgVar args) +cgOp (LASHR ITChar) args = S (A "a>" : map cgVar args) +cgOp (LASHR ITBig) args = S (A "a>.big" : map cgVar args) +cgOp (LASHR (ITFixed IT32)) args = S (A "a>.32" : map cgVar args) +cgOp (LASHR (ITFixed IT64)) args = S (A "a>.64" : map cgVar args) +cgOp p@(LASHR _) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] + +cgOp (LAnd ITNative) args = S (A "&" : map cgVar args) +cgOp (LAnd ITChar) args = S (A "&" : map cgVar args) +cgOp (LAnd ITBig) args = S (A "&.big" : map cgVar args) +cgOp (LAnd (ITFixed IT32)) args = S (A "&.32" : map cgVar args) +cgOp (LAnd (ITFixed IT64)) args = S (A "&.64" : map cgVar args) +cgOp p@(LAnd _) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] +cgOp (LOr ITNative) args = S (A "|" : map cgVar args) +cgOp (LOr ITChar) args = S (A "|" : map cgVar args) +cgOp (LOr ITBig) args = S (A "|.big" : map cgVar args) +cgOp (LOr (ITFixed IT32)) args = S (A "|.32" : map cgVar args) +cgOp (LOr (ITFixed IT64)) args = S (A "|.64" : map cgVar args) +cgOp p@(LOr _) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] +cgOp (LXOr ITNative) args = S (A "^" : map cgVar args) +cgOp (LXOr ITChar) args = S (A "^" : map cgVar args) +cgOp (LXOr ITBig) args = S (A "^.big" : map cgVar args) +cgOp (LXOr (ITFixed IT32)) args = S (A "^.32" : map cgVar args) +cgOp (LXOr (ITFixed IT64)) args = S (A "^.64" : map cgVar args) +cgOp p@(LXOr _) args = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented: " ++ show p] + + cgOp (LIntStr ITNative) args = pervasive "string_of_int" args cgOp (LIntStr ITBig) args = stdlib ["Z", "to_string"] args cgOp (LChInt _) [x] = cgVar x @@ -201,6 +266,9 @@ cgConst (BI n) = S [A "i.big", A (show n)] cgConst (Fl x) = error "no floats" cgConst (Ch i) = KInt (ord i) cgConst (Str s) = KStr s -cgConst k = error $ "unimplemented constant " ++ show k - +cgConst (B8 _) = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented B8 constant"] +cgConst (B16 _) = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented B16 constant"] +cgConst (B32 n) = S [A "i.32", A (show n)] +cgConst (B64 n) = S [A "i.64", A (show n)] +cgConst k = S [A "apply", S [A "global", A "$Pervasives", A "$failwith"], KStr $ "unimplemented constant: " ++ show k]