git.iko.soy/Idris-dev
on abc2002 help sign in
Idris-dev/src/IRTS/Java/JTypes.hs
331 lines 12 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
36addressType :: J.Type
37addressType = longType
39-----------------------------------------------------------------------
40-- Boxed types
42objectType :: J.Type
43objectType =
44 RefType . ClassRefType $ ClassType [(Ident "Object", [])]
46bigIntegerType :: J.Type
47bigIntegerType =
48 RefType . ClassRefType $ ClassType [(Ident "BigInteger", [])]
50stringType :: J.Type
51stringType =
52 RefType . ClassRefType $ ClassType [(Ident "String", [])]
54bufferType :: J.Type
55bufferType =
56 RefType . ClassRefType $ ClassType [(Ident "ByteBuffer", [])]
58threadType :: J.Type
59threadType =
60 RefType . ClassRefType $ ClassType [(Ident "Thread", [])]
62callableType :: J.Type
63callableType =
64 RefType . ClassRefType $ ClassType [(Ident "Callable", [])]
66voidType :: J.Type
67voidType =
68 RefType . ClassRefType $ ClassType [(Ident "Void", [])]
70box :: J.Type -> J.Type
71box (PrimType CharT ) = RefType . ClassRefType $ ClassType [(Ident "Character", [])]
72box (PrimType ByteT ) = RefType . ClassRefType $ ClassType [(Ident "Byte", [])]
73box (PrimType ShortT ) = RefType . ClassRefType $ ClassType [(Ident "Short", [])]
74box (PrimType IntT ) = RefType . ClassRefType $ ClassType [(Ident "Integer", [])]
75box (PrimType LongT ) = RefType . ClassRefType $ ClassType [(Ident "Long", [])]
76box (PrimType DoubleT) = RefType . ClassRefType $ ClassType [(Ident "Double", [])]
77box t = t
79isFloating :: J.Type -> Bool
80isFloating (PrimType DoubleT) = True
81isFloating (PrimType FloatT) = True
82isFloating _ = False
84isPrimitive :: J.Type -> Bool
85isPrimitive (PrimType _) = True
86isPrimitive _ = False
88isArray :: J.Type -> Bool
89isArray (RefType (ArrayType _)) = True
90isArray _ = False
92isString :: J.Type -> Bool
93isString (RefType (ClassRefType (ClassType [(Ident "String", _)]))) = True
94isString _ = False
96-----------------------------------------------------------------------
97-- Idris rts classes
99idrisClosureType :: J.Type
100idrisClosureType =
101 RefType . ClassRefType $ ClassType [(Ident "Closure", [])]
103idrisTailCallClosureType :: J.Type
104idrisTailCallClosureType =
105 RefType . ClassRefType $ ClassType [(Ident "TailCallClosure", [])]
107idrisObjectType :: J.Type
108idrisObjectType =
109 RefType . ClassRefType $ ClassType [(Ident "IdrisObject", [])]
111foreignWrapperType :: J.Type
112foreignWrapperType =
113 RefType . ClassRefType $ ClassType [(Ident "ForeignWrapper", [])]
115primFnType :: J.Type
116primFnType =
117 RefType . ClassRefType $ ClassType [(Ident "PrimFn", [])]
119-----------------------------------------------------------------------
120-- Java utility classes
122arraysType :: J.Type
123arraysType =
124 RefType . ClassRefType $ ClassType [(Ident "Arrays", [])]
126mathType :: J.Type
127mathType =
128 RefType . ClassRefType $ ClassType [(Ident "Math", [])]
131-----------------------------------------------------------------------
132-- Exception types
134exceptionType :: J.Type
135exceptionType =
136 RefType . ClassRefType $ ClassType [(Ident "Exception", [])]
138runtimeExceptionType :: J.Type
139runtimeExceptionType =
140 RefType . ClassRefType $ ClassType [(Ident "RuntimeException", [])]
142-----------------------------------------------------------------------
143-- Integer types
145nativeTyToJType :: NativeTy -> J.Type
146nativeTyToJType IT8 = byteType
147nativeTyToJType IT16 = shortType
148nativeTyToJType IT32 = integerType
149nativeTyToJType IT64 = longType
151intTyToJType :: IntTy -> J.Type
152intTyToJType (ITFixed nt) = nativeTyToJType nt
153intTyToJType (ITNative) = integerType
154intTyToJType (ITBig) = bigIntegerType
155intTyToJType (ITChar) = charType
156intTyToJType (ITVec nt _) = array $ nativeTyToJType nt
158arithTyToJType :: ArithTy -> J.Type
159arithTyToJType (ATInt it) = intTyToJType it
160arithTyToJType (ATFloat) = doubleType
162-----------------------------------------------------------------------
163-- Context variables
165localContextID :: Ident
166localContextID = Ident "context"
168localContext :: Exp
169localContext = ExpName $ Name [localContextID]
171globalContextID :: Ident
172globalContextID = Ident "globalContext"
174globalContext :: Exp
175globalContext = ExpName $ Name [globalContextID]
177newContextID :: Ident
178newContextID = Ident "new_context"
180newContext :: Exp
181newContext = ExpName $ Name [newContextID]
183contextArray :: LVar -> Exp
184contextArray (Loc _) = localContext
185contextArray (Glob _) = globalContext
187contextParam :: FormalParam
188contextParam = FormalParam [Final] (array objectType) False (VarId localContextID)
190-----------------------------------------------------------------------
191-- Constant types
193constType :: Const -> J.Type
194constType (I _) = arithTyToJType (ATInt ITNative)
195constType (BI _) = arithTyToJType (ATInt ITBig )
196constType (Fl _) = arithTyToJType (ATFloat )
197constType (Ch _) = arithTyToJType (ATInt ITChar )
198constType (Str _) = stringType
199constType (B8 _) = arithTyToJType (ATInt $ ITFixed IT8 )
200constType (B16 _) = arithTyToJType (ATInt $ ITFixed IT16)
201constType (B32 _) = arithTyToJType (ATInt $ ITFixed IT32)
202constType (B64 _) = arithTyToJType (ATInt $ ITFixed IT64)
203constType (B8V v) = arithTyToJType (ATInt . ITVec IT8 $ V.length v)
204constType (B16V v) = arithTyToJType (ATInt . ITVec IT16 $ V.length v)
205constType (B32V v) = arithTyToJType (ATInt . ITVec IT32 $ V.length v)
206constType (B64V v) = arithTyToJType (ATInt . ITVec IT64 $ V.length v)
207constType _ = objectType
209-----------------------------------------------------------------------
210-- Foreign types
212foreignType :: FType -> Maybe J.Type
213foreignType (FArith at) = Just $ arithTyToJType at
214foreignType (FFunction ) = Just $ callableType
215foreignType (FFunctionIO ) = Just $ callableType
216foreignType (FString ) = Just $ stringType
217foreignType (FUnit ) = Nothing
218foreignType (FPtr ) = Just $ objectType
219foreignType (FAny ) = Just $ objectType
221-----------------------------------------------------------------------
222-- Primitive operation analysis
224opName :: PrimFn -> String
225opName x
226 | (LSExt _ to) <- x = "LSExt" ++ (suffixFor to)
227 | (LZExt _ to) <- x = "LZExt" ++ (suffixFor to)
228 | (LTrunc _ to) <- x = "LTrunc" ++ (suffixFor to)
229 | (LFloatInt to) <- x = "LFloatInt" ++ (suffixFor to)
230 | (LStrInt to) <- x = "LStrInt" ++ (suffixFor to)
231 | (LChInt to) <- x = "LChInt" ++ (suffixFor to)
232 | (LPeek to _) <- x = "LPeek" ++ (suffixFor to)
233 | otherwise = takeWhile ((/=) ' ') $ show x
234 where
235 suffixFor (ITFixed nt) = show nt
236 suffixFor (ITNative) = show IT32
237 suffixFor (ITBig) = show ITBig
238 suffixFor (ITChar) = show ITChar
239 suffixFor (ITVec nt _) = "ITVec" ++ (show $ nativeTyWidth nt)
241sourceTypes :: PrimFn -> [J.Type]
242sourceTypes (LPlus from) = [arithTyToJType from, arithTyToJType from]
243sourceTypes (LMinus from) = [arithTyToJType from, arithTyToJType from]
244sourceTypes (LTimes from) = [arithTyToJType from, arithTyToJType from]
245sourceTypes (LUDiv from) = [intTyToJType from, intTyToJType from]
246sourceTypes (LSDiv from) = [arithTyToJType from, arithTyToJType from]
247sourceTypes (LURem from) = [intTyToJType from, intTyToJType from]
248sourceTypes (LSRem from) = [arithTyToJType from, arithTyToJType from]
249sourceTypes (LAnd from) = [intTyToJType from, intTyToJType from]
250sourceTypes (LOr from) = [intTyToJType from, intTyToJType from]
251sourceTypes (LXOr from) = [intTyToJType from, intTyToJType from]
252sourceTypes (LCompl from) = [intTyToJType from]
253sourceTypes (LSHL from) = [intTyToJType from, intTyToJType from]
254sourceTypes (LLSHR from) = [intTyToJType from, intTyToJType from]
255sourceTypes (LASHR from) = [intTyToJType from, intTyToJType from]
256sourceTypes (LEq from) = [arithTyToJType from, arithTyToJType from]
257sourceTypes (LSLt from) = [arithTyToJType from, arithTyToJType from]
258sourceTypes (LSLe from) = [arithTyToJType from, arithTyToJType from]
259sourceTypes (LSGt from) = [arithTyToJType from, arithTyToJType from]
260sourceTypes (LSGe from) = [arithTyToJType from, arithTyToJType from]
261sourceTypes (LLt from) = [intTyToJType from, intTyToJType from]
262sourceTypes (LLe from) = [intTyToJType from, intTyToJType from]
263sourceTypes (LGt from) = [intTyToJType from, intTyToJType from]
264sourceTypes (LGe from) = [intTyToJType from, intTyToJType from]
265sourceTypes (LSExt from _) = [intTyToJType from]
266sourceTypes (LZExt from _) = [intTyToJType from]
267sourceTypes (LTrunc from _) = [intTyToJType from]
268sourceTypes (LStrConcat) = repeat stringType
269sourceTypes (LStrLt) = [stringType, stringType]
270sourceTypes (LStrEq) = [stringType, stringType]
271sourceTypes (LStrLen) = [stringType]
272sourceTypes (LIntFloat from) = [intTyToJType from]
273sourceTypes (LFloatInt _) = [doubleType]
274sourceTypes (LIntStr from) = [intTyToJType from]
275sourceTypes (LStrInt from) = [stringType]
276sourceTypes (LFloatStr) = [doubleType]
277sourceTypes (LStrFloat) = [stringType]
278sourceTypes (LChInt _) = [charType]
279sourceTypes (LIntCh from) = [intTyToJType from]
280sourceTypes (LPrintNum) = [objectType]
281sourceTypes (LPrintStr) = [stringType]
282sourceTypes (LReadStr) = [objectType]
283sourceTypes (LFExp) = [doubleType]
284sourceTypes (LFLog) = [doubleType]
285sourceTypes (LFSin) = [doubleType]
286sourceTypes (LFCos) = [doubleType]
287sourceTypes (LFTan) = [doubleType]
288sourceTypes (LFASin) = [doubleType]
289sourceTypes (LFACos) = [doubleType]
290sourceTypes (LFATan) = [doubleType]
291sourceTypes (LFSqrt) = [doubleType]
292sourceTypes (LFFloor) = [doubleType]
293sourceTypes (LFCeil) = [doubleType]
294sourceTypes (LMkVec nt n) = replicate n (nativeTyToJType nt)
295sourceTypes (LIdxVec nt _) = [array $ nativeTyToJType nt, integerType]
296sourceTypes (LUpdateVec nt _) = [array $ nativeTyToJType nt, integerType, nativeTyToJType nt]
297sourceTypes (LStrHead) = [stringType]
298sourceTypes (LStrTail) = [stringType]
299sourceTypes (LStrCons) = [charType, stringType]
300sourceTypes (LStrIndex) = [stringType, integerType]
301sourceTypes (LStrRev) = [stringType]
302sourceTypes (LStdIn) = []
303sourceTypes (LStdOut) = []
304sourceTypes (LStdErr) = []
305sourceTypes (LAllocate) = [addressType]
306sourceTypes (LAppendBuffer) =
307 [bufferType, addressType, addressType, addressType, addressType, bufferType]
308sourceTypes (LSystemInfo) = [integerType]
309sourceTypes (LAppend nt _) = [bufferType, addressType, addressType, intTyToJType nt]
310sourceTypes (LPeek _ _) = [bufferType, addressType]
311sourceTypes (LFork) = [objectType]
312sourceTypes (LPar) = [objectType]
313sourceTypes (LVMPtr) = []
314sourceTypes (LNullPtr) = [objectType]
315sourceTypes (LNoOp) = repeat objectType
317-----------------------------------------------------------------------
318-- Endianess markers
320endiannessConstant :: Endianness -> Exp
321endiannessConstant c =
322 ExpName . Name . map Ident $ ["java", "nio", "ByteOrder", endiannessConstant' c]
323 where
324 endiannessConstant' BE = "BIG_ENDIAN"
325 endiannessConstant' LE = "LITTLE_ENDIAN"
326 endiannessConstant' (IRTS.Lang.Native) = endiannessConstant' BE
328endiannessArguments :: PrimFn -> [Exp]
329endiannessArguments (LAppend _ end) = [endiannessConstant end]
330endiannessArguments (LPeek _ end) = [endiannessConstant end]
331endiannessArguments _ = []