From edc1b3f65d9188da7e43ff71539e02400d2f916e Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sat, 17 Feb 2018 12:56:27 -0800 Subject: [PATCH] classes.tuple: adding ?offset-of-slot that returns n/f. --- core/classes/tuple/tuple-docs.factor | 13 ++++++++++--- core/classes/tuple/tuple.factor | 6 ++++-- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/core/classes/tuple/tuple-docs.factor b/core/classes/tuple/tuple-docs.factor index 8d17d6171f..4ee30d1d8b 100644 --- a/core/classes/tuple/tuple-docs.factor +++ b/core/classes/tuple/tuple-docs.factor @@ -454,17 +454,24 @@ HELP: boa HELP: bad-superclass { $error-description "Thrown if an attempt is made to subclass a class that is not a tuple class, or a tuple class declared " { $link POSTPONE: final } "." } ; +HELP: ?offset-of-slot +{ $values { "name" string } { "tuple" tuple } { "n" { $maybe integer } } } +{ $description "Returns the offset of a tuple slot accessed by " { $snippet "name" } ", or " { $link f } " if no slot with that name." } ; + HELP: offset-of-slot { $values { "name" string } { "tuple" tuple } { "n" integer } } -{ $description "Returns the offset of a tuple slot accessed by " { $snippet "name" } "." } ; +{ $description "Returns the offset of a tuple slot accessed by " { $snippet "name" } "." } +{ $errors "Throws a " { $link no-slot } " error if no slot with that name." } ; HELP: get-slot-named { $values { "name" string } { "tuple" tuple } { "value" object } } -{ $description "Returns the " { $snippet "value" } " stored in a tuple slot accessed by " { $snippet "name" } "." } ; +{ $description "Returns the " { $snippet "value" } " stored in a tuple slot accessed by " { $snippet "name" } "." } +{ $errors "Throws a " { $link no-slot } " error if no slot with that name." } ; HELP: set-slot-named { $values { "value" object } { "name" string } { "tuple" tuple } } -{ $description "Stores the " { $snippet "value" } " into a tuple slot accessed by " { $snippet "name" } "." } ; +{ $description "Stores the " { $snippet "value" } " into a tuple slot accessed by " { $snippet "name" } "." } +{ $errors "Throws a " { $link no-slot } " error if no slot with that name." } ; HELP: set-slots { $values { "assoc" assoc } { "tuple" tuple } } diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index f903d0088b..e260e3530e 100644 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -24,9 +24,11 @@ ERROR: not-a-tuple object ; ERROR: no-slot name tuple ; +: ?offset-of-slot ( name tuple -- n/f ) + class-of all-slots slot-named [ offset>> ] [ f ] if* ; + : offset-of-slot ( name tuple -- n ) - 2dup class-of all-slots slot-named - [ 2nip offset>> ] [ no-slot ] if* ; + 2dup ?offset-of-slot [ 2nip ] [ no-slot ] if* ; : get-slot-named ( name tuple -- value ) [ nip ] [ offset-of-slot ] 2bi slot ;