Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Is Template Haskell Rel8able deriving worth having? #136

Open
ocharles opened this issue Oct 30, 2021 · 1 comment
Open

Is Template Haskell Rel8able deriving worth having? #136

ocharles opened this issue Oct 30, 2021 · 1 comment

Comments

@ocharles
Copy link
Contributor

Currently we derive Rel8able by piggy-backing off a Generic instance. This is fine, but I wonder if we should also have a deriveRel8able Template Haskell function. My theory: overall faster compilation due to not needing a Generic instance at all, and possibly a more efficient implementation.

@ocharles
Copy link
Contributor Author

ocharles commented Oct 30, 2021

There may be something here. If we take

data AoiOverlayImage f = AoiOverlayImage
  { id          :: Column f AoiOverlayImageId
  , category    :: Column f AoiOverlayImageCategory
  , orderId     :: Column f OrderId
  , name        :: Column f Text
  , mimeType    :: Column f Text
  , imageBucket :: Column f Text
  , imageKey    :: Column f Text
  , createdAt   :: Column f UTCTime
  , imageWidth  :: Column f Double
  , imageHeight :: Column f Double
  , side        :: Column f PanelSide
  , fiducials   :: Fiducials (Point V2 (Column f Double))
  }

Then if I use deriving (Generic, Rel8able), -ddump-core-stats -ddump-timings shows:

==================== Core Stats ====================
Tidy size (terms,types,coercions) CircuitHub.Model.AoiOverlayImage: 4011 95920 180224


CoreTidy [CircuitHub.Model.AoiOverlayImage]: alloc=44652152 time=38.712
*** CorePrep [CircuitHub.Model.AoiOverlayImage]:
CorePrep [CircuitHub.Model.AoiOverlayImage]: alloc=23880 time=0.018
*** CodeGen [CircuitHub.Model.AoiOverlayImage]:
CodeGen [CircuitHub.Model.AoiOverlayImage]: alloc=341677056 time=265.794
*** systool:as:
systool:as: alloc=104672 time=0.417
*** CorePrep [CircuitHub.Model.AoiOverlayImage]:
CorePrep [CircuitHub.Model.AoiOverlayImage]: alloc=23880 time=0.062
*** CodeGen [CircuitHub.Model.AoiOverlayImage]:
CodeGen [CircuitHub.Model.AoiOverlayImage]: alloc=362855992 time=203.733
*** systool:as:
systool:as: alloc=106736 time=0.408

If I manually define Rel8able:

