QUALIFIED: sets : (assoc-slots) ( slots... length seq -- assoc ) [ narray reverse! ] dip swap zip ; inline : (assoc-slots-to-initial) ( seq class -- assoc ) initial-values reverse! zip ; : (extract-slot-values) ( initial-slot-assoc slot-assoc length -- slots... ) [ assoc-union! reverse! [ last ] map ] dip firstn ; inline MACRO: shadowed-boa ( class -- tuple ) [ all-slots [ name>> ] map [ reverse! sets:members ] keep [ [ length ] bi@ ] 2keep swapd ] keep '[ _ _ (assoc-slots) _ _ _ [ (assoc-slots-to-initial) -rot (extract-slot-values) ] [ boa ] bi ] ;