using MLStyle import InteractiveUtils . subtypes match_signature ( ast ) = ast begin quote $ ( ::LineNumberNode ) function $ name ( $ ( args ... ) ) where { $ ( cov ... ) } ; $ ( block ... ) end end | | quote $ ( ::LineNumberNode ) function $ name ( $ ( args ... ) ) ; $ ( block ... ) end end & & Do ( cov = [ ] ) => ( name = name , args = args , cov = cov ) end match_type_annotation ( ast ) = ast begin : ( $ ( arg ) : :$ ( ann ) ) => ann end match_subtype ( ast ) = ast begin : ( $ ( sub ) <: $ ( sup ) ) => ( sub = sub , sup = sup ) end function inferred ( f , args ) codeinfo = Base . code_typed ( f , args ) [ 1 ] codeinfo . second end function allsubtypes ( T ::Type ) isconcretetype ( T ) & & return [ T ] t = Type [ ] map ( K -> allsubtypes ( K , t ) , subtypes ( T ) ) t end allsubtypes ( T , t ) = isconcretetype ( T ) ? push! ( t , T ) : map ( K -> allsubtypes ( K , t ) , subtypes ( T ) ) allsubtypes ( T ::Symbol ) = allsubtypes ( Core . eval ( Main , T ) ) function concretize! ( args , concrete_args , idx ) for ( j , K ) in enumerate ( concrete_args ) for i in idx [ j ] args [ i ] = Symbol ( "$K " ) end end end function ast_replace! ( ex ::Expr , pair ::Pair ) for i = 1 : length ( ex . args ) if ex . args [ i ] == pair . first ex . args [ i ] = pair . second else ast_replace! ( ex . args [ i ] , pair ) end end ex end ast_replace! ( ex ::Symbol , pair ) = nothing ast_replace! ( ex ::LineNumberNode , pair ) = nothing function check_types ( fun , predicate , args , covs ) out = Expr [ ] covs = match_subtype . ( covs ) covs_symbols = [ c . sub for c in covs ] idx = [ findall ( args . == c ) for c in covs_symbols ] for p in Iterators . product ( [ allsubtypes ( c . sup ) for c in covs ] ... ) concrete_args = copy ( args ) concretize! ( concrete_args , p , idx ) concrete_predicate = copy ( predicate ) for pairs in [ Pair ( c , Symbol ( t ) ) for ( c , t ) in zip ( covs_symbols , p ) ] ast_replace! ( concrete_predicate , pairs ) end t = : ( Tuple { $ ( concrete_args ... ) } ) I = : ( inferred ( $ fun , $ t ) ) push! ( out , quote report_type_check ( $ concrete_predicate , $ I , $ fun , $ concrete_args ) end ) end out end function report_type_check ( predicate , inferred , fun , types ) passed = predicate ( inferred ) sig = join ( types , ", " ) status = passed ? "SUCCESS " : "FAILURE " println ( "$status: $(fun)($sig) \t → $inferred " ) end macro checked ( out , f ) sig = match_signature ( quote $ f end ) args = match_type_annotation . ( sig . args ) checks = check_types ( Symbol ( sig . name ) , out , args , sig . cov ) esc ( quote $ f $ ( checks ... ) end ) end O -> O == promote_type ( T , K ) function add ( x ::T , y ::K ) where { T <: Integer , K <: Integer } x + y end