add: inject default constructor

This commit is contained in:
Christian Brier 2024-05-15 11:45:41 +02:00
parent 207fb5c5f3
commit e572975bda

View File

@ -94,6 +94,11 @@ methodDescriptor (MethodDeclaration returntype _ parameters _) = let
++ ")" ++ ")"
++ methodParameterDescriptor returntype ++ methodParameterDescriptor returntype
injectDefaultConstructor :: [MethodDeclaration] -> [MethodDeclaration]
injectDefaultConstructor pre
| any (\(MethodDeclaration _ name _ _) -> name == "<init>") pre = pre
| otherwise = pre ++ [MethodDeclaration "void" "<init>" [] (TypedStatement "void" (Block []))]
classBuilder :: ClassFileBuilder Class classBuilder :: ClassFileBuilder Class
classBuilder (Class name methods fields) _ = let classBuilder (Class name methods fields) _ = let
@ -117,9 +122,11 @@ classBuilder (Class name methods fields) _ = let
attributes = [] attributes = []
} }
methodsWithInjectedConstructor = injectDefaultConstructor methods
classFileWithFields = foldr fieldBuilder nakedClassFile fields classFileWithFields = foldr fieldBuilder nakedClassFile fields
classFileWithMethods = foldr methodBuilder classFileWithFields methods classFileWithMethods = foldr methodBuilder classFileWithFields methodsWithInjectedConstructor
classFileWithAssembledMethods = foldr methodAssembler classFileWithMethods methods classFileWithAssembledMethods = foldr methodAssembler classFileWithMethods methodsWithInjectedConstructor
in in
classFileWithAssembledMethods classFileWithAssembledMethods
@ -232,7 +239,7 @@ assembleMethod (constants, ops, lvars) (MethodDeclaration _ name _ (TypedStateme
init_ops = [Opaload 0] init_ops = [Opaload 0]
in in
(constants_a, init_ops ++ ops_a, lvars_a) (constants_a, init_ops ++ ops_a, lvars_a)
assembleMethod _ (MethodDeclaration _ _ _ stmt) = error ("Block expected for method body, got: " ++ show stmt) assembleMethod _ (MethodDeclaration _ _ _ stmt) = error ("Block expected for method body, got: " ++ show stmt)
assembleStatement :: Assembler Statement assembleStatement :: Assembler Statement
assembleStatement (constants, ops, lvars) (TypedStatement stype (Return expr)) = case expr of assembleStatement (constants, ops, lvars) (TypedStatement stype (Return expr)) = case expr of