Skip to content

Commit

Permalink
wip
Browse files Browse the repository at this point in the history
  • Loading branch information
@ollef
ollef committed Dec 30, 2023
1 parent 6ad14e4 commit 4bd869f
Show file tree
Hide file tree
Showing 6 changed files with 103 additions and 182 deletions.
1 change: 1 addition & 0 deletions builtin/Builtin.vix
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ subInt : Int -> Int -> Int

EmptyRepresentation : Type
WordRepresentation : Type
PointerRepresentation : Type

maxRepresentation : Type -> Type -> Type
addRepresentation : Type -> Type -> Type
Expand Down
69 changes: 31 additions & 38 deletions rts/Sixten.Builtin.ll
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,62 +2,55 @@
declare void @print_int(i64 %i)
declare void @exit(i32)

@Sixten.Builtin.Int = unnamed_addr constant i64 8
@Sixten.Builtin.Type = unnamed_addr constant i64 8
@Sixten.Builtin.Int = unnamed_addr constant i64 u0x0000000800000000
@Sixten.Builtin.Type = unnamed_addr constant i64 u0x0000000800000000
@Sixten.Builtin.EmptyRepresentation = unnamed_addr constant i64 0
@Sixten.Builtin.WordRepresentation = unnamed_addr constant i64 8
@Sixten.Builtin.PointerRepresentation = unnamed_addr constant i64 u0x0000000000000008
@Sixten.Builtin.WordRepresentation = unnamed_addr constant i64 u0x0000000800000000

define external fastcc { ptr, ptr } @Sixten.Builtin.unknown(ptr %shadow_stack, ptr %heap_pointer, ptr %heap_limit, ptr %destination, i64 %a) {
define external fastcc void @Sixten.Builtin.unknown(ptr %destination, i64 %a) {
call void @exit(i32 7411)
unreachable
}

define external fastcc { i64, ptr, ptr } @Sixten.Builtin.addRepresentation(ptr %shadow_stack, ptr %heap_pointer, ptr %heap_limit, i64 %a, i64 %b) {
define external fastcc i64 @Sixten.Builtin.addRepresentation(i64 %a, i64 %b) {
%result = add i64 %a, %b
%result_with_heap_pointer_and_limit1 = insertvalue { i64, ptr, ptr } undef, i64 %result, 0
%result_with_heap_pointer_and_limit2 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit1, ptr %heap_pointer, 1
%result_with_heap_pointer_and_limit3 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit2, ptr %heap_limit, 2
ret { i64, ptr, ptr } %result_with_heap_pointer_and_limit3
ret i64 %result
}

define external fastcc { i64, ptr, ptr } @Sixten.Builtin.maxRepresentation(ptr %shadow_stack, ptr %heap_pointer, ptr %heap_limit, i64 %a, i64 %b) {
%a_lt_b = icmp ult i64 %a, %b
%result = select i1 %a_lt_b, i64 %b, i64 %a
%result_with_heap_pointer_and_limit1 = insertvalue { i64, ptr, ptr } undef, i64 %result, 0
%result_with_heap_pointer_and_limit2 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit1, ptr %heap_pointer, 1
%result_with_heap_pointer_and_limit3 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit2, ptr %heap_limit, 2
ret { i64, ptr, ptr } %result_with_heap_pointer_and_limit3
define external fastcc i64 @Sixten.Builtin.maxRepresentation(i64 %a, i64 %b) {
%a_ptrs = trunc i64 %a to i32
%b_ptrs = trunc i64 %b to i32
%a_non_ptrs64 = lshr i64 %a, 32
%b_non_ptrs64 = lshr i64 %b, 32
%a_non_ptrs = trunc i64 %a_non_ptrs64 to i32
%b_non_ptrs = trunc i64 %b_non_ptrs64 to i32
%a_ptrs_lt_b_ptrs = icmp ult i32 %a_ptrs, %b_ptrs
%result_ptrs = select i1 %a_ptrs_lt_b_ptrs, i32 %b_ptrs, i32 %a_ptrs
%a_non_ptrs_lt_b_non_ptrs = icmp ult i32 %a_non_ptrs, %b_non_ptrs
%result_non_ptrs = select i1 %a_non_ptrs_lt_b_non_ptrs, i32 %b_non_ptrs, i32 %a_non_ptrs
%result_lower = zext i32 %result_ptrs to i64
%result_non_ptrs64 = zext i32 %result_non_ptrs to i64
%result_upper = shl nuw i64 %result_non_ptrs64, 32
%result = or i64 %result_lower, %result_upper
ret i64 %result
}

define external fastcc { ptr, ptr } @Sixten.Builtin.printInt(ptr %shadow_stack, ptr %heap_pointer, ptr %heap_limit, i64 %tagged_i) {
%i = ashr i64 %tagged_i, 1
define external fastcc void @Sixten.Builtin.printInt(i64 %i) {
call void @print_int(i64 %i)
%result_with_heap_pointer_and_limit1 = insertvalue { ptr, ptr } undef, ptr %heap_pointer, 0
%result_with_heap_pointer_and_limit2 = insertvalue { ptr, ptr } %result_with_heap_pointer_and_limit1, ptr %heap_limit, 1
ret { ptr, ptr } %result_with_heap_pointer_and_limit2
}

define external fastcc { i64, ptr, ptr } @Sixten.Builtin.addInt(ptr %shadow_stack, ptr %heap_pointer, ptr %heap_limit, i64 %a, i64 %b) {
define external fastcc i64 @Sixten.Builtin.addInt(i64 %a, i64 %b) {
%result = add i64 %a, %b
%result_with_heap_pointer_and_limit1 = insertvalue { i64, ptr, ptr } undef, i64 %result, 0
%result_with_heap_pointer_and_limit2 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit1, ptr %heap_pointer, 1
%result_with_heap_pointer_and_limit3 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit2, ptr %heap_limit, 2
ret { i64, ptr, ptr } %result_with_heap_pointer_and_limit3
ret i64 %result
}

define external fastcc { i64, ptr, ptr } @Sixten.Builtin.mulInt(ptr %shadow_stack, ptr %heap_pointer, ptr %heap_limit, i64 %a, i64 %b) {
%doubled_result = mul i64 %a, %b
%result = ashr i64 %doubled_result, 1
%result_with_heap_pointer_and_limit1 = insertvalue { i64, ptr, ptr } undef, i64 %result, 0
%result_with_heap_pointer_and_limit2 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit1, ptr %heap_pointer, 1
%result_with_heap_pointer_and_limit3 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit2, ptr %heap_limit, 2
ret { i64, ptr, ptr } %result_with_heap_pointer_and_limit3
define external fastcc i64 @Sixten.Builtin.mulInt(i64 %a, i64 %b) {
%result = mul i64 %a, %b
ret i64 %result
}

define external fastcc { i64, ptr, ptr } @Sixten.Builtin.subInt(ptr %shadow_stack, ptr %heap_pointer, ptr %heap_limit, i64 %a, i64 %b) {
define external fastcc i64 @Sixten.Builtin.subInt(i64 %a, i64 %b) {
%result = sub i64 %a, %b
%result_with_heap_pointer_and_limit1 = insertvalue { i64, ptr, ptr } undef, i64 %result, 0
%result_with_heap_pointer_and_limit2 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit1, ptr %heap_pointer, 1
%result_with_heap_pointer_and_limit3 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit2, ptr %heap_limit, 2
ret { i64, ptr, ptr } %result_with_heap_pointer_and_limit3
ret i64 %result
}
4 changes: 4 additions & 0 deletions src/Builtin.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -99,6 +99,10 @@ pattern WordRepresentationName :: Name.Qualified
pattern WordRepresentationName =
"Sixten.Builtin.WordRepresentation"

pattern PointerRepresentationName :: Name.Qualified
pattern PointerRepresentationName =
"Sixten.Builtin.PointerRepresentation"

pattern AddRepresentationName :: Name.Qualified
pattern AddRepresentationName =
"Sixten.Builtin.addRepresentation"
Expand Down
39 changes: 19 additions & 20 deletions src/ClosureConverted/Representation.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -60,10 +60,10 @@ signature def =
returnRepresentation <- typeRepresentation env' type_
pure $ Representation.FunctionSignature parameterRepresentations returnRepresentation
Syntax.DataDefinition {} ->
pure $ Representation.ConstantSignature $ Representation.Direct Representation.Doesn'tContainHeapPointers
pure $ Representation.ConstantSignature Representation.Direct
Syntax.ParameterisedDataDefinition _boxity tele ->
telescopeSignature context tele mempty \_ _ parameterRepresentations -> do
pure $ Representation.FunctionSignature parameterRepresentations $ Representation.Direct Representation.Doesn'tContainHeapPointers
telescopeSignature context tele mempty \_ _ parameterRepresentations ->
pure $ Representation.FunctionSignature parameterRepresentations Representation.Direct
where
context =
Context.empty
Expand Down Expand Up @@ -95,38 +95,38 @@ typeRepresentation :: Environment v -> Domain.Type -> M Representation
typeRepresentation env type_ =
case type_ of
Domain.Neutral (Domain.Var _) _ ->
pure $ Representation.Indirect Representation.MightContainHeapPointers
pure Representation.Indirect
-- TODO: Handle these special cases in a nicer way
Domain.Neutral (Domain.Global (Name.Lifted Builtin.TypeName 0)) Tsil.Empty ->
pure $ Representation.Direct Representation.Doesn'tContainHeapPointers
pure Representation.Direct
Domain.Neutral (Domain.Global (Name.Lifted Builtin.IntName 0)) Tsil.Empty ->
pure $ Representation.Direct Representation.Doesn'tContainHeapPointers
pure Representation.Direct
Domain.Neutral (Domain.Global global) (Domain.groupSpine -> [Domain.GroupedApps args]) -> do
globalCase global args
Domain.Neutral (Domain.Global global) (Domain.groupSpine -> []) -> do
globalCase global []
Domain.Neutral {} ->
pure $ Representation.Indirect Representation.MightContainHeapPointers
pure Representation.Indirect
Domain.Con {} ->
pure $ Representation.Indirect Representation.MightContainHeapPointers
pure Representation.Indirect
Domain.Lit {} ->
pure $ Representation.Indirect Representation.MightContainHeapPointers
pure Representation.Indirect
Domain.Glued _ _ type' ->
typeRepresentation env type'
Domain.Lazy lazyType -> do
type' <- force lazyType
typeRepresentation env type'
Domain.Pi {} ->
pure $ Representation.Direct Representation.MightContainHeapPointers
pure Representation.Direct
Domain.Function {} ->
pure $ Representation.Direct Representation.Doesn'tContainHeapPointers
pure Representation.Direct
where
globalCase global@(Name.Lifted qualifiedName liftedNameNumber) args = do
-- TODO caching
definition <- fetch $ Query.ClosureConverted global
case definition of
Syntax.TypeDeclaration _ ->
pure $ Representation.Indirect Representation.MightContainHeapPointers
pure Representation.Indirect
Syntax.ConstantDefinition term -> do
value <- Evaluation.evaluate Environment.empty term
type' <- Evaluation.apply env value args
Expand All @@ -135,20 +135,20 @@ typeRepresentation env type_ =
maybeType' <- Evaluation.applyFunction env (Telescope.fromVoid tele) args
case maybeType' of
Nothing ->
pure $ Representation.Direct Representation.MightContainHeapPointers -- a closure
pure Representation.Direct
Just type' ->
typeRepresentation env type'
Syntax.DataDefinition Boxed _ ->
pure $ Representation.Direct Representation.MightContainHeapPointers
pure Representation.Direct
Syntax.DataDefinition Unboxed constructors -> do
unless (liftedNameNumber == 0) $ panic "ClosureConverted.Representation. Data with name number /= 0"
unboxedDataRepresentation qualifiedName Environment.empty constructors
Syntax.ParameterisedDataDefinition Boxed _ ->
pure $ Representation.Direct Representation.MightContainHeapPointers
pure Representation.Direct
Syntax.ParameterisedDataDefinition Unboxed tele -> do
unless (liftedNameNumber == 0) $ panic "ClosureConverted.Representation. Data with name number /= 0"
maybeResult <- Evaluation.applyTelescope env (Telescope.fromVoid tele) args $ unboxedDataRepresentation qualifiedName
pure $ fromMaybe (Representation.Indirect Representation.MightContainHeapPointers) maybeResult
pure $ fromMaybe Representation.Indirect maybeResult

unboxedDataRepresentation :: Name.Qualified -> Environment v -> Syntax.ConstructorDefinitions v -> M Representation
unboxedDataRepresentation dataTypeName env (Syntax.ConstructorDefinitions constructors) = do
Expand All @@ -164,8 +164,7 @@ unboxedDataRepresentation dataTypeName env (Syntax.ConstructorDefinitions constr
Nothing -> fieldRepresentation
Just _ -> constructorTagRepresentation <> fieldRepresentation
where
constructorTagRepresentation =
Representation.Direct Representation.Doesn'tContainHeapPointers
constructorTagRepresentation = Representation.Direct

constructorFieldRepresentation :: Environment v -> Domain.Type -> Representation -> M Representation
constructorFieldRepresentation env type_ accumulatedRepresentation = do
Expand All @@ -174,7 +173,7 @@ constructorFieldRepresentation env type_ accumulatedRepresentation = do
Domain.Pi _ fieldType closure -> do
fieldRepresentation <- typeRepresentation env fieldType
case accumulatedRepresentation <> fieldRepresentation of
representation@(Representation.Indirect Representation.MightContainHeapPointers) ->
representation@Representation.Indirect ->
pure representation
accumulatedRepresentation' -> do
(context', var) <- Environment.extend env
Expand All @@ -199,7 +198,7 @@ compileData env dataTypeName (Syntax.ConstructorDefinitions constructors) = do
(boxity, maybeTags) <- fetch $ Query.ConstructorRepresentations dataTypeName
case boxity of
Boxed ->
pure $ Syntax.Global (Name.Lifted Builtin.WordRepresentationName 0)
pure $ Syntax.Global (Name.Lifted Builtin.PointerRepresentationName 0)
Unboxed -> do
compiledConstructorFields <- forM (OrderedHashMap.toList constructors) \(_, type_) -> do
type' <- Evaluation.evaluate env type_
Expand Down
Loading

0 comments on commit 4bd869f

Please sign in to comment.