6b69f14 · Idris-dev · git.iko.soy

47ierror :: String -> a

48ierror msg = error $ "INTERNAL ERROR: IRTS.CodegenLLVM: " ++ msg

49

50−codegen :: String -> [SDecl] -> Module

50+mainDef :: Global

51−codegen tgt defs =

51+mainDef =

52− Module "idris" Nothing Nothing

52+ functionDefaults

53+ { G.returnType = IntegerType 32

54+ , G.parameters =

55+ ([ Parameter (IntegerType 32) (Name "argc") []

56+ , Parameter (PointerType (PointerType (IntegerType 8) (AddrSpace 0)) (AddrSpace 0)) (Name "argv") []

57+ ], False)

58+ , G.name = Name "main"

59+ , G.basicBlocks =

60+ [ BasicBlock (UnName 0)

61+ [ UnName 1 := idrCall "{runMain0}" [] ]

62+ (Do $ Ret (Just (ConstantOperand (C.Int 32 0))) [])

63+ ]}

64+

65+initDefs :: String -> [Definition]

66+initDefs tgt =

53− ([ TypeDefinition (Name "valTy") (

67+ [ TypeDefinition (Name "valTy")

54− Just $ StructureType False

68+ (Just $ StructureType False

55− [ IntegerType 32

69+ [ IntegerType 32

56− , ArrayType 0 (PointerType valueType (AddrSpace 0))

70+ , ArrayType 0 (PointerType valueType (AddrSpace 0))

57− ])

71+ ])

58− , TypeDefinition (Name "mpz") (

72+ , TypeDefinition (Name "mpz")

59− Just $ StructureType False

73+ (Just $ StructureType False

60− [ IntegerType 32

74+ [ IntegerType 32

61− , IntegerType 32

75+ , IntegerType 32

62− , PointerType intPtr (AddrSpace 0)

76+ , PointerType intPtr (AddrSpace 0)

63− ])

77+ ])

64− , GlobalDefinition $ globalVariableDefaults

78+ , GlobalDefinition $ globalVariableDefaults

65− { G.name = Name "__idris_intFmtStr"

79+ { G.name = Name "__idris_intFmtStr"

66− , G.linkage = L.Internal

80+ , G.linkage = L.Internal

67− , G.isConstant = True

81+ , G.isConstant = True

68− , G.hasUnnamedAddr = True

82+ , G.hasUnnamedAddr = True

69− , G.type' = ArrayType 5 (IntegerType 8)

83+ , G.type' = ArrayType 5 (IntegerType 8)

70− , G.initializer = Just $ C.Array (IntegerType 8) (map (C.Int 8 . fromIntegral . fromEnum) "%lld" ++ [C.Int 8 0])

84+ , G.initializer = Just $ C.Array (IntegerType 8) (map (C.Int 8 . fromIntegral . fromEnum) "%lld" ++ [C.Int 8 0])

71− }

85+ }

72− , rtsFun "intStr" ptrI8 [IntegerType 64]

86+ , rtsFun "intStr" ptrI8 [IntegerType 64]

73− [ BasicBlock (UnName 0)

87+ [ BasicBlock (UnName 0)

74− [ UnName 1 := simpleCall "GC_malloc_atomic"

75− [ConstantOperand (C.Int (fromInteger $ tgtWordSize tgt) 12)]

88+ [ UnName 1 := simpleCall "GC_malloc_atomic" [ConstantOperand (C.Int (fromInteger $ tgtWordSize tgt) 12)]

76− , UnName 2 := simpleCall "snprintf"

89+ , UnName 2 := simpleCall "snprintf"

77− [ LocalReference (UnName 1)

90+ [ LocalReference (UnName 1)

78− , ConstantOperand (C.Int (fromInteger $ tgtWordSize tgt) 12)

91+ , ConstantOperand (C.Int (fromInteger $ tgtWordSize tgt) 12)

79− , ConstantOperand $ C.GetElementPtr True (C.GlobalReference . Name $ "__idris_intFmtStr") [C.Int 32 0, C.Int 32 0]

92+ , ConstantOperand $ C.GetElementPtr True (C.GlobalReference . Name $ "__idris_intFmtStr") [C.Int 32 0, C.Int 32 0]

80− , LocalReference (UnName 0)

93+ , LocalReference (UnName 0)

81− ]

94+ ]

82− ]

95+ ]

83− (Do $ Ret (Just (LocalReference (UnName 1))) [])

96+ (Do $ Ret (Just (LocalReference (UnName 1))) [])

84− ]

97+ ]

85− , exfun "llvm.trap" VoidType [] False

98+ , exfun "llvm.trap" VoidType [] False

86− , exfun "snprintf" (IntegerType 32) [ptrI8, intPtr, ptrI8] True

99+ , exfun "snprintf" (IntegerType 32) [ptrI8, intPtr, ptrI8] True

87− , exfun "strcmp" (IntegerType 32) [ptrI8, ptrI8] False

100+ , exfun "strcmp" (IntegerType 32) [ptrI8, ptrI8] False

88− , exfun "strlen" intPtr [ptrI8] False

101+ , exfun "strlen" intPtr [ptrI8] False

89− , exfun "memcpy" ptrI8 [ptrI8, ptrI8, intPtr] False

102+ , exfun "memcpy" ptrI8 [ptrI8, ptrI8, intPtr] False

90− , exfun "GC_malloc" ptrI8 [intPtr] False

103+ , exfun "GC_malloc" ptrI8 [intPtr] False

91− , exfun "GC_malloc_atomic" ptrI8 [intPtr] False

104+ , exfun "GC_malloc_atomic" ptrI8 [intPtr] False

92− , exfun "__gmpz_init" VoidType [pmpz] False

105+ , exfun "__gmpz_init" VoidType [pmpz] False

93− ]

106+ , GlobalDefinition mainDef

94− ++ map mpzBinFun ["add", "sub", "mul", "fdiv_q", "fdiv_r", "and", "ior", "xor"]

107+ ] ++ map mpzBinFun ["add", "sub", "mul", "fdiv_q", "fdiv_r", "and", "ior", "xor"]

95− ++ globals

96− ++ gendefs)

