core/classes/tuple/parser/parser.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel sets namespaces sequences inspector parser
   4 lexer combinators words classes.parser classes.tuple ;
   5 IN: classes.tuple.parser
   6
   7 : shadowed-slots ( superclass slots -- shadowed )
   8     >r all-slot-names r> intersect ;
   9
  10 : check-slot-shadowing ( class superclass slots -- )
  11     shadowed-slots [
  12         [
  13             "Definition of slot ``" %
  14             %
  15             "'' in class ``" %
  16             word-name %
  17             "'' shadows a superclass slot" %
  18         ] "" make note.
  19     ] with each ;
  20
  21 ERROR: invalid-slot-name name ;
  22
  23 M: invalid-slot-name summary
  24     drop
  25     "Invalid slot name" ;
  26
  27 : (parse-tuple-slots) ( -- )
  28     #! This isn't meant to enforce any kind of policy, just
  29     #! to check for mistakes of this form:
  30     #!
  31     #! TUPLE: blahblah foo bing
  32     #!
  33     #! : ...
  34     scan {
  35         { [ dup not ] [ unexpected-eof ] }
  36         { [ dup { ":" "(" "<" } member? ] [ invalid-slot-name ] }
  37         { [ dup ";" = ] [ drop ] }
  38         [ , (parse-tuple-slots) ]
  39     } cond ;
  40
  41 : parse-tuple-slots ( -- seq )
  42     [ (parse-tuple-slots) ] { } make ;
  43
  44 : parse-tuple-definition ( -- class superclass slots )
  45     CREATE-CLASS
  46     scan {
  47         { ";" [ tuple f ] }
  48         { "<" [ scan-word parse-tuple-slots ] }
  49         [ >r tuple parse-tuple-slots r> prefix ]
  50     } case 3dup check-slot-shadowing ;