git.iko.soy/Idris-dev
on abc2002 help sign in
Idris-dev/src/IRTS/Java/ASTBuilding.hs
141 lines 3.4 kB history raw
1module IRTS.Java.ASTBuilding where
3import IRTS.Java.JTypes
5import Language.Java.Syntax hiding (Name)
6import qualified Language.Java.Syntax as J
8toClassType :: J.Type -> ClassType
9toClassType (RefType (ClassRefType ct)) = ct
10toClassType t = error $ "Not a class type: " ++ (show t)
12toRefType :: J.Type -> RefType
13toRefType (RefType rt) = rt
14toRefType t = error $ "Not a ref type: " ++ (show t)
16class InvocationTarget a where
17 (~>) :: a -> String -> [Argument] -> Exp
19instance InvocationTarget ClassType where
20 (~>) (ClassType ts) method args =
21 MethodInv $ TypeMethodCall
22 (J.Name $ map fst ts)
23 (concatMap (map fromActType . snd) ts)
24 (Ident method)
25 args
26 where
27 fromActType (ActualType refType) = refType
29instance InvocationTarget Exp where
30 (~>) exp method args =
31 MethodInv $ PrimaryMethodCall
32 exp
33 []
34 (Ident method)
35 args
37instance InvocationTarget J.Type where
38 (~>) t method args = ((toClassType t) ~> method) args
40class Callable a where
41 call :: a -> [Argument] -> Exp
43instance Callable String where
44 call method args =
45 MethodInv $ MethodCall (J.Name [Ident method]) args
47instance Callable Ident where
48 call method args =
49 MethodInv $ MethodCall (J.Name [method]) args
51instance Callable J.Name where
52 call method args =
53 MethodInv $ MethodCall method args
55(<>) :: Type -> Exp -> Exp
56(<>) = Cast
58localVar :: Int -> Ident
59localVar i = Ident $ "loc" ++ show i
61(@!) :: Exp -> Int -> ArrayIndex
62(@!) target pos =
63 ArrayIndex target [Lit $ Int (toInteger pos)]
65(@:=) :: Either ArrayIndex Ident -> Exp -> BlockStmt
66(@:=) (Right lhs) rhs =
67 LocalVars [Final] objectType [VarDecl (VarId lhs) (Just $ InitExp rhs)]
68(@:=) (Left lhs) rhs =
69 BlockStmt . ExpStmt $ Assign (ArrayLhs lhs) EqualA rhs
71(~&&~) :: Exp -> Exp -> Exp
72(~&&~) e1 e2 = BinOp e1 CAnd e2
74(~==~) :: Exp -> Exp -> Exp
75(~==~) e1 e2 = BinOp e1 Equal e2
77addToBlock :: [BlockStmt] -> Exp -> [BlockStmt]
78addToBlock blk exp = blk ++ [BlockStmt $ ExpStmt exp]
80jName :: String -> J.Name
81jName n = J.Name [Ident n]
83jConst :: String -> Exp
84jConst = ExpName . jName
86jReturn :: Exp -> BlockStmt
87jReturn = BlockStmt . Return . Just
89jInt :: Int -> Exp
90jInt = Lit . Int . toInteger
92jString :: String -> Exp
93jString = Lit . String
95simpleMethod :: [Modifier] -> Maybe J.Type -> String -> [FormalParam] -> Block -> Decl
96simpleMethod mods t name params body =
97 MemberDecl $ MethodDecl
98 mods
99 []
100 t
101 (Ident $ name)
102 params
103 []
104 (MethodBody . Just $ body)
106declareFinalObjectArray :: Ident -> Maybe VarInit -> BlockStmt
107declareFinalObjectArray name init =
108 LocalVars [Final]
109 (array objectType)
110 [ VarDecl
111 (VarDeclArray . VarId $ name)
112 init
113 ]
115arrayInitExps :: [Exp] -> VarInit
116arrayInitExps = InitArray . ArrayInit . map (InitExp)
118extendWithNull :: [Exp] -> Int -> [Exp]
119extendWithNull exps additionalZeros =
120 exps ++ (replicate additionalZeros (Lit $ Null))
122closure :: Exp -> Exp
123closure body =
124 InstanceCreation
125 []
126 (toClassType idrisClosureType)
127 []
128 (Just $ ClassBody
129 [ simpleMethod
130 [Public, Final] (Just objectType) "call" []
131 (Block [jReturn body])
132 ]
133 )
135bigInteger :: String -> Exp
136bigInteger s =
137 InstanceCreation
138 []
139 (toClassType bigIntegerType)
140 [Lit $ String s]
141 Nothing