97 where

108 where

98− ((gendefs, globals), _) = (runState . runWriterT) (mapM cgDef defs) 0

99 intPtr = IntegerType (fromInteger $ tgtWordSize tgt)

109 intPtr = IntegerType (fromInteger $ tgtWordSize tgt)

100 ptrI8 = PointerType (IntegerType 8) (AddrSpace 0)

110 ptrI8 = PointerType (IntegerType 8) (AddrSpace 0)

101 pmpz = PointerType mpzTy (AddrSpace 0)

111 pmpz = PointerType mpzTy (AddrSpace 0)

120 , G.parameters = (flip map argtys $ \ty -> Parameter ty (UnName 0) [], vari)

130 , G.parameters = (flip map argtys $ \ty -> Parameter ty (UnName 0) [], vari)

121 }

131 }

122

132

133+codegen :: String -> [SDecl] -> Module

134+codegen tgt defs = Module "idris" Nothing Nothing (initDefs tgt ++ globals ++ gendefs)

135+ where

136+ ((gendefs, globals), _) = (runState . runWriterT) (mapM cgDef defs) 0

137+

123valueType :: Type

138valueType :: Type

124valueType = NamedTypeReference (Name "valTy")

139valueType = NamedTypeReference (Name "valTy")

125

140

716 x'' <- if ity == ITNative || intTyWidth ity < 64

731 x'' <- if ity == ITNative || intTyWidth ity < 64

717 then inst $ SExt x' (IntegerType 64) []

732 then inst $ SExt x' (IntegerType 64) []

718 else return x'

733 else return x'

719− box FString =<< inst (rtsCall "intStr" [x''])

734+ box FString =<< inst (idrCall "__idris_intStr" [x''])

720

735

721cgOp LStrConcat [x,y] = cgStrCat x y

736cgOp LStrConcat [x,y] = cgStrCat x y

722cgOp prim args = ierror $ "Unimplemented primitive: [" ++ show prim ++ "]("

737cgOp prim args = ierror $ "Unimplemented primitive: [" ++ show prim ++ "]("

771 , metadata = []

786 , metadata = []

772 }

787 }

773

788

774−rtsCall :: String -> [Operand] -> Instruction

789+idrCall :: String -> [Operand] -> Instruction

775−rtsCall name args =

790+idrCall name args =

776 Call { isTailCall = False

791 Call { isTailCall = False

777 , callingConvention = CC.Fast

792 , callingConvention = CC.Fast

778 , returnAttributes = []

793 , returnAttributes = []

779− , function = Right . ConstantOperand . C.GlobalReference . Name $ "__idris_" ++ name

794+ , function = Right . ConstantOperand . C.GlobalReference . Name $ name

780 , arguments = map (\x -> (x, [])) args

795 , arguments = map (\x -> (x, [])) args

781 , functionAttributes = []

796 , functionAttributes = []

782 , metadata = []

797 , metadata = []