factor: fortran, add more string escaping temporarily, make modern lex itself.
parent
7651252428
commit
6f23279be6
|
@ -206,9 +206,9 @@ MACRO:: read-double-matched ( open-ch -- quot: ( n string tag ch -- n' string se
|
||||||
} case
|
} case
|
||||||
] ;
|
] ;
|
||||||
|
|
||||||
: read-double-matched-paren ( n string tag ch -- n' string seq ) char: ( read-double-matched ;
|
: read-double-matched-paren ( n string tag ch -- n' string seq ) char: \( read-double-matched ;
|
||||||
: read-double-matched-bracket ( n string tag ch -- n' string seq ) char: [ read-double-matched ;
|
: read-double-matched-bracket ( n string tag ch -- n' string seq ) char: \[ read-double-matched ;
|
||||||
: read-double-matched-brace ( n string tag ch -- n' string seq ) char: { read-double-matched ;
|
: read-double-matched-brace ( n string tag ch -- n' string seq ) char: \{ read-double-matched ;
|
||||||
|
|
||||||
defer: lex
|
defer: lex
|
||||||
defer: lex-factor
|
defer: lex-factor
|
||||||
|
@ -248,9 +248,9 @@ MACRO:: read-matched ( ch -- quot: ( n string tag -- n' string slice' ) )
|
||||||
} cond
|
} cond
|
||||||
] ;
|
] ;
|
||||||
|
|
||||||
: read-bracket ( n string slice -- n' string slice' ) char: [ read-matched ;
|
: read-bracket ( n string slice -- n' string slice' ) char: \[ read-matched ;
|
||||||
: read-brace ( n string slice -- n' string slice' ) char: { read-matched ;
|
: read-brace ( n string slice -- n' string slice' ) char: \{ read-matched ;
|
||||||
: read-paren ( n string slice -- n' string slice' ) char: ( read-matched ;
|
: read-paren ( n string slice -- n' string slice' ) char: \( read-matched ;
|
||||||
|
|
||||||
: read-backtick ( n string opening -- n' string obj )
|
: read-backtick ( n string opening -- n' string obj )
|
||||||
[
|
[
|
||||||
|
@ -260,10 +260,10 @@ MACRO:: read-matched ( ch -- quot: ( n string tag -- n' string slice' ) )
|
||||||
|
|
||||||
: read-string-payload ( n string -- n' string )
|
: read-string-payload ( n string -- n' string )
|
||||||
over [
|
over [
|
||||||
{ char: \ char: \" } slice-til-separator-inclusive {
|
{ char: \\ char: \" } slice-til-separator-inclusive {
|
||||||
{ f [ drop ] }
|
{ f [ drop ] }
|
||||||
{ char: \" [ drop ] }
|
{ char: \" [ drop ] }
|
||||||
{ char: \ [ drop next-char-from drop read-string-payload ] }
|
{ char: \\ [ drop next-char-from drop read-string-payload ] }
|
||||||
} case
|
} case
|
||||||
] [
|
] [
|
||||||
string-expected-got-eof
|
string-expected-got-eof
|
||||||
|
@ -278,7 +278,7 @@ MACRO:: read-matched ( ch -- quot: ( n string tag -- n' string slice' ) )
|
||||||
tag 1 cut-slice* dquote-literal make-matched-literal ;
|
tag 1 cut-slice* dquote-literal make-matched-literal ;
|
||||||
|
|
||||||
: take-comment ( n string slice -- n' string comment )
|
: take-comment ( n string slice -- n' string comment )
|
||||||
2over ?nth char: [ = [
|
2over ?nth char: \[ = [
|
||||||
[ 1 + ] 2dip 2over ?nth read-double-matched-bracket
|
[ 1 + ] 2dip 2over ?nth read-double-matched-bracket
|
||||||
] [
|
] [
|
||||||
[ slice-til-eol drop dup ] dip 1 cut-slice* line-comment-literal make-delimited-literal
|
[ slice-til-eol drop dup ] dip 1 cut-slice* line-comment-literal make-delimited-literal
|
||||||
|
@ -409,16 +409,16 @@ MACRO: rules>call-lexer ( seq -- quot: ( n/f string -- n'/f string literal ) )
|
||||||
'[ _ slice-til-either _ case ] ;
|
'[ _ slice-til-either _ case ] ;
|
||||||
|
|
||||||
CONSTANT: factor-lexing-rules {
|
CONSTANT: factor-lexing-rules {
|
||||||
T{ line-comment-lexer { generator read-exclamation } { delimiter char: ! } }
|
T{ line-comment-lexer { generator read-exclamation } { delimiter char: \! } }
|
||||||
T{ backtick-lexer { generator read-backtick } { delimiter char: ` } }
|
T{ backtick-lexer { generator read-backtick } { delimiter char: ` } }
|
||||||
T{ backslash-lexer { generator read-backslash } { delimiter char: \ } }
|
T{ backslash-lexer { generator read-backslash } { delimiter char: \\ } }
|
||||||
T{ dquote-lexer { generator read-string } { delimiter char: \" } { escape char: \ } }
|
T{ dquote-lexer { generator read-string } { delimiter char: \" } { escape char: \\ } }
|
||||||
T{ decorator-lexer { generator read-decorator } { delimiter char: @ } }
|
T{ decorator-lexer { generator read-decorator } { delimiter char: @ } }
|
||||||
|
|
||||||
T{ colon-lexer { generator read-colon } { delimiter char: : } }
|
T{ colon-lexer { generator read-colon } { delimiter char: \: } }
|
||||||
T{ matched-lexer { generator read-bracket } { delimiter char: [ } }
|
T{ matched-lexer { generator read-bracket } { delimiter char: \[ } }
|
||||||
T{ matched-lexer { generator read-brace } { delimiter char: { } }
|
T{ matched-lexer { generator read-brace } { delimiter char: \{ } }
|
||||||
T{ matched-lexer { generator read-paren } { delimiter char: ( } }
|
T{ matched-lexer { generator read-paren } { delimiter char: \( } }
|
||||||
|
|
||||||
T{ terminator-lexer { generator read-terminator } { delimiter char: ; } }
|
T{ terminator-lexer { generator read-terminator } { delimiter char: ; } }
|
||||||
T{ terminator-lexer { generator read-terminator } { delimiter char: ] } }
|
T{ terminator-lexer { generator read-terminator } { delimiter char: ] } }
|
||||||
|
@ -450,20 +450,18 @@ CONSTANT: factor-lexing-rules {
|
||||||
[ nip array? not ] assoc-filter ;
|
[ nip array? not ] assoc-filter ;
|
||||||
|
|
||||||
|
|
||||||
/*
|
|
||||||
! What a lexer body looks like, produced by make-lexer
|
! What a lexer body looks like, produced by make-lexer
|
||||||
: lex ( n/f string -- n'/f string literal )
|
! : lex ( n/f string -- n'/f string literal )
|
||||||
"!`\\\"[{(\s\r\n" slice-til-either {
|
! "!`\\\"[{(\s\r\n" slice-til-either {
|
||||||
{ char: ! [ read-exclamation ] }
|
! { char: ! [ read-exclamation ] }
|
||||||
{ char: ` [ read-backtick ] }
|
! { char: ` [ read-backtick ] }
|
||||||
{ char: \ [ read-backslash ] }
|
! { char: \ [ read-backslash ] }
|
||||||
{ char: \" [ read-string ] }
|
! { char: \" [ read-string ] }
|
||||||
{ char: \[ [ read-bracket ] }
|
! { char: \[ [ read-bracket ] }
|
||||||
{ char: \{ [ read-brace ] }
|
! { char: \{ [ read-brace ] }
|
||||||
{ char: \( [ read-paren ] }
|
! { char: \( [ read-paren ] }
|
||||||
{ char: \s [ read-token-or-whitespace ] }
|
! { char: \s [ read-token-or-whitespace ] }
|
||||||
{ char: \r [ read-token-or-whitespace ] }
|
! { char: \r [ read-token-or-whitespace ] }
|
||||||
{ char: \n [ read-token-or-whitespace ] }
|
! { char: \n [ read-token-or-whitespace ] }
|
||||||
{ f [ f like dup [ make-tag-literal ] when ] }
|
! { f [ f like dup [ make-tag-literal ] when ] }
|
||||||
} case ; inline
|
! } case ; inline
|
||||||
*/
|
|
||||||
|
|
|
@ -21,10 +21,12 @@ ERROR: bad-escape char ;
|
||||||
{ char: \s char: \s }
|
{ char: \s char: \s }
|
||||||
{ char: 0 char: \0 }
|
{ char: 0 char: \0 }
|
||||||
{ char: \\ char: \\ }
|
{ char: \\ char: \\ }
|
||||||
|
{ char: \: char: \: }
|
||||||
{ char: \" char: \" }
|
{ char: \" char: \" }
|
||||||
{ char: \{ char: \{ }
|
{ char: \{ char: \{ }
|
||||||
{ char: \[ char: \[ }
|
{ char: \[ char: \[ }
|
||||||
{ char: \( char: \( }
|
{ char: \( char: \( }
|
||||||
|
{ char: \! char: \! }
|
||||||
} ?at [ bad-escape ] unless ;
|
} ?at [ bad-escape ] unless ;
|
||||||
|
|
||||||
symbol: name>char-hook
|
symbol: name>char-hook
|
||||||
|
|
|
@ -442,13 +442,18 @@ MACRO: fortran-invoke ( return library function parameters -- quot )
|
||||||
|
|
||||||
SYNTAX: SUBROUTINE:
|
SYNTAX: SUBROUTINE:
|
||||||
f current-library get scan-token ")" parse-tokens
|
f current-library get scan-token ")" parse-tokens
|
||||||
[ "()" subseq? ] reject define-fortran-function ;
|
[ "()" subseq? ] reject ";" expect define-fortran-function ;
|
||||||
|
|
||||||
SYNTAX: FUNCTION:
|
SYNTAX: FUNCTION:
|
||||||
scan-token current-library get scan-token ")" parse-tokens
|
scan-token current-library get scan-token ")" parse-tokens
|
||||||
[ "()" subseq? ] reject define-fortran-function ;
|
[ "()" subseq? ] reject ";" expect define-fortran-function ;
|
||||||
|
|
||||||
SYNTAX: LIBRARY:
|
SYNTAX: LIBRARY:
|
||||||
scan-token
|
scan-token
|
||||||
[ current-library set ]
|
[ current-library set ]
|
||||||
[ set-fortran-abi ] bi ;
|
[ set-fortran-abi ] bi ;
|
||||||
|
|
||||||
|
SYNTAX: library:
|
||||||
|
scan-token
|
||||||
|
[ current-library set ]
|
||||||
|
[ set-fortran-abi ] bi ;
|
||||||
|
|
|
@ -9,7 +9,7 @@ add-fortran-library
|
||||||
deploy-blas? get [ "blas" deploy-library ] when
|
deploy-blas? get [ "blas" deploy-library ] when
|
||||||
>>
|
>>
|
||||||
|
|
||||||
LIBRARY: blas
|
library: blas
|
||||||
|
|
||||||
! Level 1 BLAS (scalar-vector and vector-vector)
|
! Level 1 BLAS (scalar-vector and vector-vector)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue