From bacdd274ca8f4b2be2bcda5580758f753434ce08 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 26 Oct 2024 10:52:37 -0500 Subject: [PATCH] Fix tracks runtime type check. --- src/core/hooks_implementations.ml | 2 +- src/core/source.ml | 6 ++++-- src/core/types/format_type.ml | 2 +- 3 files changed, 6 insertions(+), 4 deletions(-) diff --git a/src/core/hooks_implementations.ml b/src/core/hooks_implementations.ml index 3b0e068a57..28c252dba6 100644 --- a/src/core/hooks_implementations.ml +++ b/src/core/hooks_implementations.ml @@ -20,7 +20,7 @@ let eval_check ~env:_ ~tm v = s#content_type_computation_allowed)) else if Source_tracks.is_value v then ( let s = Source_tracks.source v in - Typing.(s#frame_type <: tm.Term.t)) + Typing.(s#frame_type <: Type.fresh tm.Term.t)) else if Track.is_value v then ( let field, source = Lang_source.to_track v in if not source#has_content_type then ( diff --git a/src/core/source.ml b/src/core/source.ml index d6c681ff01..abe9b4a222 100644 --- a/src/core/source.ml +++ b/src/core/source.ml @@ -215,8 +215,10 @@ class virtual operator ?(stack = []) ?clock ?(name = "src") sources = try self#content_type_computation_allowed; if log == source_log then self#create_log; - source_log#info "Source %s gets up with content type: %s." id - (Frame.string_of_content_type self#content_type); + source_log#info + "Source %s gets up with content type: %s and frame type: %s." id + (Frame.string_of_content_type self#content_type) + (Type.to_string self#frame_type); self#log#debug "Clock is %s." (Clock.id self#clock); self#log#important "Content type is %s." (Frame.string_of_content_type self#content_type); diff --git a/src/core/types/format_type.ml b/src/core/types/format_type.ml index df04082965..6d9b6d7ff0 100644 --- a/src/core/types/format_type.ml +++ b/src/core/types/format_type.ml @@ -53,7 +53,7 @@ module FormatSpecs = struct let subtype _ f f' = Content_base.merge f f' let sup _ f f' = - Content_base.merge f f'; + Content_base.(merge (duplicate f) (duplicate f')); f let to_string _ = assert false