More error checking in constructors for when slot name is repeated or a slot is not present in a tuple
parent
095763bcee
commit
654e4d48f5
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test constructors calendar kernel accessors
|
||||
combinators.short-circuit initializers math ;
|
||||
USING: accessors calendar combinators.short-circuit
|
||||
constructors eval initializers kernel math tools.test ;
|
||||
IN: constructors.tests
|
||||
|
||||
TUPLE: stock-spread stock spread timestamp ;
|
||||
|
@ -41,3 +41,11 @@ CONSTRUCTOR: ct4 ( a b c d -- obj )
|
|||
[ 2 ] [ 0 0 <ct2> a>> ] unit-test
|
||||
[ 3 ] [ 0 0 0 <ct3> a>> ] unit-test
|
||||
[ 4 ] [ 0 0 0 0 <ct4> a>> ] unit-test
|
||||
|
||||
[
|
||||
"""IN: constructors.tests
|
||||
TUPLE: foo a b ;
|
||||
CONSTRUCTOR: foo ( a c -- obj ) ;""" eval( -- )
|
||||
] [
|
||||
error>> unknown-constructor-parameters?
|
||||
] must-fail-with
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2009 Slava Pestov, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs classes classes.tuple effects.parser
|
||||
fry generalizations generic.standard kernel lexer locals macros
|
||||
parser sequences slots vocabs words arrays ;
|
||||
USING: accessors arrays assocs classes classes.tuple
|
||||
effects.parser fry generalizations generic.standard kernel
|
||||
lexer locals macros parser sequences sets slots vocabs words ;
|
||||
IN: constructors
|
||||
|
||||
! An experiment
|
||||
|
@ -38,6 +38,15 @@ MACRO:: slots>constructor ( class slots -- quot )
|
|||
default-params swap assoc-union values _ firstn class boa
|
||||
] ;
|
||||
|
||||
ERROR: repeated-constructor-parameters class effect ;
|
||||
|
||||
ERROR: unknown-constructor-parameters class effect unknown ;
|
||||
|
||||
: ensure-constructor-parameters ( class effect -- class effect )
|
||||
dup in>> all-unique? [ repeated-constructor-parameters ] unless
|
||||
2dup [ all-slots [ name>> ] map ] [ in>> ] bi* swap diff
|
||||
[ unknown-constructor-parameters ] unless-empty ;
|
||||
|
||||
:: (define-constructor) ( constructor-word class effect def -- word quot )
|
||||
constructor-word
|
||||
class def define-initializer
|
||||
|
@ -53,7 +62,8 @@ MACRO:: slots>constructor ( class slots -- quot )
|
|||
scan-word [ name>> "<" ">" surround create-in dup reset-generic ] keep ;
|
||||
|
||||
: parse-constructor ( -- class word effect def )
|
||||
scan-constructor complete-effect parse-definition ;
|
||||
scan-constructor complete-effect ensure-constructor-parameters
|
||||
parse-definition ;
|
||||
|
||||
SYNTAX: CONSTRUCTOR: parse-constructor f define-constructor ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue