QUALIFIED: sets : generate-slot-sequences ( class -- seq1 seq2 ) all-slots [ name>> ] map [ reverse! sets:members ] keep ; : 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 ( slot-assoc initial-slot-assoc length -- slots... ) [ swap assoc-union! reverse! [ last ] map ] dip firstn ; inline MACRO: shadowed-boa ( class -- tuple ) [ generate-slot-sequences [ [ length ] keep ] dip ] keep '[ _ _ _ _ [ assoc-slots ] 2dip [ assoc-slots-to-initial dup length extract-slot-values ] [ boa ] bi ] ;