replaced redundancies
parent
70428241bd
commit
c05e91a7a3
|
@ -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." } ;
|
|
|
@ -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
|
|
|
@ -1 +0,0 @@
|
||||||
Sam Anklesaria
|
|
|
@ -1 +0,0 @@
|
||||||
Haskell-like algebraic data types
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
|
@ -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 ;
|
|
|
@ -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:, ;
|
||||||
|
|
Loading…
Reference in New Issue