git.iko.soy/Idris-dev
on 0875310 help sign in
Idris-dev/src/IRTS/Java/JTypes.hs
300 lines 10 kB history raw
1{-# LANGUAGE PatternGuards #-}
2module IRTS.Java.JTypes where
4import Idris.Core.TT
5import IRTS.Lang
6import Language.Java.Syntax
7import qualified Language.Java.Syntax as J
9import qualified Data.Vector.Unboxed as V
11-----------------------------------------------------------------------
12-- Primitive types
14charType :: J.Type
15charType =
16 PrimType CharT
18byteType :: J.Type
19byteType = PrimType ByteT
21shortType :: J.Type
22shortType = PrimType ShortT
24integerType :: J.Type
25integerType = PrimType IntT
27longType :: J.Type
28longType = PrimType LongT
30doubleType :: J.Type
31doubleType = PrimType DoubleT
33array :: J.Type -> J.Type
34array t = RefType . ArrayType $ t
36-----------------------------------------------------------------------
37-- Boxed types
39objectType :: J.Type
40objectType =
41 RefType . ClassRefType $ ClassType [(Ident "Object", [])]
43bigIntegerType :: J.Type
44bigIntegerType =
45 RefType . ClassRefType $ ClassType [(Ident "BigInteger", [])]
47stringType :: J.Type
48stringType =
49 RefType . ClassRefType $ ClassType [(Ident "String", [])]
51threadType :: J.Type
52threadType =
53 RefType . ClassRefType $ ClassType [(Ident "Thread", [])]
55callableType :: J.Type
56callableType =
57 RefType . ClassRefType $ ClassType [(Ident "Callable", [])]
59voidType :: J.Type
60voidType =
61 RefType . ClassRefType $ ClassType [(Ident "Void", [])]
63box :: J.Type -> J.Type
64box (PrimType CharT ) = RefType . ClassRefType $ ClassType [(Ident "Character", [])]
65box (PrimType ByteT ) = RefType . ClassRefType $ ClassType [(Ident "Byte", [])]
66box (PrimType ShortT ) = RefType . ClassRefType $ ClassType [(Ident "Short", [])]
67box (PrimType IntT ) = RefType . ClassRefType $ ClassType [(Ident "Integer", [])]
68box (PrimType LongT ) = RefType . ClassRefType $ ClassType [(Ident "Long", [])]
69box (PrimType DoubleT) = RefType . ClassRefType $ ClassType [(Ident "Double", [])]
70box t = t
72isFloating :: J.Type -> Bool
73isFloating (PrimType DoubleT) = True
74isFloating (PrimType FloatT) = True
75isFloating _ = False
77isPrimitive :: J.Type -> Bool
78isPrimitive (PrimType _) = True
79isPrimitive _ = False
81isArray :: J.Type -> Bool
82isArray (RefType (ArrayType _)) = True
83isArray _ = False
85isString :: J.Type -> Bool
86isString (RefType (ClassRefType (ClassType [(Ident "String", _)]))) = True
87isString _ = False
89-----------------------------------------------------------------------
90-- Idris rts classes
92idrisClosureType :: J.Type
93idrisClosureType =
94 RefType . ClassRefType $ ClassType [(Ident "Closure", [])]
96idrisTailCallClosureType :: J.Type
97idrisTailCallClosureType =
98 RefType . ClassRefType $ ClassType [(Ident "TailCallClosure", [])]
100idrisObjectType :: J.Type
101idrisObjectType =
102 RefType . ClassRefType $ ClassType [(Ident "IdrisObject", [])]
104foreignWrapperType :: J.Type
105foreignWrapperType =
106 RefType . ClassRefType $ ClassType [(Ident "ForeignWrapper", [])]
108primFnType :: J.Type
109primFnType =
110 RefType . ClassRefType $ ClassType [(Ident "PrimFn", [])]
112-----------------------------------------------------------------------
113-- Java utility classes
115arraysType :: J.Type
116arraysType =
117 RefType . ClassRefType $ ClassType [(Ident "Arrays", [])]
119mathType :: J.Type
120mathType =
121 RefType . ClassRefType $ ClassType [(Ident "Math", [])]
124-----------------------------------------------------------------------
125-- Exception types
127exceptionType :: J.Type
128exceptionType =
129 RefType . ClassRefType $ ClassType [(Ident "Exception", [])]
131runtimeExceptionType :: J.Type
132runtimeExceptionType =
133 RefType . ClassRefType $ ClassType [(Ident "RuntimeException", [])]
135nativeTyToJType :: NativeTy -> J.Type
136nativeTyToJType IT8 = byteType
137nativeTyToJType IT16 = shortType
138nativeTyToJType IT32 = integerType
139nativeTyToJType IT64 = longType
141intTyToJType :: IntTy -> J.Type
142intTyToJType (ITFixed nt) = nativeTyToJType nt
143intTyToJType (ITNative) = integerType
144intTyToJType (ITBig) = bigIntegerType
145intTyToJType (ITChar) = charType
146intTyToJType (ITVec nt _) = array $ nativeTyToJType nt
148arithTyToJType :: ArithTy -> J.Type
149arithTyToJType (ATInt it) = intTyToJType it
150arithTyToJType (ATFloat) = doubleType
152-----------------------------------------------------------------------
153-- Context variables
155localContextID :: Ident
156localContextID = Ident "context"
158localContext :: Exp
159localContext = ExpName $ Name [localContextID]
161globalContextID :: Ident
162globalContextID = Ident "globalContext"
164globalContext :: Exp
165globalContext = ExpName $ Name [globalContextID]
167newContextID :: Ident
168newContextID = Ident "new_context"
170newContext :: Exp
171newContext = ExpName $ Name [newContextID]
173contextArray :: LVar -> Exp
174contextArray (Loc _) = localContext
175contextArray (Glob _) = globalContext
177contextParam :: FormalParam
178contextParam = FormalParam [Final] (array objectType) False (VarId localContextID)
180-----------------------------------------------------------------------
181-- Constant types
183constType :: Const -> J.Type
184constType (I _) = arithTyToJType (ATInt ITNative)
185constType (BI _) = arithTyToJType (ATInt ITBig )
186constType (Fl _) = arithTyToJType (ATFloat )
187constType (Ch _) = arithTyToJType (ATInt ITChar )
188constType (Str _) = stringType
189constType (B8 _) = arithTyToJType (ATInt $ ITFixed IT8 )
190constType (B16 _) = arithTyToJType (ATInt $ ITFixed IT16)
191constType (B32 _) = arithTyToJType (ATInt $ ITFixed IT32)
192constType (B64 _) = arithTyToJType (ATInt $ ITFixed IT64)
193constType (B8V v) = arithTyToJType (ATInt . ITVec IT8 $ V.length v)
194constType (B16V v) = arithTyToJType (ATInt . ITVec IT16 $ V.length v)
195constType (B32V v) = arithTyToJType (ATInt . ITVec IT32 $ V.length v)
196constType (B64V v) = arithTyToJType (ATInt . ITVec IT64 $ V.length v)
197constType _ = objectType
199-----------------------------------------------------------------------
200-- Foreign types
202foreignType :: FType -> Maybe J.Type
203foreignType (FArith at) = Just $ arithTyToJType at
204foreignType (FFunction ) = Just $ callableType
205foreignType (FFunctionIO ) = Just $ callableType
206foreignType (FString ) = Just $ stringType
207foreignType (FUnit ) = Nothing
208foreignType (FPtr ) = Just $ objectType
209foreignType (FAny ) = Just $ objectType
211-----------------------------------------------------------------------
212-- Primitive operation analysis
214opName :: PrimFn -> String
215opName x
216 | (LSExt _ to) <- x = "LSExt" ++ (suffixFor to)
217 | (LZExt _ to) <- x = "LZExt" ++ (suffixFor to)
218 | (LTrunc _ to) <- x = "LTrunc" ++ (suffixFor to)
219 | (LFloatInt to) <- x = "LFloatInt" ++ (suffixFor to)
220 | (LStrInt to) <- x = "LStrInt" ++ (suffixFor to)
221 | (LChInt to) <- x = "LChInt" ++ (suffixFor to)
222 | otherwise = takeWhile ((/=) ' ') $ show x
223 where
224 suffixFor (ITFixed nt) = show nt
225 suffixFor (ITNative) = show IT32
226 suffixFor (ITBig) = show ITBig
227 suffixFor (ITChar) = show ITChar
228 suffixFor (ITVec nt _) = "ITVec" ++ (show $ nativeTyWidth nt)
230sourceTypes :: PrimFn -> [J.Type]
231sourceTypes (LPlus from) = [arithTyToJType from, arithTyToJType from]
232sourceTypes (LMinus from) = [arithTyToJType from, arithTyToJType from]
233sourceTypes (LTimes from) = [arithTyToJType from, arithTyToJType from]
234sourceTypes (LUDiv from) = [intTyToJType from, intTyToJType from]
235sourceTypes (LSDiv from) = [arithTyToJType from, arithTyToJType from]
236sourceTypes (LURem from) = [intTyToJType from, intTyToJType from]
237sourceTypes (LSRem from) = [arithTyToJType from, arithTyToJType from]
238sourceTypes (LAnd from) = [intTyToJType from, intTyToJType from]
239sourceTypes (LOr from) = [intTyToJType from, intTyToJType from]
240sourceTypes (LXOr from) = [intTyToJType from, intTyToJType from]
241sourceTypes (LCompl from) = [intTyToJType from]
242sourceTypes (LSHL from) = [intTyToJType from, intTyToJType from]
243sourceTypes (LLSHR from) = [intTyToJType from, intTyToJType from]
244sourceTypes (LASHR from) = [intTyToJType from, intTyToJType from]
245sourceTypes (LEq from) = [arithTyToJType from, arithTyToJType from]
246sourceTypes (LSLt from) = [arithTyToJType from, arithTyToJType from]
247sourceTypes (LSLe from) = [arithTyToJType from, arithTyToJType from]
248sourceTypes (LSGt from) = [arithTyToJType from, arithTyToJType from]
249sourceTypes (LSGe from) = [arithTyToJType from, arithTyToJType from]
250sourceTypes (LLt from) = [intTyToJType from, intTyToJType from]
251sourceTypes (LLe from) = [intTyToJType from, intTyToJType from]
252sourceTypes (LGt from) = [intTyToJType from, intTyToJType from]
253sourceTypes (LGe from) = [intTyToJType from, intTyToJType from]
254sourceTypes (LSExt from _) = [intTyToJType from]
255sourceTypes (LZExt from _) = [intTyToJType from]
256sourceTypes (LTrunc from _) = [intTyToJType from]
257sourceTypes (LStrConcat) = repeat stringType
258sourceTypes (LStrLt) = [stringType, stringType]
259sourceTypes (LStrEq) = [stringType, stringType]
260sourceTypes (LStrLen) = [stringType]
261sourceTypes (LIntFloat from) = [intTyToJType from]
262sourceTypes (LFloatInt _) = [doubleType]
263sourceTypes (LIntStr from) = [intTyToJType from]
264sourceTypes (LStrInt from) = [stringType]
265sourceTypes (LFloatStr) = [doubleType]
266sourceTypes (LStrFloat) = [stringType]
267sourceTypes (LChInt _) = [charType]
268sourceTypes (LIntCh from) = [intTyToJType from]
269sourceTypes (LPrintNum) = [objectType]
270sourceTypes (LPrintStr) = [stringType]
271sourceTypes (LReadStr) = [objectType]
272sourceTypes (LFExp) = [doubleType]
273sourceTypes (LFLog) = [doubleType]
274sourceTypes (LFSin) = [doubleType]
275sourceTypes (LFCos) = [doubleType]
276sourceTypes (LFTan) = [doubleType]
277sourceTypes (LFASin) = [doubleType]
278sourceTypes (LFACos) = [doubleType]
279sourceTypes (LFATan) = [doubleType]
280sourceTypes (LFSqrt) = [doubleType]
281sourceTypes (LFFloor) = [doubleType]
282sourceTypes (LFCeil) = [doubleType]
283sourceTypes (LMkVec nt n) = replicate n (nativeTyToJType nt)
284sourceTypes (LIdxVec nt _) = [array $ nativeTyToJType nt, integerType]
285sourceTypes (LUpdateVec nt _) = [array $ nativeTyToJType nt, integerType, nativeTyToJType nt]
286sourceTypes (LStrHead) = [stringType]
287sourceTypes (LStrTail) = [stringType]
288sourceTypes (LStrCons) = [charType, stringType]
289sourceTypes (LStrIndex) = [stringType, integerType]
290sourceTypes (LStrRev) = [stringType]
291sourceTypes (LStdIn) = []
292sourceTypes (LStdOut) = []
293sourceTypes (LStdErr) = []
294sourceTypes (LFork) = [objectType]
295sourceTypes (LPar) = [objectType]
296sourceTypes (LVMPtr) = []
297sourceTypes (LNullPtr) = [objectType]
298sourceTypes (LNoOp) = repeat objectType