From: Doug Coleman Date: Wed, 22 Jun 2022 20:10:04 +0000 (-0500) Subject: fry2: remove for now X-Git-Tag: 0.99~1353 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=1474e94f6785433da14badd45316c36a453ee2ae fry2: remove for now --- diff --git a/extra/fry2/fry2.factor b/extra/fry2/fry2.factor deleted file mode 100644 index 564fc4dd02..0000000000 --- a/extra/fry2/fry2.factor +++ /dev/null @@ -1,100 +0,0 @@ -! Copyright (C) 2022 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs combinators -combinators.short-circuit combinators.smart fry generalizations -kernel lexer make math math.order multiline namespaces parser -prettyprint quotations sequences sequences.deep -sequences.private sets sorting.slots splitting -splitting.monotonic strings.parser ; -IN: fry2 - -MACRO: nswapd ( ndown1 ndown2 dip -- quot ) - [ 2dup < [ swap ] when - [ [ - ] keep ] [ ] 2bi ] dip - '[ [ _ _ -nrotd _ _ nrotd ] _ ndip ] ; - - - -TUPLE: local name mutable? ; - -: ( name -- local ) - local new - swap "!" ?tail - [ >>name ] dip - [ >>mutable? ] when* ; inline - -TUPLE: fry-quot seq ; -INSTANCE: fry-quot immutable-sequence - -: ( seq -- fry-quot ) - fry-quot new - swap >>seq ; inline - -M: fry-quot length seq>> length ; -M: fry-quot nth-unsafe seq>> nth-unsafe ; - -: find-locals ( seq -- hash ) - [ local? ] deep-filter members - { { name>> >=< } } sort-by zip-index reverse ; - -DEFER: fry2 -DEFER: fry3 -<< -SYNTAX: FRY[ parse-quotation fry >quotation append! ; -SYNTAX: FRY2[ parse-quotation fry2 append! ; -! SYNTAX: LFRY[ parse-quotation fry3 append! ; -SYNTAX: L" lexer get skip-blank parse-string suffix! ; ->> - -: split-fry ( quot -- seq ) - [ - [ { _ @ } member? ] bi@ - 2array { { t f } { f f } } member? - ] monotonic-split ; - -: trim-fry ( seq -- quot ) - [ - dup ?first \ _ = [ - unclip drop >quotation '[ _ curry ] - ] [ - dup ?first \ @ = [ - unclip drop >quotation '[ B _ compose ] ! B '[ call @ ] - ] [ - ! B - ] if - ] if - ] map [ >quotation ] map dup . - - '[ [ _ spread ] [ ] output>sequence concat ] ; inline - -: fry2 ( quot -- quot' ) split-fry trim-fry ; inline - -DEFER: convert-locals - -! : fry3 ( quot -- quot' ) -! [ find-locals ] keep -! [ convert-locals call ] keep -! [ dup local? [ drop \ _ ] when ] map split-fry trim-fry ; inline - -:: convert-locals ( locals quot -- quot' ) - locals assoc-size :> size - [ - size quot [ - { - { [ dup \ _ = ] [ drop 1 - [ ] , ] } - ! { [ dup \ @ = ] [ drop "omg" throw 1 - [ ] , ] } - { [ dup local? ] [ - [ locals at dup size swap - swap [ + ] dip '[ 1 _ _ mntuckd ] , ] keepd - ] } - ! { [ dup fry-quot? ] [ - ! B - ! ! size '[ _ 1 1 noverd ] , - ! ! [ locals ] dip '[ _ _ convert-locals fry ] , - ! [ locals ] dip convert-locals fry '[ _ ] , ! fry , - ! ! size '[ _ ndrop ] , - ! ] } - [ drop ] - } cond - ] each drop - size '[ _ ndrop ] , - ] [ ] make concat ; inline