instance Rel8able AoiOverlayImage where
  type GColumns AoiOverlayImage =
    HProduct (HIdentity AoiOverlayImageId)
    (HProduct (HIdentity AoiOverlayImageCategory)
    (HProduct (HIdentity OrderId)
    (HProduct (HIdentity Text)
    (HProduct (HIdentity Text)
    (HProduct (HIdentity Text)
    (HProduct (HIdentity Text)
    (HProduct (HIdentity UTCTime)
    (HProduct (HIdentity Double)
    (HProduct (HIdentity Double)
    (HProduct (HIdentity PanelSide)
    (Columns (Fiducials (Point V2 (Column Expr Double))))))))))))))
  type GFromExprs AoiOverlayImage = AoiOverlayImage Result

  gfromColumns = \case
    SAggregate -> \(HProduct (HIdentity id) (HProduct (HIdentity category) (HProduct (HIdentity orderId) (HProduct (HIdentity name) (HProduct (HIdentity mimeType) (HProduct (HIdentity imageBucket) (HProduct (HIdentity imageKey) (HProduct (HIdentity createdAt) (HProduct (HIdentity imageWidth) (HProduct (HIdentity imageHeight) (HProduct (HIdentity side) _fiducials))))))))))) ->
      AoiOverlayImage{..}
    SExpr -> \(HProduct (HIdentity id) (HProduct (HIdentity category) (HProduct (HIdentity orderId) (HProduct (HIdentity name) (HProduct (HIdentity mimeType) (HProduct (HIdentity imageBucket) (HProduct (HIdentity imageKey) (HProduct (HIdentity createdAt) (HProduct (HIdentity imageWidth) (HProduct (HIdentity imageHeight) (HProduct (HIdentity side) _fiducials))))))))))) ->
      AoiOverlayImage{..}
    SField -> \(HProduct (HIdentity id) (HProduct (HIdentity category) (HProduct (HIdentity orderId) (HProduct (HIdentity name) (HProduct (HIdentity mimeType) (HProduct (HIdentity imageBucket) (HProduct (HIdentity imageKey) (HProduct (HIdentity createdAt) (HProduct (HIdentity imageWidth) (HProduct (HIdentity imageHeight) (HProduct (HIdentity side) _fiducials))))))))))) ->
      AoiOverlayImage{..}
    SName -> \(HProduct (HIdentity id) (HProduct (HIdentity category) (HProduct (HIdentity orderId) (HProduct (HIdentity name) (HProduct (HIdentity mimeType) (HProduct (HIdentity imageBucket) (HProduct (HIdentity imageKey) (HProduct (HIdentity createdAt) (HProduct (HIdentity imageWidth) (HProduct (HIdentity imageHeight) (HProduct (HIdentity side) _fiducials))))))))))) ->
      AoiOverlayImage{..}
    SResult -> \(HProduct (HIdentity (Identity id)) (HProduct (HIdentity (Identity category)) (HProduct (HIdentity (Identity orderId)) (HProduct (HIdentity (Identity name)) (HProduct (HIdentity (Identity mimeType)) (HProduct (HIdentity (Identity imageBucket)) (HProduct (HIdentity (Identity imageKey)) (HProduct (HIdentity (Identity createdAt)) (HProduct (HIdentity (Identity imageWidth)) (HProduct (HIdentity (Identity imageHeight)) (HProduct (HIdentity (Identity side)) _fiducials))))))))))) ->
      AoiOverlayImage{..}

  gtoColumns context AoiOverlayImage{..} = case context of
    SAggregate ->
      HProduct (HIdentity id) (HProduct (HIdentity category) (HProduct (HIdentity orderId) (HProduct (HIdentity name) (HProduct (HIdentity mimeType) (HProduct (HIdentity imageBucket) (HProduct (HIdentity imageKey) (HProduct (HIdentity createdAt) (HProduct (HIdentity imageWidth) (HProduct (HIdentity imageHeight) (HProduct (HIdentity side) (undefined fiducials)))))))))))
    SExpr ->
      HProduct (HIdentity id) (HProduct (HIdentity category) (HProduct (HIdentity orderId) (HProduct (HIdentity name) (HProduct (HIdentity mimeType) (HProduct (HIdentity imageBucket) (HProduct (HIdentity imageKey) (HProduct (HIdentity createdAt) (HProduct (HIdentity imageWidth) (HProduct (HIdentity imageHeight) (HProduct (HIdentity side) (undefined fiducials)))))))))))
    SField ->
      HProduct (HIdentity id) (HProduct (HIdentity category) (HProduct (HIdentity orderId) (HProduct (HIdentity name) (HProduct (HIdentity mimeType) (HProduct (HIdentity imageBucket) (HProduct (HIdentity imageKey) (HProduct (HIdentity createdAt) (HProduct (HIdentity imageWidth) (HProduct (HIdentity imageHeight) (HProduct (HIdentity side) (undefined fiducials)))))))))))
    SName ->
      HProduct (HIdentity id) (HProduct (HIdentity category) (HProduct (HIdentity orderId) (HProduct (HIdentity name) (HProduct (HIdentity mimeType) (HProduct (HIdentity imageBucket) (HProduct (HIdentity imageKey) (HProduct (HIdentity createdAt) (HProduct (HIdentity imageWidth) (HProduct (HIdentity imageHeight) (HProduct (HIdentity side) (undefined fiducials)))))))))))
    SResult ->
      HProduct (HIdentity (pure id)) $
      HProduct (HIdentity (pure category))$
      HProduct (HIdentity (pure orderId)) $
      HProduct (HIdentity (pure name)) $
      HProduct (HIdentity (pure mimeType)) $
      HProduct (HIdentity (pure imageBucket)) $
      HProduct (HIdentity (pure imageKey)) $
      HProduct (HIdentity (pure createdAt)) $
      HProduct (HIdentity (pure imageWidth)) $
      HProduct (HIdentity (pure imageHeight)) $
      HProduct (HIdentity (pure side)) $
              (undefined fiducials)

  gfromResult (HProduct (HIdentity (Identity id)) (HProduct (HIdentity (Identity category)) (HProduct (HIdentity (Identity orderId)) (HProduct (HIdentity (Identity name)) (HProduct (HIdentity (Identity mimeType)) (HProduct (HIdentity (Identity imageBucket)) (HProduct (HIdentity (Identity imageKey)) (HProduct (HIdentity (Identity createdAt)) (HProduct (HIdentity (Identity imageWidth)) (HProduct (HIdentity (Identity imageHeight)) (HProduct (HIdentity (Identity side)) _fiducials))))))))))) =
    AoiOverlayImage{..}

  gtoResult AoiOverlayImage{..} =
    HProduct (HIdentity (pure id)) $
    HProduct (HIdentity (pure category))$
    HProduct (HIdentity (pure orderId)) $
    HProduct (HIdentity (pure name)) $
    HProduct (HIdentity (pure mimeType)) $
    HProduct (HIdentity (pure imageBucket)) $
    HProduct (HIdentity (pure imageKey)) $
    HProduct (HIdentity (pure createdAt)) $
    HProduct (HIdentity (pure imageWidth)) $
    HProduct (HIdentity (pure imageHeight)) $
    HProduct (HIdentity (pure side)) $
             (undefined fiducials)

Then I get

==================== Core Stats ====================
Tidy size (terms,types,coercions) CircuitHub.Model.AoiOverlayImage: 1183 19963 47503


CoreTidy [CircuitHub.Model.AoiOverlayImage]: alloc=11051920 time=8.720
*** CorePrep [CircuitHub.Model.AoiOverlayImage]:
CorePrep [CircuitHub.Model.AoiOverlayImage]: alloc=23880 time=0.017
*** CodeGen [CircuitHub.Model.AoiOverlayImage]:
CodeGen [CircuitHub.Model.AoiOverlayImage]: alloc=111075016 time=77.838
*** systool:as:
systool:as: alloc=104648 time=0.343
*** CorePrep [CircuitHub.Model.AoiOverlayImage]:
CorePrep [CircuitHub.Model.AoiOverlayImage]: alloc=23880 time=0.054
*** CodeGen [CircuitHub.Model.AoiOverlayImage]:
CodeGen [CircuitHub.Model.AoiOverlayImage]: alloc=119318232 time=57.784
*** systool:as:
systool:as: alloc=106688 time=0.413

If I'm reading this right, 500ms becomes 144ms - so almost a 5x speed up in compilation time.

Obviously generating the code using TH is going to take time, so 5x might be out of reach, but even 2x would be fairly impressive.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant