2005-02-18 20:37:01 -05:00
|
|
|
! Copyright (C) 2004, 2005 Slava Pestov.
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
|
|
|
|
|
|
! Bootstrapping trick; see doc/bootstrap.txt.
|
|
|
|
IN: !syntax
|
|
|
|
USING: syntax generic kernel lists namespaces parser words ;
|
|
|
|
|
|
|
|
: GENERIC:
|
2005-05-14 17:18:45 -04:00
|
|
|
#! GENERIC: bar == G: bar [ dup ] [ type ] ;
|
|
|
|
CREATE define-generic ; parsing
|
2005-02-18 20:37:01 -05:00
|
|
|
|
2005-05-14 17:18:45 -04:00
|
|
|
: G:
|
|
|
|
#! G: word picker dispatcher ;
|
|
|
|
CREATE [ 2unlist rot define-generic* ] [ ] ; parsing
|
2005-02-18 20:37:01 -05:00
|
|
|
|
|
|
|
: BUILTIN:
|
2005-05-14 17:18:45 -04:00
|
|
|
#! Syntax: BUILTIN: <class> <type#> <predicate> <slots> ;
|
|
|
|
CREATE scan-word scan-word [ define-builtin ] [ ] ; parsing
|
2005-02-18 20:37:01 -05:00
|
|
|
|
2005-02-21 21:26:20 -05:00
|
|
|
: COMPLEMENT: ( -- )
|
2005-02-18 20:37:01 -05:00
|
|
|
#! Followed by a class name, then a complemented class.
|
|
|
|
CREATE
|
|
|
|
dup intern-symbol
|
|
|
|
scan-word define-complement ; parsing
|
|
|
|
|
|
|
|
: UNION: ( -- class predicate definition )
|
|
|
|
#! Followed by a class name, then a list of union members.
|
|
|
|
CREATE
|
|
|
|
dup intern-symbol
|
|
|
|
dup predicate-word
|
2005-03-05 14:45:23 -05:00
|
|
|
[ dupd unit "predicate" set-word-prop ] keep
|
2005-02-18 20:37:01 -05:00
|
|
|
[ define-union ] [ ] ; parsing
|
|
|
|
|
|
|
|
: PREDICATE: ( -- class predicate definition )
|
|
|
|
#! Followed by a superclass name, then a class name.
|
|
|
|
scan-word
|
|
|
|
CREATE dup intern-symbol
|
2005-03-05 14:45:23 -05:00
|
|
|
dup rot "superclass" set-word-prop
|
2005-02-18 20:37:01 -05:00
|
|
|
dup predicate-word
|
2005-08-03 18:47:32 -04:00
|
|
|
[ define-predicate-class ] [ ] ; parsing
|
2005-02-18 20:37:01 -05:00
|
|
|
|
|
|
|
: TUPLE:
|
|
|
|
#! Followed by a tuple name, then slot names, then ;
|
|
|
|
scan
|
|
|
|
string-mode on
|
|
|
|
[ string-mode off define-tuple ]
|
|
|
|
f ; parsing
|
|
|
|
|
|
|
|
: M: ( -- class generic [ ] )
|
|
|
|
#! M: foo bar begins a definition of the bar generic word
|
|
|
|
#! specialized to the foo type.
|
|
|
|
scan-word scan-word [ define-method ] [ ] ; parsing
|
|
|
|
|
|
|
|
: C:
|
|
|
|
#! Followed by a tuple name, then constructor code, then ;
|
|
|
|
#! Constructor code executes with the empty tuple on the
|
|
|
|
#! stack.
|
2005-05-14 17:18:45 -04:00
|
|
|
scan-word [ define-constructor ] [ ] ; parsing
|