Skip to content

Commit

Permalink
Added the supported by malfunction operators
Browse files Browse the repository at this point in the history
  • Loading branch information
@xekoukou
xekoukou committed Oct 11, 2016
1 parent aee20c6 commit ff705c1
Showing 1 changed file with 70 additions and 2 deletions.
72 changes: 70 additions & 2 deletions src/IRTS/CodegenMalfunction.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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
Expand All @@ -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]

0 comments on commit ff705c1

Please sign in to comment.