Convert scheme.kak expensive shell scope to awk

This commit is contained in:
Maxime Coste 2019-01-20 12:31:57 +11:00
parent 8587ecaeb4
commit a35a1591d0

View File

@ -25,88 +25,94 @@ add-highlighter shared/scheme/quoted-form region -recurse "\(" "'\(" "\)" fill v
add-highlighter shared/scheme/code/ regex (#t|#f) 0:value add-highlighter shared/scheme/code/ regex (#t|#f) 0:value
add-highlighter shared/scheme/code/ regex \b[0-9]+\.[0-9]*\b 0:value add-highlighter shared/scheme/code/ regex \b[0-9]+\.[0-9]*\b 0:value
evaluate-commands %sh{ evaluate-commands %sh{ exec awk -f - <<'EOF'
BEGIN {
# Primitive expressions that cannot be derived.
split("define do let let* letrec if cond case and or begin lambda delay delay-force set!", keywords);
# Primitive expressions that cannot be derived. # Macro expressions.
keywords='define do let let* letrec if cond case and or begin lambda delay delay-force set!' split("define-syntax let-syntax letrec-syntax syntax-rules syntax-case", meta);
# Macro expressions. # Basic operators.
meta="define-syntax let-syntax letrec-syntax syntax-rules syntax-case" split("* + - ... / < <= = => > >=", operators);
# Basic operators. # Procedures that create a base type and their predicates (for easier type checking)
operators='* + - ... / < <= = => > >=' split("list vector bytevector cons string boolean? list? pair? "\
"vector? bytevector? string? char? complex? eof-object? input-port? "\
"null? number? output-port? procedure? symbol?", types);
# Procedures that create a base type and their predicates (for easier type checking) # R5RS available procedures
types="list vector bytevector cons string boolean? list? pair? split("abs acos angle append apply asin assoc assq assv atan "\
vector? bytevector? string? char? complex? eof-object? input-port? "caaaar caaadr caaar caadar caaddr caadr "\
null? number? output-port? procedure? symbol?" "caar cadaar cadadr cadar caddar cadddr caddr cadr "\
"call-with-current-continuation call-with-input-file "\
"call-with-output-file call-with-values car cdaaar cdaadr cdaar "\
"cdadar cdaddr cdadr cdar cddaar cddadr cddar cdddar cddddr cdddr "\
"cddr cdr ceiling char->integer char-alphabetic? char-ci<=? "\
"char-ci<? char-ci=? char-ci>=? char-ci>? char-downcase "\
"char-lower-case? char-numeric? char-ready? char-upcase "\
"char-upper-case? char-whitespace? char<=? char<? char=? "\
"char>=? char>? close-input-port close-output-port cons cos "\
"current-input-port current-output-port denominator display "\
"dynamic-wind else eq? equal? eqv? eval even? exact->inexact "\
"exact? exp expt floor for-each force gcd imag-part inexact->exact "\
"inexact? integer->char integer? interaction-environment lcm "\
"length list list->string list->vector list-ref list-tail load log "\
"magnitude make-polar make-rectangular make-string make-vector "\
"map max member memq memv min modulo negative? newline not "\
"null-environment number->string numerator odd? open-input-file "\
"open-output-file or peek-char positive? quasiquote quote quotient "\
"rational? rationalize read read-char real-part real? remainder "\
"reverse round scheme-report-environment set-car! set-cdr! sin "\
"sqrt string->list string->number string->symbol string-append "\
"string-ci<=? string-ci<? string-ci=? string-ci>=? "\
"string-ci>? string-copy string-fill! string-length string-ref "\
"string-set! string<=? string<? string=? string>=? string>? "\
"substring symbol->string tan truncate values vector "\
"vector->list vector-fill! vector-length vector-ref vector-set! "\
"with-input-from-file with-output-to-file write write-char zero?",
builtins);
# R5RS available procedures non_word_chars="[\\s\\(\\)\\[\\]\\{\\};\\|]";
builtins="abs acos angle append apply asin assoc assq assv atan
caaaar caaadr caaar caadar caaddr caadr
caar cadaar cadadr cadar caddar cadddr caddr cadr
call-with-current-continuation call-with-input-file
call-with-output-file call-with-values car cdaaar cdaadr cdaar
cdadar cdaddr cdadr cdar cddaar cddadr cddar cdddar cddddr cdddr
cddr cdr ceiling char->integer char-alphabetic? char-ci<=?
char-ci<? char-ci=? char-ci>=? char-ci>? char-downcase
char-lower-case? char-numeric? char-ready? char-upcase
char-upper-case? char-whitespace? char<=? char<? char=?
char>=? char>? close-input-port close-output-port cons cos
current-input-port current-output-port denominator display
dynamic-wind else eq? equal? eqv? eval even? exact->inexact
exact? exp expt floor for-each force gcd imag-part inexact->exact
inexact? integer->char integer? interaction-environment lcm
length list list->string list->vector list-ref list-tail load log
magnitude make-polar make-rectangular make-string make-vector
map max member memq memv min modulo negative? newline not
null-environment number->string numerator odd? open-input-file
open-output-file or peek-char positive? quasiquote quote quotient
rational? rationalize read read-char real-part real? remainder
reverse round scheme-report-environment set-car! set-cdr! sin
sqrt string->list string->number string->symbol string-append
string-ci<=? string-ci<? string-ci=? string-ci>=?
string-ci>? string-copy string-fill! string-length string-ref
string-set! string<=? string<? string=? string>=? string>?
substring symbol->string tan truncate values vector
vector->list vector-fill! vector-length vector-ref vector-set!
with-input-from-file with-output-to-file write write-char zero?"
join () { printf "%s" "$1" | tr -s ' \n\t' "$2"; } normal_identifiers="-!$%&\\*\\+\\./:<=>\\?\\^_~a-zA-Z0-9";
identifier_chars="[" normal_identifiers "][" normal_identifiers ",#]*";
printf '%s\n' "hook global WinSetOption filetype=scheme %{ }
set-option window static_words $(join "$keywords $meta $operators $builtins" ' ' ) function add_highlighter(regex, highlight) {
}" printf("add-highlighter shared/scheme/code/ regex \"%s\" %s\n", regex, highlight);
}
exact_quote () { function quoted_join(words, quoted, first) {
for symbol in "$@" first=1
do for (i in words) {
printf '\\Q%s\\E ' "$symbol" if (!first) { quoted=quoted "|"; }
done quoted=quoted "\\Q" words[i] "\\E";
first=0;
}
return quoted;
}
function add_word_highlighter(words, face, regex) {
regex = non_word_chars "+(" quoted_join(words) ")" non_word_chars
add_highlighter(regex, "1:" face)
}
function print_words(words) {
for (i in words) { printf(" %s", words[i]); }
} }
qkeys=$(join "$(exact_quote $keywords)" '|') BEGIN {
qmeta=$(join "$(exact_quote $meta)" '|') printf("hook global WinSetOption filetype=scheme %%{ set-option window static_words ");
qops=$(join "$(exact_quote "$operators")" '|') print_words(keywords); print_words(meta); print_words(operators); print_words(builtins);
qbuiltins=$(join "$(exact_quote $builtins)" '|') printf(" }\n")
qtypes=$(join "$(exact_quote $types)" '|')
non_word_chars='[\s\(\)\[\]\{\};\|]' add_word_highlighter(keywords, "keyword");
normal_identifiers='-!$%&\*\+\./:<=>\?\^_~a-zA-Z0-9' add_word_highlighter(meta, "meta");
identifier_chars="[${normal_identifiers}][${normal_identifiers},#]*" add_word_highlighter(operators, "operator");
add_word_highlighter(builtins, "builtin");
add_highlighter () { add_word_highlighter(types, "type");
printf '%s\n' "add-highlighter shared/scheme/code/ regex \"$1\" $2" add_highlighter(non_word_chars "+('" identifier_chars ")", "1:attribute");
} add_highlighter("\\(define\\W+\\((" identifier_chars ")", "1:function");
add_highlighter("\\(define\\W+(" identifier_chars ")\\W+\\(lambda", "1:function");
add_highlighter "${non_word_chars}+(${qkeys})${non_word_chars}" "1:keyword" }
add_highlighter "${non_word_chars}+(${qmeta})${non_word_chars}" "1:meta" EOF
add_highlighter "${non_word_chars}+(${qops})${non_word_chars}" "1:operator"
add_highlighter "${non_word_chars}+(${qbuiltins})${non_word_chars}" "1:builtin"
add_highlighter "${non_word_chars}+('${identifier_chars})" "1:attribute"
add_highlighter "${non_word_chars}+(${qtypes})${non_word_chars}" "1:type"
add_highlighter "\(define\W+\(($identifier_chars)" "1:function"
add_highlighter "\(define\W+($identifier_chars)\W+\(lambda" "1:function"
} }
# Initialization # Initialization