steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

modern: Instead of [=[ ]=] [==[ ]==] we use [0[ ]0] [1[ ]1] etc.

modern-harvey3
Doug Coleman 2019-12-01 11:19:43 -06:00
parent 5a9f0752c8
commit 9e4a999f7b
1 changed files with 43 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
extra/modern/modern.factor
View File

@ -2,9 +2,9 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs combinators combinators.short-circuit USING: arrays assocs combinators combinators.short-circuit
continuations io.encodings.utf8 io.files kernel make math continuations io.encodings.utf8 io.files kernel make math
math.order modern.compiler modern.paths modern.slices sequences math.order math.parser modern.compiler modern.paths modern.slices
sequences.extras sets splitting strings syntax.modern unicode sequences sequences.extras sets splitting strings syntax.modern
vocabs.loader ; unicode vocabs.loader ;
IN: modern IN: modern
: <ws> ( obj -- obj ) ; : <ws> ( obj -- obj ) ;
@ -13,32 +13,41 @@ ERROR: long-opening-mismatch tag open string n ch ;
ERROR: unexpected-terminator string n slice ; ! ] } ) ; ERROR: unexpected-terminator string n slice ; ! ] } ) ;
ERROR: compound-syntax-disallowed seq n obj ; ERROR: compound-syntax-disallowed seq n obj ;
! (( )) [[ ]] {{ }} ERROR: expected-digits-only str n got ;
MACRO:: read-double-matched ( open-ch -- quot: ( string n tag ch -- string n' seq ) ) ! Allow [00[ ]00] etc
2 open-ch <string> : check-digits ( str n got -- str n digits )
open-ch 1string dup but-last [ digit? ] all?
2 open-ch matching-delimiter <string> [ >string but-last expected-digits-only ] unless ;
:> ( openstr2 openstr1 closestr2 ) ! "[[" "[" "]]"
|[ string n tag! ch |
ch {
{ char: = [
tag 1 cut-slice* drop tag! ! tag of (=( is ( here, fix it
string n openstr1 slice-until-include [ -1 modify-from ] dip :> ( string' n' opening ch )
ch open-ch = [ tag openstr2 string n ch long-opening-mismatch ] unless
opening matching-delimiter-string :> needle
string' n' needle slice-til-string :> ( string'' n'' payload closing ) ! (( )) [[ ]] {{ }}
string n'' MACRO:: read-double-matched ( $open-ch -- quot: ( string n tag ch -- string n' seq ) )
tag opening payload closing 4array <double-bracket> 2 $open-ch <string>
$open-ch 1string
2 $open-ch matching-delimiter <string>
:> ( $openstr2 $openstr1 $closestr2 ) ! "[[" "[" "]]"
|[ $string $n $tag! $ch |
$ch {
{ [ dup digit? ] [
drop $tag 1 cut-slice* drop $tag! ! XXX: $tag of (=( is ( here, fix it (??)
$string $n $openstr1 slice-until-include [
check-digits ! 000] ok, 00a] bad
-1 modify-from
] dip :> ( $string' $n' $opening $ch )
$ch $open-ch = [ $tag $openstr2 $string $n $ch long-opening-mismatch ] unless
$opening matching-delimiter-string :> $needle
$string' $n' $needle slice-til-string :> ( $string'' $n'' $payload $closing )
$string $n''
$tag $opening $payload $closing 4array <double-bracket>
] } ] }
{ open-ch [ { [ dup $open-ch = ] [
tag 1 cut-slice* swap tag! 1 modify-to :> opening drop $tag 1 cut-slice* swap $tag! 1 modify-to :> $opening
string n 1 + closestr2 slice-til-string :> ( string' n' payload closing ) $string $n 1 + $closestr2 slice-til-string :> ( $string' $n' $payload $closing )
string n' $string $n'
tag opening payload closing 4array <double-bracket> $tag $opening $payload $closing 4array <double-bracket>
] } ] }
[ [ tag openstr2 string n ] dip long-opening-mismatch ] [ [ $tag $openstr2 $string $n ] dip long-opening-mismatch ]
} case } cond
] ; ] ;
: read-double-matched-bracket ( string n tag ch -- string n' seq ) char: \[ read-double-matched ; : read-double-matched-bracket ( string n tag ch -- string n' seq ) char: \[ read-double-matched ;
@ -96,18 +105,16 @@ DEFER: lex-factor-nested
dup length 1 > [ nip ] [ drop ] if ; dup length 1 > [ nip ] [ drop ] if ;
DEFER: lex-factor-fallthrough DEFER: lex-factor-fallthrough
MACRO:: read-matched ( ch -- quot: ( string n tag -- string n' slice' ) ) MACRO:: read-matched ( $ch -- quot: ( string n tag -- string n' slice' ) )
ch dup matching-delimiter { 10 <iota> [ char: 0 + ] map
[ drop "=" swap prefix ] $ch matching-delimiter 1string :> ( $openstreq $closestr1 ) ! digits ]
[ nip 1string ] |[ $string $n $tag |
} 2cleave :> ( openstreq closestr1 ) ! [= ] $string $n $tag
|[ string n tag |
string n tag
2over nth-check-eof { 2over nth-check-eof {
{ [ dup openstreq member? ] [ ch read-double-matched ] } ! (=( or (( { [ dup $openstreq member? ] [ $ch read-double-matched ] } ! (=( or ((
{ [ dup blank? ] [ { [ dup blank? ] [
drop dup '[ _ matching-delimiter-string closestr1 2array members lex-until ] dip drop dup '[ _ matching-delimiter-string $closestr1 2array members lex-until ] dip
swap unclip-last 3array ch <matched> swap unclip-last 3array $ch <matched>
] } ! ( foo ) ] } ! ( foo )
[ [
drop [ slice-til-whitespace drop ] dip span-slices drop [ slice-til-whitespace drop ] dip span-slices