replaced redundancies

db4
Sam Anklesaria 2009-08-04 17:16:34 -05:00
parent 70428241bd
commit c05e91a7a3
7 changed files with 4 additions and 24 deletions

View File

@ -1,5 +0,0 @@
USING: help.markup help.syntax ;
IN: classes.algebraic
HELP: DATA:
{ $syntax "DATA: class constructor | constructor arg ... | ... ;" }
{ $description "Creates a haskell style algebraic data type. For each constructor, a seperate tuple is created, and the resulting tuples are added to a union class." } ;

View File

@ -1,10 +0,0 @@
USING: classes.parser classes.tuple classes.union kernel peg
peg-lexer sequences ;
IN: classes.algebraic
ON-BNF: DATA:
tokenizer = <foreign factor>
delimit = "|" => [[ drop ignore ]]
tuple = (!("|"|";").)+ => [[ unclip create-class-in [ tuple rot define-tuple-class ] keep ]]
expr = . tuple (delimit tuple)* ";" => [[ first3 swap prefix [ create-class-in ] dip define-union-class ignore ]]
;ON-BNF

View File

@ -1 +0,0 @@
Sam Anklesaria

View File

@ -1 +0,0 @@
Haskell-like algebraic data types

View File

@ -1,8 +1,8 @@
USING: accessors arrays classes.algebraic combinators io.styles USING: accessors arrays variants combinators io.styles
kernel math parser sequences fry ; kernel math parser sequences fry ;
IN: fonts.syntax IN: fonts.syntax
DATA: fontname serif | monospace ; VARIANT: fontname serif monospace ;
: install ( object quot -- quot/? ) over [ curry ] [ 2drop [ ] ] if ; : install ( object quot -- quot/? ) over [ curry ] [ 2drop [ ] ] if ;

View File

@ -15,8 +15,5 @@ IN: sequences.extras
[ unclip id swap quot call( prev elt -- next ) quot reduce* ] if-empty ; inline recursive [ unclip id swap quot call( prev elt -- next ) quot reduce* ] if-empty ; inline recursive
:: combos ( list1 list2 -- result ) list2 [ [ 2array ] curry list1 swap map ] map concat ; :: combos ( list1 list2 -- result ) list2 [ [ 2array ] curry list1 swap map ] map concat ;
: (head-slice) ( seq n -- seq' ) over length over < [ drop ] [ head-slice ] if ;
: find-all ( seq quot -- elts ) [ [ length iota ] keep ] dip : find-all ( seq quot -- elts ) [ [ length iota ] keep ] dip
[ dupd call( a -- ? ) [ 2array ] [ 2drop f ] if ] curry 2map [ ] filter ; inline [ dupd call( a -- ? ) [ 2array ] [ 2drop f ] if ] curry 2map [ ] filter ; inline
: empty ( seq -- ) 0 swap shorten ;

View File

@ -14,7 +14,7 @@ TUPLE: placeholder < gadget members ;
: (remove-members) ( placeholder members -- ) [ [ model? ] filter swap parent>> model>> [ remove-connection ] curry each ] : (remove-members) ( placeholder members -- ) [ [ model? ] filter swap parent>> model>> [ remove-connection ] curry each ]
[ nip [ gadget? ] filter [ unparent ] each ] 2bi ; [ nip [ gadget? ] filter [ unparent ] each ] 2bi ;
: remove-members ( placeholder -- ) dup members>> [ drop ] [ [ (remove-members) ] keep empty ] if-empty ; : remove-members ( placeholder -- ) dup members>> [ drop ] [ [ (remove-members) ] keep delete-all ] if-empty ;
: add-member ( obj placeholder -- ) over layout? [ [ gadget>> ] dip ] when members>> push ; : add-member ( obj placeholder -- ) over layout? [ [ gadget>> ] dip ] when members>> push ;
: , ( item -- ) make:, ; : , ( item -- ) make:, ;