├── docs ├── skipmake ├── setup_vim.def ├── mydef.vim ├── block_release.txt ├── blockscope.txt └── mydef_run.md ├── run ├── skipmake ├── config └── run_tex.def ├── deflib ├── skipmake ├── std_general.def ├── perl │ ├── apl.def │ ├── indentations.def │ ├── topsort.def │ ├── extra.def │ ├── html.def │ ├── gnuplot_extra.def │ ├── parse_utils.def │ ├── make_dist.def │ ├── statistics.def │ ├── parse.def │ └── permutation.def ├── std_make.def ├── ansi_color.def ├── constants.def ├── ext.def └── std_perl.def ├── manual ├── skipmake ├── mydef.def ├── output_general.def └── intro.def ├── macros_compile ├── skipmake ├── list.def └── ogdl.def ├── macros_output ├── skipmake ├── types.def ├── perl_like.def ├── case.def ├── scope.def ├── for.def ├── print.def └── sumcode.def ├── config ├── tests ├── inc │ ├── template_inc.txt │ ├── template.txt │ └── inc.def ├── apple_test.def ├── perl_eval.def ├── make_test.def ├── TESTS ├── perl_preproc.def ├── general_test.def ├── prolog.def ├── perl_apl.def ├── perl_while.def ├── general_output.def ├── general_macro_split.def ├── page.def ├── general_macro_concat.def ├── general_macro_dynamic.def ├── perl_callback.def ├── perl_foreach.def ├── perl_input.def ├── general_sub_optional.def ├── general_subcode_arg.def ├── perl_std.def ├── perl_cur_line.def ├── perl_pm.def ├── perl_func_arg.def ├── general_macro_preset.def ├── perl_loop_else.def ├── general_points.def ├── perl_topsort.def ├── general_macro_export.def ├── perl_callsub.def ├── perl_expand_macro.def ├── general_plugin.def ├── perl_for.def ├── general_template.def ├── general_stub.def ├── xs_test.def ├── general_autoload.def ├── perl_ellipses.def ├── perl_regex.def ├── general_subcode.def ├── perl_function.def ├── perl_multi_blocks.def ├── general_callsub.def ├── perl_params.def ├── parse_test.def ├── perl_print.def ├── general_include.def ├── general_ext.def ├── general_parse.def ├── general_fibonacci.def ├── general_macro_special.def ├── general_comment.def ├── perl_STUB.def ├── general_preproc.def ├── perl_permutation.def ├── general_macros.def ├── perl_mydef_utils.def ├── perl_template.def ├── perl_ext.def ├── perl_test.def ├── perl_loop.def └── perl_macros.def ├── .gitmodules ├── install_def.sh ├── dist ├── make_dist.def └── manifest ├── CITATION.cff ├── output_general.def ├── version.def ├── .github └── workflows │ └── test.yml ├── macros_util ├── debug.def ├── path.def ├── makestring.def ├── ogdl.def └── resource.def ├── mydef_test.def ├── macros_make ├── makefile_perl.def └── makefile_c.def ├── macros_parse ├── legacy.def ├── include.def ├── template.def ├── default_page.def ├── macros.def ├── hacks.def ├── indentation.def └── debug.def ├── mydef_update.def ├── modules.def ├── mydef_debug.def ├── macros_ext └── grab_file.def ├── mydef_decl.def ├── old └── set_macro_join.def ├── bootstrap.sh ├── Guide.md ├── mydef.def ├── mydef_ext.def ├── dumpout.def ├── mydef_page.def ├── README.md ├── compileutil.def └── mydef_install.def /docs/skipmake: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /run/skipmake: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /deflib/skipmake: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /manual/skipmake: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /macros_compile/skipmake: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /macros_output/skipmake: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /deflib/std_general.def: -------------------------------------------------------------------------------- 1 | 2 | 3 | -------------------------------------------------------------------------------- /config: -------------------------------------------------------------------------------- 1 | output_dir: out 2 | module: perl 3 | -------------------------------------------------------------------------------- /run/config: -------------------------------------------------------------------------------- 1 | output_dir: out 2 | module: perl 3 | -------------------------------------------------------------------------------- /tests/inc/template_inc.txt: -------------------------------------------------------------------------------- 1 | INCLUDE another template_inc.txt 2 | -------------------------------------------------------------------------------- /tests/apple_test.def: -------------------------------------------------------------------------------- 1 | page: test, basic_frame 2 | subcode: appmain 3 | 4 | 5 | -------------------------------------------------------------------------------- /deflib/perl/apl.def: -------------------------------------------------------------------------------- 1 | subcode: array(a, @shape) 2 | $global @$(a), @$(a)_dim=($(shape)) 3 | -------------------------------------------------------------------------------- /tests/inc/template.txt: -------------------------------------------------------------------------------- 1 | $call @A 2 | DUMP_STUB _A 3 | $template inc/template_inc.txt 4 | TEMPLATE 5 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "mydef_boot"] 2 | path = mydef_boot 3 | url = https://github.com/hzhou/mydef_boot 4 | -------------------------------------------------------------------------------- /install_def.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | mydef_install deflib . def 4 | mydef_install out/lib . pm 5 | mydef_install out/script . - 6 | 7 | -------------------------------------------------------------------------------- /dist/make_dist.def: -------------------------------------------------------------------------------- 1 | include: perl/make_dist.def 2 | 3 | page: make_dist 4 | module: perl 5 | arg: 1.0.1 6 | 7 | $call make_dist, mydef 8 | -------------------------------------------------------------------------------- /tests/perl_eval.def: -------------------------------------------------------------------------------- 1 | page: t 2 | module: perl 3 | 4 | 5 | eval('my $x = 1; print "x = $x\n";') 6 | eval('print x = "$x\n";') 7 | 8 | -------------------------------------------------------------------------------- /tests/make_test.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: general 3 | type: 4 | 5 | subcode: main 6 | target: prerequisite 7 | TAB recipe 8 | -------------------------------------------------------------------------------- /tests/TESTS: -------------------------------------------------------------------------------- 1 | general_include.def 2 | general_autoload.def 3 | general_macros.def 4 | general_macro_special.def 5 | general_stub.def 6 | general_ext.def 7 | perl_for.def 8 | -------------------------------------------------------------------------------- /tests/perl_preproc.def: -------------------------------------------------------------------------------- 1 | page: test 2 | DEBUG preproc 3 | $(set:t=>test) 4 | $(if:t~>t) 5 | $print Match 6 | $(else) 7 | $print misMatch 8 | -------------------------------------------------------------------------------- /tests/general_test.def: -------------------------------------------------------------------------------- 1 | page: test 2 | line 1 3 | line 2 4 | $call more 5 | 6 | subcode: more 7 | oh, there are more lines 8 | line 3 9 | line 4 10 | -------------------------------------------------------------------------------- /tests/prolog.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: general 3 | type: prolog 4 | 5 | fac(n, 1) :- n<2. 6 | fac(n, X) :- n1 is n-1, fac(n1,Y), X is n*Y 7 | 8 | ?- fac(10, ans) 9 | -------------------------------------------------------------------------------- /tests/perl_apl.def: -------------------------------------------------------------------------------- 1 | include: perl/apl.def 2 | 3 | #- we need work out a array dimension system 4 | 5 | page: test 6 | # $call array, a, 10 7 | $sumcode(10) $a[i]=i*i 8 | print "@a\n" 9 | -------------------------------------------------------------------------------- /tests/perl_while.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: perl 3 | my $count=10 4 | $while $count>0; $count-- 5 | $print count: $count 6 | 7 | $(for:a-z and 1-) 8 | $print $1 - $2 9 | -------------------------------------------------------------------------------- /tests/general_output.def: -------------------------------------------------------------------------------- 1 | page: t.out 2 | module: general 3 | 4 | The output file should be t.out, not t.out.txt 5 | 6 | /* expect t.out: 7 | The output file should be t.out, not t.out.txt 8 | */ 9 | -------------------------------------------------------------------------------- /tests/general_macro_split.def: -------------------------------------------------------------------------------- 1 | page: test 2 | A:1,2,3 3 | 4 | $(split:A) 5 | $(p_n) parts: 1: $(p_1), 2: $(p_2), 3: $(p_3) 6 | 7 | /* expect test.txt: 8 | 3 parts: 1: 1, 2: 2, 3: 3 9 | */ 10 | -------------------------------------------------------------------------------- /tests/inc/inc.def: -------------------------------------------------------------------------------- 1 | subcode: inc_test 2 | FROM inc_test 3 | 4 | subcode: inc_test_2 5 | FROM inc_test_2 6 | 7 | macros: 8 | msg: msg: defined in inc.def 9 | msg2: msg2: defined in inc.def 10 | 11 | -------------------------------------------------------------------------------- /deflib/std_make.def: -------------------------------------------------------------------------------- 1 | 2 | subcode: check_make_version(ver) 3 | $ifneq_ (${firstword ${sort ${MAKE_VERSION} $(ver)}},$(ver)) 4 | ${error You have make '${MAKE_VERSION}' installed. GNU make >= $(ver) is required} 5 | 6 | -------------------------------------------------------------------------------- /tests/page.def: -------------------------------------------------------------------------------- 1 | subcode: do_test 2 | $print Hello world! 3 | 4 | subcode: test2 5 | $print test 2 6 | 7 | page: test 8 | type: pl 9 | subcode: main 10 | $call do_test 11 | $call test2 12 | -------------------------------------------------------------------------------- /deflib/ansi_color.def: -------------------------------------------------------------------------------- 1 | macros: 2 | ANSI_RESET: \033[0m 3 | ANSI_RED: \033[31m 4 | ANSI_GREEN: \033[32m 5 | ANSI_YELLOW: \033[33m 6 | ANSI_BLUE: \033[34m 7 | ANSI_MAGENTA: \033[35m 8 | ANSI_CYAN: \033[36m 9 | -------------------------------------------------------------------------------- /CITATION.cff: -------------------------------------------------------------------------------- 1 | cff-version: 1.2.0 2 | message: "If you use this software, please cite it as below." 3 | authors: 4 | - family-names: Zhou 5 | given-names: Hui 6 | title: "MyDef - A Generic Preprocessor" 7 | url: https://github.com/hzhou/mydef 8 | -------------------------------------------------------------------------------- /tests/general_macro_concat.def: -------------------------------------------------------------------------------- 1 | page: t 2 | module: general 3 | $(a) 4 | 5 | macros: 6 | a:: 7 | a:: a, b, c 8 | a:: d, e, f 9 | a:: 10 | a:: g, h, i 11 | 12 | /* expect t.txt: 13 | a, b, c, d, e, f, g, h, i 14 | */ 15 | -------------------------------------------------------------------------------- /dist/manifest: -------------------------------------------------------------------------------- 1 | *.def 2 | config 3 | 4 | macros_compile 5 | macros_make 6 | macros_parse 7 | macros_util 8 | macros_output 9 | 10 | bootstrap 11 | bootstrap.sh 12 | install_def.sh 13 | 14 | README.md 15 | docs 16 | manual 17 | deflib 18 | tests 19 | -------------------------------------------------------------------------------- /output_general.def: -------------------------------------------------------------------------------- 1 | include: output.def 2 | 3 | page: output_general, output_main 4 | type: pm 5 | output_dir: lib/MyDef 6 | ext: txt 7 | package: MyDef::output_general 8 | 9 | subcode: parsecode 10 | $call parsecode_common 11 | -------------------------------------------------------------------------------- /tests/general_macro_dynamic.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: general 3 | 4 | $(set:a=A) 5 | $(set:$(a)_flag=flag for $(a)) 6 | [ $(A_flag) ] 7 | [ $($(a)_flag) ] 8 | 9 | /* expect test.txt: 10 | [ flag for A ] 11 | [ flag for A ] 12 | */ 13 | -------------------------------------------------------------------------------- /tests/perl_callback.def: -------------------------------------------------------------------------------- 1 | page: test 2 | &call2 muti_callback 3 | $print print this first 4 | second: 5 | $print ... this next 6 | 7 | 8 | subcode: muti_callback 9 | BLOCK1 10 | $print -- between BLOCK1 and BLOCK2 11 | BLOCK2 12 | -------------------------------------------------------------------------------- /tests/perl_foreach.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: perl 3 | 4 | my @a=1..10 5 | $foreach $t in @a 6 | $print $t 7 | 8 | my @b='a'..'j' 9 | $foreach $t, $i in @b 10 | $print $i: $t 11 | 12 | $foreach $a, $b in @a, @b 13 | $print $a - $b 14 | 15 | -------------------------------------------------------------------------------- /tests/perl_input.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: perl 3 | 4 | $print ---- \@lines ----\n 5 | $call get_file_lines, inc/inc.def 6 | $print @lines 7 | 8 | $print ---- \@A ----\n 9 | $call get_file_lines, inc/inc.def, @A 10 | $foreach $l in @A 11 | $print $l- 12 | -------------------------------------------------------------------------------- /version.def: -------------------------------------------------------------------------------- 1 | macros: 2 | version: development 3 | date: latest 4 | 5 | subcode: check_arg_version(a) 6 | $case $(a) eq "-v" or $(a) eq "--version" 7 | my $prog=$0 8 | $prog=~s/^.*\/// 9 | $print $prog: version $(version) - $(date)" 10 | exit(0) 11 | -------------------------------------------------------------------------------- /tests/general_sub_optional.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: general 3 | 4 | $call A, Hello 5 | $call A, Hello, World 6 | 7 | subcode: A(a, @b) 8 | $(if:b) 9 | $(a) - $(b) 10 | $(else) 11 | $(a) 12 | 13 | /* expect out/test.txt: 14 | Hello 15 | Hello - World 16 | */ 17 | -------------------------------------------------------------------------------- /tests/general_subcode_arg.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: general 3 | 4 | $call A, Hello world! 5 | $call A 6 | 7 | subcode: A(@arg) 8 | $(if:arg) 9 | A with arg: $(arg) 10 | $(else) 11 | A without arg 12 | 13 | /* expect test.txt: 14 | A with arg: Hello world! 15 | A without arg 16 | */ 17 | -------------------------------------------------------------------------------- /tests/perl_std.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: perl 3 | 4 | my $t = "A (int a, char *s) {" 5 | $if $t=~/$(RE_PAREN)/ -> $p 6 | $print Got [$p] 7 | 8 | subcode:: gone_ 9 | # fncode: bases defined in std_perl.def 10 | my @t = bases(10000, 60, 60, 24) 11 | print join(":", reverse @t), "\n" 12 | -------------------------------------------------------------------------------- /tests/perl_cur_line.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: perl 3 | 4 | $call A 5 | $if 1 6 | $print 1 7 | $print 2 8 | my $a=1 9 | # a comment 10 | $a=2 11 | $a=3 12 | $a=4 13 | $if 1 14 | $print 3 15 | $print 4 16 | 17 | subcode: A 18 | $print A1 19 | $print A2 20 | -------------------------------------------------------------------------------- /tests/perl_pm.def: -------------------------------------------------------------------------------- 1 | module: perl 2 | page: test 3 | package: test 4 | 5 | fncode: test($t) 6 | $print test: $t 7 | 8 | 9 | /* expect test.pm: 10 | use strict; 11 | package test; 12 | 13 | # ---- subroutines -------------------------------------------- 14 | sub test { 15 | my ($t) = @_; 16 | print "test: $t\n"; 17 | } 18 | 19 | 1; 20 | */ 21 | -------------------------------------------------------------------------------- /tests/perl_func_arg.def: -------------------------------------------------------------------------------- 1 | page: test 2 | $global $a 3 | $a=10 4 | test($a) 5 | test_arg("Something") 6 | test_arg() 7 | 8 | fncode: test($t) 9 | print "test: $t\n" 10 | 11 | fncode: test_2(t) 12 | autolist: 1 13 | $print "backup function: test_2 - $(t)\n" 14 | 15 | fncode: test_arg($a="default") 16 | $print test_arg: [$a] 17 | -------------------------------------------------------------------------------- /tests/general_macro_preset.def: -------------------------------------------------------------------------------- 1 | page: t 2 | _pagename = $(_pagename) 3 | _pageext = $(_pageext) 4 | _outdir = $(_outdir) 5 | 6 | _defname = $(_defname) 7 | _deffile = $(_deffile) 8 | 9 | /* expect t.txt: 10 | _pagename = t 11 | _pageext = txt 12 | _outdir = . 13 | _defname = general_macro_preset 14 | _deffile = general_macro_preset.def 15 | */ 16 | -------------------------------------------------------------------------------- /tests/perl_loop_else.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: perl 3 | 4 | # ref: macros_compile/util.def 5 | # ... => DUMP_STUB stub_$stub_idx 6 | # $(block:...) => $(block:$(stub)) 7 | ... 8 | $for $i=10 9 | $if $i==5 10 | break flag_found 11 | $if $i==7 12 | break flag_found 13 | 14 | $if $flag_found 15 | $print Found 5! 16 | -------------------------------------------------------------------------------- /tests/general_points.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: general 3 | type: txt 4 | setpoint_format: (%.2f, %.2f) 5 | 6 | $(setpoint:A=1, 1) 7 | $(setpoint:B=A .xy 0.5, -0.5) 8 | $(setpoint:C=(0, 1) .rot 45) 9 | $(A) 10 | $(B) 11 | $(C) 12 | $(setpoint:A=-60:1) 13 | $(A) 14 | 15 | /* expect test.txt: 16 | (1.00, 1.00) 17 | (1.50, 0.50) 18 | (-0.71, 0.71) 19 | (0.50, -0.87) 20 | */ 21 | -------------------------------------------------------------------------------- /tests/perl_topsort.def: -------------------------------------------------------------------------------- 1 | include: perl/topsort.def 2 | 3 | page: test 4 | module: perl 5 | 6 | # example from wikipedia: topological sorting 7 | my @tlist = (2,3,5,7,8,9,10,11) 8 | my %H 9 | $H{2}=[11] 10 | $H{8}=[3,7] 11 | $H{9}=[8,11] 12 | $H{10}=[3,11] 13 | $H{11}=[5,7] 14 | 15 | $print "input: @tlist" 16 | my $L=top_sort(\@tlist, \%H) 17 | $print "output: @$L" 18 | -------------------------------------------------------------------------------- /tests/general_macro_export.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: general 3 | 4 | $call set_a 5 | $call test_basic 6 | 7 | subcode: set_a 8 | setting a... 9 | # $(export:a=1) 10 | $(set-1:a=1) 11 | # $(set-2:a=1) 12 | 13 | #----------------------------------------------- 14 | subcode: test_basic 15 | a: [$(a)] 16 | 17 | /* expect test.txt: 18 | setting a... 19 | a: [1] 20 | */ 21 | -------------------------------------------------------------------------------- /tests/perl_callsub.def: -------------------------------------------------------------------------------- 1 | module: perl 2 | page: test 3 | $print test \$map P1 ... 4 | $map P1, 1,2,3,4 5 | 6 | $print test \$map P(pre) ... 7 | $map P("^2 = "), 1,2,3,4 8 | 9 | $print test \$map2 P2 ... 10 | $map2 P2, 1,1, 2,4, 3,9, 4,16 11 | 12 | subcode: P1(a) 13 | print "$(a) -> ", $(a)**2, "\n" 14 | 15 | subcode: P(sym, a) 16 | print $(a), $(sym), $(a)**2, "\n" 17 | 18 | subcode: P2(a, b) 19 | $print $(a) -> $(b) 20 | -------------------------------------------------------------------------------- /tests/perl_expand_macro.def: -------------------------------------------------------------------------------- 1 | page: test 2 | DEBUG macro 3 | $(set:a=test) 4 | $(set:b=hello $1) 5 | $(set:c=a) 6 | 7 | $(set:this=Oh, ) 8 | 9 | $print this macro [$.] 10 | $print nested inline macro $(b:$(a)) 11 | $print nested macro [$($(c))] 12 | 13 | $print undefined macro [$(that)] 14 | 15 | $(set:V=$($1)) 16 | $print no double expand: \$(V:CFLAGS) 17 | 18 | $(set:π=$pi) 19 | my π = 3.14 20 | $print symbol macro: Π = π 21 | -------------------------------------------------------------------------------- /tests/general_plugin.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: general 3 | 4 | $plugin A, &D 5 | $plugin(B) C 6 | $A a 7 | $B b 8 | $D test 9 | text 10 | 11 | subcode: A(t) 12 | A: $(t) 13 | 14 | perlcode: C 15 | my $t = "[$param]" 16 | push @$out, "C: $t" 17 | 18 | subcode: D(t) 19 | plugin block with param $(t): 20 | BLOCK 21 | end plugin 22 | 23 | /* expect test.txt: 24 | A: a 25 | C: [b] 26 | plugin block with param test: 27 | text 28 | end plugin 29 | */ 30 | -------------------------------------------------------------------------------- /tests/perl_for.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: perl 3 | 4 | $call test_for, 4 5 | $call test_for, $i=0:4 6 | $call test_for, 1 to 4 7 | $call test_for, 4 downto 1 8 | 9 | subcode: test_for(@p) 10 | $print " %-20s: -", '$for $(p)' 11 | $for $(p) 12 | $print "$i -" 13 | $print 14 | 15 | /* expect output: 16 | $for 4 : 0 1 2 3 17 | $for $i=0:4 : 0 1 2 3 18 | $for 1 to 4 : 1 2 3 4 19 | $for 4 downto 1 : 4 3 2 1 20 | */ 21 | -------------------------------------------------------------------------------- /tests/general_template.def: -------------------------------------------------------------------------------- 1 | page: test, from inc/template.txt 2 | NEWLINE? 3 | Hello 4 | $call T 5 | # ************************* 6 | # $template inc/template.txt 7 | 8 | template: T 9 | ---- 1 10 | template: T 11 | ---- 2 12 | 13 | subcode: A 14 | test $call in template 15 | $(block:_A) 16 | test DUMP_STUB in template 17 | 18 | /* expect test.txt: 19 | test $call in template 20 | test DUMP_STUB in template 21 | INCLUDE another template_inc.txt 22 | TEMPLATE 23 | Hello 24 | ---- 1 25 | */ 26 | -------------------------------------------------------------------------------- /docs/setup_vim.def: -------------------------------------------------------------------------------- 1 | page: t 2 | module: perl 3 | 4 | my $cwd = `pwd` 5 | chomp $cwd 6 | my $home = $ENV{HOME} 7 | 8 | $if !-d "$home/.vim" 9 | mkdir "$home/.vim" 10 | $if !-d "$home/.vim/syntax" 11 | mkdir "$home/.vim/syntax" 12 | 13 | open Out, ">>$home/.vim/filetype.vim" 14 | print Out "augroup filetypedetect\n" 15 | print Out "au BufNewFile,BufRead *.def setf mydef\n" 16 | print Out "augroup END\n" 17 | close Out 18 | 19 | system "ln -s $cwd/mydef.vim $home/.vim/syntax/" 20 | 21 | -------------------------------------------------------------------------------- /tests/general_stub.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: general 3 | 4 | $(block:_A) 5 | a1 6 | DUMP_STUB _A 7 | $(block:_A) 8 | a2 9 | 10 | ->[ {STUB} ] 11 | $(block:STUB) 12 | b1 13 | b2 14 | 15 | ->[ {STUB} ] 16 | --- 17 | $(block:STUB:,) 18 | b1 19 | b2 20 | 21 | -> $(stub:; :make_string) 22 | 23 | bypasscode: make_string 24 | a 25 | b 26 | c 27 | /* expect test.txt: 28 | a1 29 | a2 30 | ->[ b1 b2 ] 31 | ->[ b1,b2 ] 32 | --- 33 | -> a; b; c 34 | */ 35 | -------------------------------------------------------------------------------- /tests/xs_test.def: -------------------------------------------------------------------------------- 1 | # TEST: test_xs::test("Hui Zhou"); 2 | # TEST: my @a; for(my $i=2;$i<10;$i++){push @a, $i*$i;} test_xs::test_array(\@a); 3 | 4 | page: test_xs, basic_frame 5 | subcode: xs_main 6 | $list test, test_array 7 | 8 | fncode: test(s_name) 9 | $global sv_global 10 | sv_global=newSV(0) 11 | sv_setiv(sv_global, 100) 12 | printf("Hello, %s! %d wishes\n", s_name, SvIV(sv_global)) 13 | 14 | fncode: test_array(av_list) 15 | $foreach tn in av_list 16 | printf(" %4d ", tn) 17 | printf("\n") 18 | 19 | -------------------------------------------------------------------------------- /tests/general_autoload.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: general 3 | type: txt 4 | 5 | Main Text 6 | $call post 7 | 8 | subcode: _autoload 9 | autoload 1 10 | 11 | subcode: _autoload 12 | autoload 2 13 | $call autoload_sub 14 | 15 | subcode: autoload_sub 16 | autoload_sub 17 | 18 | subcode: post 19 | Post 20 | $call post_sub 21 | 22 | subcode: post_sub 23 | post_sub 24 | 25 | /* expect test.txt: 26 | autoload 1 27 | autoload 2 28 | autoload_sub 29 | Main Text 30 | Post 31 | post_sub 32 | */ 33 | -------------------------------------------------------------------------------- /tests/perl_ellipses.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: perl 3 | 4 | ... 5 | $for $i=0:100 6 | $if $i% 5 ==0 7 | $(block:...) 8 | my $cnt_5 9 | $cnt_5++ 10 | $call check_mod_3 11 | $call check_mod_7 12 | $(for:3,5,7) 13 | $print count $1: $cnt_$1 14 | 15 | subcode: check_mod_3 16 | $if $i % 3 == 0 17 | $(block:...) 18 | my $cnt_3 19 | $cnt_3++ 20 | 21 | subcode: check_mod_7 22 | $if $i % 7 == 0 23 | $loopvar $cnt_7=0 24 | $cnt_7++ 25 | -------------------------------------------------------------------------------- /tests/perl_regex.def: -------------------------------------------------------------------------------- 1 | /* 2 | include: perl/parse_regex.def 3 | 4 | page: test 5 | my $r=parse_regex("ab(c|de)*") 6 | debug_regex($r) 7 | */ 8 | 9 | 10 | page: test 11 | module: perl 12 | 13 | $_ = "Hello Default!" 14 | $if /Hello (\w+)/ -> $name 15 | $print Hello [$name] 16 | 17 | my $s = "Hello world!" 18 | $if $s=~/Hello (\w+)(.*)/ -> $name, $period 19 | $print Hello [$name] - $period 20 | 21 | 22 | $global $period 23 | $if /Hello (\w+)(.*)/ -> $name, $period* 24 | $print Hello [$name] 25 | 26 | $print Got period - [$period] 27 | 28 | -------------------------------------------------------------------------------- /tests/general_subcode.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: general 3 | 4 | $call A 5 | $call B 6 | 7 | # 0 -- default, gets overwritten 8 | # 1-8 -- merge 9 | # 9 -- always overwrite, default, warns 10 | 11 | subcode: B 12 | B9_1 13 | 14 | subcode:0 A 15 | A0 16 | 17 | subcode:7 A 18 | A7 19 | 20 | subcode:2 A 21 | A2 22 | 23 | subcode:: A 24 | A5 25 | 26 | subcode:1 A 27 | A1 28 | 29 | subcode:8 A 30 | A8 31 | 32 | subcode:9 B 33 | B9_2 34 | 35 | subcode: B 36 | B9_3 37 | 38 | /* expect test.txt: 39 | A1 40 | A2 41 | A5 42 | A7 43 | A8 44 | B9_3 45 | */ 46 | -------------------------------------------------------------------------------- /tests/perl_function.def: -------------------------------------------------------------------------------- 1 | page: test 2 | $global $a 3 | $a=10 4 | test($a) 5 | 6 | fncode: test($t) 7 | print "test: $t\n" 8 | 9 | fncode: test_2(t) 10 | autolist: 1 11 | $print "backup function: test_2 - $(t)\n" 12 | 13 | /* expect test.pl: 14 | #!/usr/bin/perl 15 | use strict; 16 | 17 | our $a; 18 | 19 | $a=10; 20 | test($a); 21 | 22 | # ---- subroutines -------------------------------------------- 23 | sub test { 24 | my ($t) = @_; 25 | print "test: $t\n"; 26 | } 27 | 28 | sub test_2 { 29 | my ($t) = @_; 30 | print "backup function: test_2 - $t\n"; 31 | } 32 | */ 33 | -------------------------------------------------------------------------------- /tests/perl_multi_blocks.def: -------------------------------------------------------------------------------- 1 | page: test 2 | &call test_multiblock 3 | $print $(msg) 4 | 5 | $print 6 | $(if:1) 7 | &call2 test_multiblock_2 8 | $print this is block 1 9 | 2: 10 | $print this is block 2 11 | 12 | subcode: test_multiblock 13 | $if 1 14 | $(set:msg=test 1) 15 | BLOCK 16 | $elif 1 17 | $(set:msg=test 2) 18 | BLOCK 19 | $else 20 | $(set:msg=test 3) 21 | BLOCK 22 | 23 | $(set:msg=print anyway) 24 | BLOCK 25 | 26 | subcode: test_multiblock_2 27 | BLOCK1 28 | $print ============ 29 | BLOCK2 30 | -------------------------------------------------------------------------------- /tests/general_callsub.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: general 3 | 4 | &call A 5 | Hello 6 | 7 | &call B 8 | Hello 9 | 10 | &call C 11 | Hello 12 | 13 | D -- 14 | &call @D 15 | Hello 16 | 17 | subcode: A 18 | A -- 19 | BLOCK 20 | A -- 21 | 22 | subcode: B 23 | # multiblock 24 | B -- 25 | BLOCK 26 | B -- 27 | BLOCK 28 | B -- 29 | 30 | subcode: C 31 | $(for:1-2) 32 | C$1 33 | BLOCK 34 | /* expect test.txt: 35 | A -- 36 | Hello 37 | A -- 38 | B -- 39 | Hello 40 | B -- 41 | Hello 42 | B -- 43 | C1 44 | Hello 45 | C2 46 | Hello 47 | D -- 48 | Hello 49 | */ 50 | -------------------------------------------------------------------------------- /tests/perl_params.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: perl 3 | $(for:0-7) 4 | $call A$1, a, b 5 | 6 | subcode: A0 7 | $print Error: extra : [] 8 | 9 | subcode: A1(p1) 10 | $print Error: extra : [$(p1)] 11 | 12 | subcode: A2(p1, p2) 13 | $print exact: [$(p1) - $(p2)] 14 | 15 | subcode: A3(@a) 16 | $print Slurp - $(a) 17 | 18 | subcode: A4(@p1, @p2) 19 | $print $(p1) - $(p2) 20 | 21 | subcode: A5(a, @p1, @p2) 22 | $print [$(a)] - $(p1) - $(p2) 23 | 24 | subcode: A6(a, b, @p1, @p2) 25 | $print [$(a) - $(b)] - $(p1) - $(p2) 26 | 27 | subcode: A7(a, b, c, @p1, @p2) 28 | $print Error: missing : [$(a) - $(b) - $(c)] - $(p1) - $(p2) 29 | -------------------------------------------------------------------------------- /tests/parse_test.def: -------------------------------------------------------------------------------- 1 | # DEBUG def 2 | 3 | subcode: A1 4 | top def 5 | 6 | #----------------------------------------------- 7 | page: test, basicframe, p1, p2 8 | module: general 9 | direct main code 10 | $call B1 11 | 12 | subcode: main 13 | real main 14 | 15 | still main code 16 | 17 | 18 | subcode: B1 19 | $call b1 20 | subcode: b1 21 | belongs to B1 22 | subcode: b2 23 | something 24 | subcode: c1 25 | subcode: c2 26 | test 27 | 28 | subcode: basicframe(p1, @p2) 29 | frame $(p1) - $(p2) 30 | ---- main ---- 31 | $call main 32 | ---- main2 ---- 33 | $call main2 34 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: test 2 | 3 | on: [push] 4 | 5 | jobs: 6 | build: 7 | 8 | runs-on: ubuntu-latest 9 | 10 | steps: 11 | - uses: actions/checkout@v1 12 | - name: bootstrap 13 | run: | 14 | git submodule update --init 15 | sh bootstrap.sh all 16 | - name: test 17 | env: 18 | PATH: $HOME/bin:$PATH 19 | PERL5LIB: $HOME/lib/perl5 20 | MYDEFLIB: $HOME/lib/MyDef 21 | MYDEFSRC: $PWD 22 | run: | 23 | export PATH=$HOME/bin:/usr/bin:/bin 24 | export PERL5LIB=$HOME/lib/perl5 25 | export MYDEFLIB=$HOME/lib/MyDef 26 | export MYDEFSRC=$PWD 27 | cd tests; mydef_test 28 | -------------------------------------------------------------------------------- /macros_util/debug.def: -------------------------------------------------------------------------------- 1 | /* 2 | subcode: dump_array(a) 3 | print "Dump array $(a)\n" 4 | $foreach my $t in @$(a) 5 | print " ", $t, "\n" 6 | 7 | subcode: dump_hash(h) 8 | print "Dump hash $(h)\n" 9 | $while my ($k, $v) = each %$(h) 10 | print " ", "$k: $v\n" 11 | */ 12 | 13 | subcode: dump_line(name) 14 | my $yellow="\033[33;1m"; 15 | my $normal="\033[0m"; 16 | print "$yellow $(name): [$l]$normal\n" 17 | 18 | subcode: dump_def 19 | print "Dump def $def\n" 20 | $while my ($k, $v) = each %$def 21 | print " ", "$k: $v\n" 22 | $if $k eq "codes" 23 | $while my ($k2, $v2) = each %$v 24 | print " ", $v2->{type}, "code: $k2\n" 25 | 26 | -------------------------------------------------------------------------------- /tests/perl_print.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: perl 3 | $print plain string "with quotes" in it 4 | $print plain string $green{with color} in it 5 | $print "format: %4d°C = %4.1f°F", 100, 100*9/5+32 6 | $(set:print_to=STDOUT) 7 | $print "print_to=STDOUT with concatenation ". 2**10 ." (should work as long as quoted overall)" 8 | 9 | my @out 10 | $(set:print_to=@out) 11 | $print "out 1" 12 | $print "out %d", 2 13 | $foreach $l in @out 14 | print $l 15 | 16 | /* expect output: 17 | plain string "with quotes" in it 18 | plain string \x1b[32mwith color\x1b[0m in it 19 | format: 100°C = 212.0°F 20 | print_to=STDOUT with concatenation 1024 (should work as long as quoted overall) 21 | out 1 22 | out 2 23 | */ 24 | -------------------------------------------------------------------------------- /tests/general_include.def: -------------------------------------------------------------------------------- 1 | include: notfound.def 2 | include: hello.def? 3 | include: inc/inc.def 4 | 5 | page: test 6 | module: general 7 | $(msg) 8 | $(msg2) 9 | $call inc_test 10 | $call inc_test_2 11 | 12 | subcode: inc_test_2 13 | First come first stay 14 | 15 | macros: 16 | msg2: msg2: defined in main 17 | 18 | /* error message: 19 | notfound.def not found 20 | search path: ... 21 | Not overwriting subcode inc_test_2: ... 22 | */ 23 | 24 | /* expect test.txt: 25 | msg: defined in inc.def 26 | msg2: defined in main 27 | FROM inc_test 28 | First come first stay 29 | */ 30 | 31 | /* note: 32 | std_xxx.def is always included, but it may be shadowed by putting a std_xxx.def in your include_path or current path 33 | */ 34 | 35 | -------------------------------------------------------------------------------- /tests/general_ext.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: general 3 | 4 | $(set:M=codelist) 5 | &call codelist 6 | $(M) 7 | 8 | $call inject_sub 9 | $call @test_inject_sub 10 | 11 | $call run_src 12 | 13 | perlcode: codelist 14 | require MyDef::ext 15 | my $codelist = MyDef::ext::grab_codelist(do_macro=>1) 16 | $foreach @$codelist 17 | push @$out, "TEST $_" 18 | 19 | 20 | perlcode: inject_sub 21 | my @src=("TEST inject_sub") 22 | require MyDef::ext 23 | MyDef::ext::inject_sub("test_inject_sub", \@src) 24 | 25 | perlcode: run_src 26 | my @src=("TEST run_src") 27 | require MyDef::ext 28 | MyDef::ext::run_src(\@src) 29 | 30 | /* expect test.txt: 31 | TEST codelist 32 | TEST inject_sub 33 | TEST run_src 34 | */ 35 | -------------------------------------------------------------------------------- /deflib/constants.def: -------------------------------------------------------------------------------- 1 | macros: 2 | pi: 3.1415926535897932 3 | pi4: 3.1415927 4 | to_rad: 0.0174532925199 5 | to_deg: 57.2957795131 6 | 7 | e: 2.7182818284 8 | ln10: 2.30258509299 9 | sqrt2: 1.4142135623 10 | phi: 1.61803398874 11 | 12 | c: 299792458 # m/s 13 | h: 6.62606957e-34 # J s 14 | hbar: 1.054571726e-34 # J s 15 | N: 6.02214129e23 # Avogadro's number (/mol) 16 | k: 1.3806488e-23 # J/K 17 | 18 | miu0: 1.256637061e-6 # N/A2 4pi e-7 19 | eps0: 8.854187817e-12 # F/m 1/miu0/c2 20 | q: 1.602176565e-19 # elementary charge (C) 21 | 22 | m0: 9.10938291e-31 # electron mass (kg) 23 | a0: 5.2917721092e-11 # Bohr radius (m) 24 | Eh: 4.35974434e-18 # Hartree energy (J) 25 | -------------------------------------------------------------------------------- /tests/general_parse.def: -------------------------------------------------------------------------------- 1 | macros: 2 | m1: a 3 | m2: b 4 | 5 | page: test, test_sub 6 | attr1: a 7 | attr2: b 8 | 9 | line 1 10 | line 2 11 | 12 | page: test2 13 | attr1: a 14 | attr2: b 15 | 16 | subcode: main 17 | line 1 18 | line 2 19 | macros: 20 | m3: a 21 | m4: b 22 | 23 | subcode: A 24 | outside 1 25 | outside 2 26 | 27 | DEBUG code: test_sub 28 | subcode: test_sub 29 | macros: 30 | B: A 31 | test 1 32 | test 2 33 | &call $(B) 34 | C1 35 | C2 36 | 37 | subcode: A 38 | A1 39 | A2 40 | B1 41 | BLOCK 42 | B2 43 | 44 | resource: root 45 | name1: a 46 | name2: b 47 | name3: 48 | a, b, c 49 | d, e, f 50 | -------------------------------------------------------------------------------- /mydef_test.def: -------------------------------------------------------------------------------- 1 | page: mydef_test 2 | module: perl 3 | output_dir: script 4 | type: 5 | 6 | $if !-f "TESTS" 7 | $print No TESTS found 8 | exit 0 9 | 10 | my @tests 11 | &call open_r, TESTS 12 | $if /^(\S+\.def)/ 13 | push @tests, $1 14 | 15 | my $n_tests=@tests 16 | my $n_fail=0 17 | $foreach $t in @tests 18 | $print "*** [ $t ] ***" 19 | system("mydef_run $t") == 0 or $n_fail++ 20 | $call @check_system 21 | 22 | $if $n_fail>0 23 | die "Tests failed: $n_fail / $n_tests\n" 24 | 25 | $print Ran $n_tests tests. 26 | exit 0 27 | 28 | # -------------------------------------- 29 | subcode: check_system 30 | $if $?==-1 31 | # Failed to run 32 | $elif $? & 0xff 33 | # Died with signal 34 | $elif $? > 0 35 | # exit non_zero 36 | 37 | -------------------------------------------------------------------------------- /macros_compile/list.def: -------------------------------------------------------------------------------- 1 | subcode:: _autoload 2 | $global %list_list 3 | $global %list_hash 4 | 5 | subcode:: preproc_elifs 6 | $elif $preproc=~/^list_init:(\w+)/ 7 | $list_list{$1}=[] 8 | $elif $preproc=~/^list_push:(\w+)=(.*)/ 9 | push @{$list_list{$1}}, $2 10 | $elif $preproc=~/^list_set:(\w+),(\d+)=(.*)/ 11 | $list_list{$1}->[$2]=$3 12 | $elif $preproc=~/^list_each:(\w+)/ 13 | my $key=$1 14 | my $subblock=grabblock($block, \$lindex); 15 | my $idx=0 16 | $foreach $val in @{$list_list{$key}} 17 | $deflist->[-1]->{idx}=$idx 18 | $deflist->[-1]->{val}=$val 19 | parseblock({source=>$subblock, name=>"list_each $key"}) 20 | $idx++ 21 | $elif $preproc=~/^hash_init:(\w+)/ 22 | $list_hash{$1}={} 23 | $elif $preproc=~/^hash_set:(\w+),([^=]+)=(.*)/ 24 | $list_hash{$1}->{$2}=$3 25 | 26 | -------------------------------------------------------------------------------- /run/run_tex.def: -------------------------------------------------------------------------------- 1 | page: run_tex 2 | my $f_tex = $ARGV[0] 3 | $if $f_tex =~ /^(.*)\/(.*)/ 4 | chdir $1 or die "can't chdir $1\n" 5 | $f_tex = $2 6 | 7 | $if !-e $f_tex 8 | die "Missing latex file [$f_tex]\n" 9 | 10 | my $P = "pdflatex" 11 | $if $f_tex=~/\.tex$/ 12 | $P = "pdftex" 13 | 14 | $use IPC::Open3 15 | 16 | my $stage 17 | $print "$P $f_tex ..." 18 | my $pid = open3(\*P_IN, \*P_OUT, \*P_ERR, "$P $f_tex") or die "open3 failed $!" 19 | my $sp = " " 20 | $while 21 | $if /^! / 22 | $stage="Err" 23 | $if /! LaTeX Error:/ 24 | print P_IN "x\n" 25 | $if /\(Press Enter to retry, or Control-D to exit\)/ 26 | last 27 | 28 | # selectively show error messages 29 | $if $stage eq "Err" 30 | print "$sp$_" 31 | $elif /^(\w+) written on/ 32 | print "$sp$_" 33 | 34 | -------------------------------------------------------------------------------- /macros_make/makefile_perl.def: -------------------------------------------------------------------------------- 1 | subcode: perl_dir(dir) 2 | $if $(dir)=~/^(\w[0-9a-zA-Z_\-]*)\/lib/ 3 | my $name=$1 4 | $name=~s/-/::/g; 5 | $if !-d $dir 6 | BLOCK 7 | 8 | subcode: makefile_perl(dir) 9 | &call perl_dir, $(dir) 10 | my $pm_count=0 11 | $while my ($p, $h) = each %h_page 12 | $if $h->{type} eq "pm" 13 | $pm_count++ 14 | $if $pm_count>0 15 | print "Running h2xs -X $name ... ...\n"; 16 | system "h2xs -X $name"; 17 | $else 18 | # $print pm_count = 0 19 | 20 | subcode: makefile_xs(dir) 21 | &call perl_dir, $(dir) 22 | print "Running h2xs -n $name ... ...\n"; 23 | system "h2xs -n $name"; 24 | 25 | #---------------------------------------- 26 | #- my @scripts = glob("script/*") 27 | #- WriteMakefile(... 28 | #- EXE_FILES => \@scripts, 29 | #- ... 30 | #- LIBS => ['-lm -l...'], 31 | #- ... 32 | -------------------------------------------------------------------------------- /tests/general_fibonacci.def: -------------------------------------------------------------------------------- 1 | # reference: http://hz2.org/blog/fibonacci_sequence.html 2 | 3 | page: test 4 | module: general 5 | type: hs 6 | 7 | $call seq, fib, 0, 1, a0+a1 8 | $call seq, geom, 1, a0*2 9 | $call seq, fac, 1, a0*n 10 | $call seq, rec, "recursive", "I know (" ++ a0 ++ ") " ++ show n 11 | 12 | main = print (fac 42) 13 | 14 | # ---- engine part, tuck in the library ---- 15 | perlcode: seq 16 | $if $param=~/(\w+)[,:]\s*(.*)/ 17 | my $name=$1 18 | my @tlist=split /,\s*/, $2 19 | my $n=$#tlist 20 | 21 | my @t=split /\b(a\d+)\b/, $tlist[$n] 22 | $foreach $t in @t 23 | $if $t=~/^a(\d+)/ 24 | my $i=$n-$1 25 | $t="$name(n-$i)" 26 | my $t=join('', @t) 27 | 28 | $for $i=0:$n 29 | push @$out, "$name $i = $tlist[$i]\n" 30 | push @$out, "$name n = $t\n" 31 | push @$out, "\n" 32 | 33 | 34 | -------------------------------------------------------------------------------- /macros_parse/legacy.def: -------------------------------------------------------------------------------- 1 | subcode:: parse_level_0 2 | $elif $line=~/^path:\s*(.+)/ 3 | add_path($1) 4 | $elif $line=~/^resource:\s+(\w+)(.*)/ 5 | $call grab_resource 6 | 7 | subcode: grab_resource 8 | my $grab 9 | $if $def->{resource}->{$1} 10 | $grab=$def->{resource}->{$1} 11 | $else 12 | $grab={"_list"=>[], "_name"=>$1} 13 | $def->{resource}->{$1}=$grab 14 | my $t=$2 15 | $if $t=~/^\s*,\s*(.*)/ 16 | my @tlist=split /,\s*/, $1 17 | $grab->{"_parents"}=\@tlist 18 | 19 | #----------------------------------------------- 20 | my $grab_indent=$curindent 21 | my @grab 22 | &call parse_loop 23 | $call get_indentation 24 | $if $curindent>$grab_indent 25 | my $i=$curindent-$grab_indent-1; 26 | push @grab, "$i:$line"; 27 | $else 28 | grab_ogdl($grab, \@grab) 29 | #print_ogdl($grab, 0) 30 | last 31 | $cur_line-- 32 | 33 | -------------------------------------------------------------------------------- /mydef_update.def: -------------------------------------------------------------------------------- 1 | page: mydef_update 2 | output_dir: script 3 | type: 4 | 5 | $call get_MYDEFSRC_or_die 6 | system "cd MyDef && git pull && make && make install" 7 | 8 | my @all = glob("output_*") 9 | $foreach $a in @ARGV 10 | $if $a=~/(output_\w+)/ 11 | push @all, $1 12 | 13 | $foreach $a in @all 14 | $if !-d $a 15 | system "git clone https://github.com/hzhou/$a" 16 | $if -d $a and -d "$a/.git" 17 | $print $green{$a} .... 18 | system "cd $a && git pull origin master && mydef_make && make && make install" 19 | 20 | # ------------------------- 21 | subcode: get_MYDEFSRC_or_die 22 | my $dir 23 | $if $ENV{MYDEFSRC}=~/(.*)\/MyDef/ 24 | $dir = $1 25 | $if !$dir 26 | die "Missing MYDEFSRC location\n" 27 | $if !-d $dir 28 | die "Not a directory [$dir]\n" 29 | chdir $dir or die "Cannot chdir $dir\n" 30 | 31 | 32 | 33 | -------------------------------------------------------------------------------- /macros_parse/include.def: -------------------------------------------------------------------------------- 1 | #---- includes ---------------------------- 2 | subcode: _autoload 3 | $call dbl_list, includes 4 | 5 | # ref: parseutil.def - fncode: import_file 6 | subcode: parse_switch_include 7 | $elif $curindent==0 and $line=~/^include:?\s*(.*)/ 8 | $call add_include, $1 9 | 10 | # ref: macros_parse/default_page.def 11 | subcode: default_page_include 12 | $elif $k eq "include" 13 | $call add_include, $v 14 | 15 | #---------------------------------------- 16 | subcode: add_include(t) 17 | $if $(t) eq "$def->{_defname}.def" 18 | $print include main self [$(t)]? 19 | $else 20 | $call dbl_push, includes, $(t) 21 | 22 | subcode: load_standard_includes 23 | my $module = $MyDef::var->{module} 24 | 25 | my @standard_includes 26 | $if $MyDef::var->{'include'} 27 | push @standard_includes, split(/[:,]\s*/, $MyDef::var->{'include'}) 28 | 29 | my $stdinc="std_$module.def" 30 | push @standard_includes, $stdinc 31 | 32 | -------------------------------------------------------------------------------- /tests/general_macro_special.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: general 3 | 4 | x: $(x3:a) - $(x3,:test) 5 | eval: $(eval:1+1) 6 | nest: $(nest:3:sqrt(*):x) 7 | join: $(join:*:,:a-c) 8 | sym: $(sym:,) 9 | 10 | $(set:a=test_something) 11 | subst: $(subst:a:test_:do_) 12 | 13 | $(set:a=a word) 14 | word: $(a:1:word) 15 | subword: $(a:3:) 16 | 17 | $(set:a=is 123) 18 | $(a:2:number) 19 | strlen: $(a:strlen) 20 | strip: $(a:strip) 21 | regex: $(a:regex:(\d+)) 22 | uc: $(a:uc) # lc,uc_first,length 23 | 24 | $(set:a=a, b, c) 25 | list [$(a:list:n)]: $(a:list:1) 26 | $(a:list:shift 1) 27 | $(a:list:-*-) 28 | 29 | /* expect test.txt: 30 | x: aaa - test,test,test 31 | eval: 2 32 | nest: sqrt(sqrt(sqrt(x))) 33 | join: a,b,c 34 | sym: Comma 35 | subst: do_something 36 | word: word 37 | subword: ord 38 | 123 39 | strlen: 6 40 | strip: s 12 41 | regex: 123 42 | uc: IS 123 43 | list [3]: b 44 | b, c 45 | -a-, -b-, -c- 46 | */ 47 | -------------------------------------------------------------------------------- /tests/general_comment.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: general 3 | 4 | # Normal comment starts with # 5 | #Comment line without # space 6 | /* Multi-line comments are always filtered before anything else 7 | (can even break the indentation) */ 8 | 9 | # Escape with hexcode 10 | \x23! /bin/sh # trailing comments always get filtered 11 | $(shebang_bash) 12 | 13 | \x2f* multi-line comments need escape */ 14 | 15 | # C preprocs are recognized, e.g. #define #ifdef ... 16 | #ifdef A 17 | 18 | $call A 19 | 20 | macros: 21 | shebang_bash: #! /bin/bash # trailing comment require #space 22 | 23 | template: A 24 | Template # with trailing comment 25 | # Comments can be passed in literally in template 26 | \x2f* Unfortunately multiline comments still need escape */ 27 | 28 | /* expect test.txt: 29 | #! /bin/sh 30 | #! /bin/bash 31 | 32 | /* multi-line comments need escape */ 33 | 34 | #ifdef A 35 | 36 | Template # with trailing comment 37 | # Comments can be passed in literally in template 38 | /* Unfortunately multiline comments still need escape */ 39 | */ 40 | -------------------------------------------------------------------------------- /tests/perl_STUB.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: perl 3 | 4 | &call test, DUMP_STUB 5 | DUMP_STUB init 6 | $call test_1 7 | $(block:init) 8 | $a = "Changed in \x24(block:init)" 9 | 10 | # Essentially $(stub:...) are inline macros 11 | &call test, stub:... 12 | $print Another stub: $(stub:make_string)! 13 | &call test, stub:... 14 | $if $(stub: && :make_cond) 15 | $print STUB in \$if works! 16 | 17 | $call test_verbose 18 | $print Done. All is well 19 | 20 | subcode: test(stubtype) 21 | $print [$(stubtype)]\n - 22 | BLOCK 23 | 24 | subcode: test_verbose 25 | &call test, INSERT_STUB 26 | $print direct stub --> {STUB} <--. 27 | INSERT_STUB[ ] _dummy_ 28 | $(block:_dummy_) 29 | $(mode:bypass) 30 | a 31 | b 32 | c 33 | 34 | subcode: test_1 35 | $global $a = 1 36 | $print a = $a 37 | 38 | bypasscode: make_string 39 | a 40 | b 41 | c 42 | 43 | bypasscode: make_cond 44 | 1 45 | 2 46 | 3 47 | -------------------------------------------------------------------------------- /deflib/perl/indentations.def: -------------------------------------------------------------------------------- 1 | subcode: expand_tab(s, tabwidth) 2 | use integer; 3 | 1 while $(s)=~s/\t+/' ' x (length($&) * $(tabwidth) - length($`) % $(tabwidth))/e; 4 | 5 | #---------------------------------------- 6 | #- e.g. my $indent = get_indent($line) 7 | 8 | fncode: get_indent($s) 9 | $global @indent_stack=(0) 10 | # use integer; 11 | # 1 while $s=~s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e; 12 | # my $i=length($s); 13 | my $i=get_indent_spaces($s) 14 | $if $i==$indent_stack[-1] 15 | NOOP 16 | $elif $i>$indent_stack[-1] 17 | push @indent_stack, $i 18 | $else 19 | $while $i<$indent_stack[-1] 20 | pop @indent_stack; 21 | 22 | return $#indent_stack; 23 | 24 | #---------------------------------------- 25 | #- 26 | 27 | fncode: get_indent_spaces($t) 28 | use integer 29 | 30 | my $n=length($t) 31 | my $count=0 32 | $for $i=0:$n 33 | $if substr($t, $i, 1) eq ' ' 34 | $count++ 35 | $elif substr($t, $i, 1) eq "\t" 36 | $count=($count/8+1)*8 37 | $else 38 | return $count 39 | return $count 40 | 41 | -------------------------------------------------------------------------------- /modules.def: -------------------------------------------------------------------------------- 1 | macros: 2 | module_list: general, perl 3 | # php, www, c, xs, apple, win32, win32rc, perl, general, glsl, make, ino, matlab, cpp, plot, java, autoit, python, fortran, asm, go, awk 4 | module_type: general=>"txt",perl=>"pl" 5 | 6 | subcode: _autoload 7 | $map add_module, c, sh, xs, php, js, cpp, java, go, awk, ino, glsl, asm, tcl, lua, latex, tex 8 | $call add_module2, as, s 9 | $call add_module2, www, html 10 | $call add_module2, win32, c 11 | $call add_module2, win32rc, rc 12 | $call add_module2, apple, m 13 | $call add_module2, matlab, m 14 | $call add_module2, autoit, au3 15 | $call add_module2, python, py 16 | $call add_module2, fortran, f 17 | $call add_module, f90 18 | $call add_module2, pascal, pas 19 | $call add_module2, plot, pl 20 | $call add_module2, rust, rs 21 | 22 | subcode: add_module(name) 23 | $(setmacro:module_list=$(module_list),$(name)) 24 | # $(setmacro:module_type=$(module_type),$(name)=>"$(name)") 25 | 26 | subcode: add_module2(name, ext) 27 | $(setmacro:module_list=$(module_list),$(name)) 28 | $(setmacro:module_type=$(module_type),$(name)=>"$(ext)") 29 | -------------------------------------------------------------------------------- /deflib/perl/topsort.def: -------------------------------------------------------------------------------- 1 | # $L is a list of names, $H is a hash of dpendency 2 | fncode: top_sort($L, $H) 3 | # Kahn's algorith, $H gets destroyed 4 | my (@S, %invdep) 5 | $call init_S_invdep 6 | my @L 7 | $while @S 8 | my $name = shift @S 9 | push @L, $name 10 | $if $invdep{$name} 11 | $foreach $k in @{$invdep{$name}} 12 | my $cnt=0 13 | $call remove_dep 14 | $if $cnt==0 15 | # "unshift" to cluster the dependency group 16 | unshift @S, $k 17 | $if @L<@$L 18 | die "top_sort: cyclic dependency exist!\n" 19 | return \@L 20 | 21 | subcode: init_S_invdep 22 | $foreach $name in @$L 23 | $if !$H->{$name} or @{$H->{$name}}==0 24 | push @S, $name 25 | $else 26 | $foreach $k in @{$H->{$name}} 27 | $if !$invdep{$k} 28 | $invdep{$k}=[$name] 29 | $else 30 | push @{$invdep{$k}}, $name 31 | 32 | subcode: remove_dep 33 | $foreach $d in @{$H->{$k}} 34 | $if defined $d 35 | $if $d eq $name 36 | $d = undef 37 | $else 38 | $cnt++ 39 | 40 | -------------------------------------------------------------------------------- /mydef_debug.def: -------------------------------------------------------------------------------- 1 | page: mydef_debug 2 | output_dir: script 3 | type: 4 | 5 | my $mydef_page = `which mydef_page` 6 | chomp $mydef_page 7 | $print mydef_page: $mydef_page 8 | 9 | grep_file($mydef_page, 'MyDef::createpage') 10 | 11 | print "\n MyDef::createpage\n" 12 | print " my \$plines=MyDef::compileutil::compile();\n" 13 | print " MyDef::compileutil::output(\$plines);\n" 14 | 15 | print "\n MyDef::compileutil::compile\n" 16 | print " call_sub(\"_autoload\");\n" 17 | print " call_sub(\"main\");\n" 18 | print " \$f_parse->(\"NOOP POST_MAIN\")\n" 19 | print " ...\n" 20 | print " \$f_dumpout->(\@buffer, fetch_output(0), \$page->{_pageext})\n" 21 | 22 | $if $mydef_page=~/(.*)\/bin\/mydef_page/ 23 | my $lib_dir="$1/lib/perl5/MyDef" 24 | my $f = "$lib_dir/dumpout.pm" 25 | $if -f $f 26 | print "\n MyDef::dumpout::dumpout\n" 27 | grep_file($f, '\^\(INCLUDE_BLOCK\|DUMP_STUB\)') 28 | 29 | my $f = "$lib_dir/output_c.pm" 30 | $if -f $f 31 | print "\n MyDef::output_c::parsecode\n" 32 | grep_file($f, '\^NOOP POST_MAIN') 33 | 34 | fncode: grep_file($file, $pat) 35 | my $l = `grep '$pat' -n $file` 36 | $while $l=~/^\s*(\d+):\s+(.*)/mg 37 | print " line $1:\t$2\n" 38 | -------------------------------------------------------------------------------- /tests/general_preproc.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: general 3 | 4 | $(if:0) 5 | Commented out 6 | $(else) 7 | Show this instead 8 | $call test_if 9 | $call test_for_in 10 | $call test_for 11 | 12 | subcode: test_if 13 | --------------------------- 14 | $(set:a=abc) 15 | $(if:a~a) 16 | $(a) starts with a 17 | $(if:a~.*(B|b)) 18 | $(a) contains B|b 19 | 20 | subcode: test_for_in 21 | --------------------------- 22 | $(for:a-c) 23 | $(_i): $1 24 | 25 | subcode: test_for 26 | --------------------------- 27 | $(for:a,b in 1,2 and 2, 4) 28 | $(a) - $(b) 29 | --------------------------- 30 | $(for:1,2 and 2, 4) 31 | $1 : $2 32 | # for unequal list, the first list determins number 33 | --------------------------- 34 | $(for:a,b in 1,2 and 2, 4, 6) 35 | $(a) - $(b) 36 | --------------------------- 37 | $(for:a,b in 1,2,3 and 2, 4) 38 | $(a) - $(b) 39 | 40 | /* expect test.txt: 41 | Show this instead 42 | --------------------------- 43 | abc starts with a 44 | abc contains B|b 45 | --------------------------- 46 | 0: a 47 | 1: b 48 | 2: c 49 | --------------------------- 50 | 1 - 2 51 | 2 - 4 52 | --------------------------- 53 | 1 : 2 54 | 2 : 4 55 | --------------------------- 56 | 1 - 2 57 | 2 - 4 58 | --------------------------- 59 | 1 - 2 60 | 2 - 4 61 | 3 - 62 | */ 63 | -------------------------------------------------------------------------------- /macros_parse/template.def: -------------------------------------------------------------------------------- 1 | # ref: subcode: parse_page_line 2 | fncode: parse_template($def, $template_file) 3 | $call check_path 4 | 5 | $global $template_idx=0, %template_file_hash 6 | $if $template_file_hash{$template_file} 7 | return $template_file_hash{$template_file} 8 | $else 9 | $template_idx++ 10 | my $name="_T$template_idx" 11 | $template_file_hash{$template_file} = $name 12 | 13 | my $cur_source=[] 14 | $(set:parent=$def) 15 | $call add_subcode, $cur_source, "template", $name 16 | $call read_source 17 | $foreach $l in @$cur_source 18 | $if $l=~/^(\s*)(\$template)\s+(.+)/ 19 | my $sp = $1 20 | my $t_name = parse_template($def, $3) 21 | $l = "$sp\$call $t_name\n" 22 | return $name 23 | 24 | #-------------------------------------- 25 | subcode: read_source 26 | &call open_r, $template_file 27 | push @$cur_source, $_ 28 | 29 | subcode: check_path 30 | my $template_dir 31 | $if $def->{macros}->{TemplateDir} 32 | $template_dir=$def->{macros}->{TemplateDir} 33 | $elif $MyDef::var->{TemplateDir} 34 | $template_dir=$MyDef::var->{TemplateDir} 35 | 36 | $if $template_dir 37 | $if $template_file!~/^\.*\// 38 | $template_file = $template_dir.'/'.$template_file 39 | -------------------------------------------------------------------------------- /deflib/perl/extra.def: -------------------------------------------------------------------------------- 1 | # e.g. @t = bases(10000, 60, 60, 24); print join(':', reverse @t), "\n"; --> 2:46:40 2 | fncode: bases($n, @bases) 3 | my @t 4 | $foreach $b in @bases 5 | push @t, $n % $b 6 | $n = int($n/$b) 7 | $if $n<=0 8 | last 9 | $if $n>0 10 | push @t, $n 11 | return @t 12 | 13 | # -- simple progress timing 14 | fncode: get_time 15 | $global $time_start = time() 16 | my $t = time()-$time_start 17 | my @t 18 | $call get_seg, 60 19 | $call get_seg, 60 20 | $call get_seg, 60 21 | $if $t>0 22 | $call get_seg, 24 23 | return sprintf("%d day %02d:%02d:%02d", $t[3], $t[2], $t[1], $t[0]) 24 | $else 25 | return sprintf("%02d:%02d:%02d", $t[2], $t[1], $t[0]) 26 | 27 | subcode: get_seg(P) 28 | push @t, $t % $(P) 29 | $t = int($t/$(P)) 30 | 31 | fncode: json($v) 32 | $if ref($v) eq "HASH" 33 | my @tlist 34 | $foreach $k in sort keys %$v 35 | push @tlist, "\"$k\":".json($v->{$k}) 36 | return '{'.join(',', @tlist).'}' 37 | $elif ref($v) eq "ARRAY" 38 | my @tlist 39 | $foreach $k in @$v 40 | push @tlist, json($k) 41 | return '['.join(',', @tlist).']' 42 | $elif $v eq "0" or $v!=0 43 | return $v 44 | $else 45 | return "\"$v\"" 46 | 47 | subcode: dump(v) 48 | print ' $(v)=', json($(v)), "\n" 49 | -------------------------------------------------------------------------------- /macros_util/path.def: -------------------------------------------------------------------------------- 1 | 2 | fncode: add_path($dir) 3 | $if !$dir 4 | return 5 | 6 | $global @path, %path 7 | my $deflib=$ENV{MYDEFLIB} 8 | my $defsrc=$ENV{MYDEFSRC} 9 | 10 | $if $dir=~/\$\(MYDEFSRC\)/ 11 | $if !$defsrc 12 | die "MYDEFSRC not defined (in environment)!\n" 13 | $dir=~s/\$\(MYDEFSRC\)/$defsrc/g 14 | 15 | my @tlist = split /:/, $dir 16 | $foreach $t in @tlist 17 | $t=~s/\/$// 18 | $if $t and !$path{$t} 19 | $if -d $t 20 | $path{$t}=1 21 | push @path, $t 22 | $else 23 | warn "add_path: [$t] not a directory\n" 24 | 25 | fncode: find_file($file) 26 | my $nowarn 27 | $if $file=~/^(\S+)\?/ 28 | $file=$1 29 | $nowarn = 1 30 | 31 | $if -f $file 32 | return $file 33 | 34 | $if @path 35 | $foreach $dir in @path 36 | $if -f "$dir/$file" 37 | return "$dir/$file"; 38 | $if !$nowarn 39 | warn "$file not found\n" 40 | warn " search path: ".join(":", @path)."\n" 41 | 42 | return undef 43 | 44 | #----ref: mydef_make --------------------- 45 | subcode: protect_path 46 | my @save_path 47 | BLOCK 48 | $if @save_path 49 | %path=() 50 | @path=@save_path 51 | $foreach $t in @path 52 | $path{$t}=1 53 | @save_path=() 54 | 55 | subcode: protect_add_path(f) 56 | $if !@save_path 57 | @save_path=@path 58 | add_path($(f)) 59 | -------------------------------------------------------------------------------- /tests/perl_permutation.def: -------------------------------------------------------------------------------- 1 | include: perl/permutation.def 2 | 3 | page: test 4 | module: perl 5 | 6 | $(if:1) 7 | &call test, permutation, 4 8 | &call permutation, 4 9 | $print [ @perm ] 10 | $call inc 11 | $(if:1) 12 | &call test, permute, 4, 2 13 | &call permute, 4, 2 14 | $print [ $perm[0] $perm[1] ] 15 | $call inc 16 | 17 | $(if:1) 18 | # $(set:p=10,4) 19 | $(set:p=4,2) 20 | &call test, choose, $(p) 21 | &call choose, $(p) 22 | $print [ @perm ] 23 | $call inc 24 | 25 | $(if:0) 26 | &call test, enum_count, 4, 2 27 | &call enum_count, 4, 2 28 | $print [ @perm ] 29 | $call inc 30 | 31 | $(if:0) 32 | my @limit=(60, 60, 24, 2) 33 | &call test, enum_count, 4, \$limit[\$i] 34 | &call enum_count, 4, $limit[$i] 35 | $if $perm[0] % 15 == 0 and $perm[1]==10 and $perm[2] % 6 == 0 36 | $print [ @perm ] 37 | $call inc 38 | 39 | $(if:0) 40 | &call test, ordered_count, 4, 2, 5 41 | &call ordered_count, 4, 2, 5 42 | $for $i=0:4 43 | print $perm[$i], ' ' 44 | $print 45 | $call inc 46 | 47 | subcode: test(@msg) 48 | $print ----\n$(msg) 49 | my $cnt 50 | BLOCK 51 | $print count: $cnt 52 | 53 | subcode: inc 54 | $cnt++ 55 | -------------------------------------------------------------------------------- /macros_ext/grab_file.def: -------------------------------------------------------------------------------- 1 | fncode: grab_file($file, $pat) 2 | my @t 3 | $if $file eq "-" 4 | $file = $MyDef::def->{file} 5 | $call @comment_header 6 | 7 | my $flag 8 | &call open_r, $file 9 | $if $pat 10 | $call check_flag_pattern_mydef 11 | $elif $flag 12 | push @t, $_ 13 | $else 14 | push @t, $_ 15 | $call @chop_empty 16 | 17 | return \@t 18 | 19 | # ------------------- 20 | subcode: open_r(f) 21 | $if open In, $(f) 22 | $while 23 | BLOCK 24 | close In 25 | $else 26 | die "Can't open $file\n" 27 | 28 | #- TODO: support other comment syntax 29 | subcode: check_flag_pattern_mydef 30 | # main block is marked with #---- 31 | $if /^\#----\s*$pat\s*----/ 32 | $flag=1 33 | $elif /^\#----.*----/ 34 | $flag=0 35 | # sub-blocks are marked with # -- 36 | $elif !$flag and /^\s*#\s*--\s*$pat\s*--/ 37 | $flag=2 38 | $elif $flag==2 and /^\s*#\s*--.*--/ 39 | $flag=0 40 | 41 | subcode: comment_header 42 | my $fname=$file 43 | $if $file=~/def\/(.*)/ 44 | $fname = $1 45 | $elif $file=~/.*\/(.*)/ 46 | $fname = $1 47 | 48 | $if $pat 49 | push @t, "#---- $fname: $pat ----\n" 50 | $else 51 | push @t, "#---- file: $fname ----\n" 52 | 53 | subcode: chop_empty 54 | $while $t[-1]=~/^\s*$/ 55 | pop @t 56 | -------------------------------------------------------------------------------- /deflib/perl/html.def: -------------------------------------------------------------------------------- 1 | subcode: html_tag(@tag) 2 | $(allow_recurse:20) 3 | $(if:tag=html) 4 | print Out "\n" 5 | 6 | my @tt_list=split /,\s*/, "$(tag)" 7 | my ($func, $attr, $quick_content)= parse_tag_attributes(\@tt_list) 8 | 9 | print Out "<$func$attr>" 10 | BLOCK 11 | print Out "\n" 12 | 13 | #---------------------------------------- 14 | fncode: parse_tag_attributes($tt_list) 15 | my $func=shift @$tt_list 16 | my $attr="" 17 | my $quick_content 18 | $foreach $tt in @$tt_list 19 | $if $tt eq "/" 20 | $quick_content="" 21 | $elsif $tt=~/^#(\S+)$/ 22 | # ---- ID ------------ 23 | $attr.=" id=\"$1\""; 24 | $elif $tt=~/^(\S+?)[:=]"(.*)"/ 25 | # ---- Named Attribute ---- 26 | $attr.=" $1=\"$2\"" 27 | $elif $tt=~/^(\S+?)[:=](.*)/ 28 | $attr.=" $1=\"$2\"" 29 | $elif $tt=~/^"(.*)"/ 30 | # ---- Quick Content ---- 31 | $quick_content=$1 32 | $else 33 | # ---- Classes ---- 34 | $attr.=" class=\"$tt\""; 35 | 36 | $call tag_input 37 | $call tag_form 38 | return ($func, $attr, $quick_content) 39 | 40 | subcode: tag_input 41 | $case $func eq "input" 42 | $if $attr !~ /type=/ 43 | $attr.=" type=\"text\"" 44 | $if $quick_content 45 | $attr.=" placeholder=\"$quick_content\"" 46 | subcode: tag_form 47 | $case $func eq "form" 48 | $if $attr !~ /action=/ 49 | $attr.=" action=\"\"" 50 | $if $attr !~ /method=/ 51 | $attr.=" method=\"POST\"" 52 | 53 | -------------------------------------------------------------------------------- /mydef_decl.def: -------------------------------------------------------------------------------- 1 | page: mydef_decl 2 | type: 3 | output_dir: script 4 | 5 | my @c_list 6 | my $inc 7 | $foreach $a in @ARGV 8 | $if $a=~/\.c$/ 9 | push @c_list, $a 10 | $elif $a=~/\.inc/ 11 | $inc = $a 12 | 13 | $if $inc and @c_list 14 | $foreach $f in @c_list 15 | load_declare($f) 16 | &call open_w, $inc 17 | $if @auto_struct_list 18 | print Out "S ", join(", ", @auto_struct_list), "\n" 19 | $foreach $name in @struct_list 20 | print Out "struct $name\{\n" 21 | $foreach $l in @{$struct_list{$name}} 22 | print Out $l 23 | print Out "};\n" 24 | $foreach $name in @decl_list 25 | print Out "F $decl_list{$name}\n" 26 | 27 | fncode: load_declare($f) 28 | $global %decl_list, @decl_list 29 | $global %struct_list, @struct_list, @auto_struct_list 30 | &call open_r, $f 31 | $if /^(\S.+)\s+(\w+)\((.*)\);/ 32 | my ($type, $name, $param)=($1, $2, $3) 33 | $if !$decl_list{$name} 34 | $if $type !~/^static/ 35 | $decl_list{$name}="$type $name($param)" 36 | push @decl_list, $name 37 | $elif /^struct\s+(\w+)\s*{\s*(.*)$/ 38 | my ($name, $comment) = ($1, $2) 39 | my @t 40 | $while 41 | $if /^}/ 42 | last 43 | $else 44 | push @t, $_ 45 | $if $comment=~/public/ 46 | $struct_list{$name}=\@t 47 | push @struct_list, $name 48 | $else 49 | push @auto_struct_list, $name 50 | 51 | -------------------------------------------------------------------------------- /deflib/perl/gnuplot_extra.def: -------------------------------------------------------------------------------- 1 | subcode: set_3d 2 | &call plot_settings 3 | set view 60,210,1.5,1 4 | set pm3d depthorder hidden3d 1 5 | set hidden3d 6 | 7 | subcode: set_3d_none 8 | &call plot_settings 9 | unset colorbox 10 | unset key 11 | unset border 12 | unset tics 13 | set ticslevel 0 14 | 15 | subcode: set_border_xy 16 | &call plot_settings 17 | set border 3 front lc rgb '#808080' lt 1 lw 1 18 | set tics nomirror out scale 0.75 19 | set format '%g' 20 | 21 | subcode: set_border_none 22 | &call plot_settings 23 | set border 0 24 | unset xlabel 25 | unset ylabel 26 | set format x '' 27 | set format y '' 28 | set tics scale 0 29 | 30 | subcode: set_grid 31 | &call plot_settings 32 | set grid back lc rgb '#d6d7d9' lt 0 lw 1 33 | 34 | subcode: set_filledcurves 35 | &call plot_settings 36 | set style fill transparent solid 0.5 noborder 37 | set style function filledcurves y1=0 38 | set clip two 39 | 40 | subcode: set_line_colors(@colors) 41 | $(export:linestyle=1) 42 | $(for:c in $(colors)) 43 | $(eval:i=$(_i)+1) 44 | push @plot_settings, "set style line $(i) lt 1 lc rgb '#$(c)'" 45 | 46 | subcode: set_palette(@colors) 47 | my @t 48 | $(for:c in $(colors)) 49 | push @t, "$(_i) '#$(c)'" 50 | # push @plot_settings, "set palette maxcolors $(colors:list:n)" 51 | push @plot_settings, "set palette defined (".join(', ', @t).")" 52 | 53 | subcode: set_x_in_pi 54 | &call plot_settings 55 | # set encoding utf8 56 | # set format x '%.1Pπ' 57 | set xtics pi 58 | set format x '%.0P{/Symbol p}' 59 | 60 | 61 | -------------------------------------------------------------------------------- /tests/general_macros.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: general 3 | 4 | $(A) 5 | $(B:param) 6 | $(set:c=hello) 7 | $(C) 8 | $call test_basic 9 | $call set_macro 10 | $call export 11 | $call enumset 12 | $call test_calc 13 | $call test_eval 14 | $call test_split 15 | $call test_perl 16 | 17 | subcode: set_macro 18 | $(setmacro:a=set) 19 | $(set1:b=set1: $1) 20 | $call test_basic 21 | 22 | subcode: export 23 | $(export:a=export) 24 | a: [$(a)] 25 | 26 | subcode: enumset 27 | $(for:a,b) 28 | # $(for:...) creates extra scope, unlike $(if:...) 29 | $(set-1:_base+=1) 30 | $(set-1:$1=$(_base)) 31 | a, b: $(a), $(b) 32 | 33 | subcode: test_calc 34 | $(set:a+=1) 35 | a: $(a) 36 | $(set:a.=1) 37 | a: $(a) 38 | subcode: test_eval 39 | $(eval:a=`echo backtick`) 40 | a: $(a) 41 | 42 | subcode: test_split 43 | $(set:a=test,split) 44 | $(split:a) 45 | $(p_1) - $(p_2) 46 | 47 | subcode: test_perl 48 | $call perl_set_macro 49 | $(macro-from-perl) 50 | 51 | perlcode: perl_set_macro 52 | $MyDef::def->{macros}->{"macro-from-perl"} = "macro set from perl" 53 | 54 | 55 | #----------------------------------------------- 56 | subcode: test_basic 57 | a: [$(a)] 58 | $(b:b) 59 | 60 | macros: 61 | a: 1, 2, 3 62 | a:: 4, 5 63 | b: param: $1 64 | A: A=$(a) 65 | B: B=$(b:$1) # only simple macros can nest 66 | C: C=$(c) # only static macros can nest 67 | 68 | /* expect test.txt: 69 | A=1, 2, 3, 4, 5 70 | B=$(b:param) 71 | C=$(c) 72 | a: [1, 2, 3, 4, 5] 73 | param: b 74 | a: [set] 75 | set1: b 76 | a: [export] 77 | a, b: 1, 2 78 | a: 1 79 | a: 11 80 | a: backtick 81 | test - split 82 | macro set from perl 83 | */ 84 | -------------------------------------------------------------------------------- /tests/perl_mydef_utils.def: -------------------------------------------------------------------------------- 1 | page: test 2 | type: pl 3 | $call test_expand_macro 4 | # $call test_proper_split 5 | # $call test_benchmark 6 | # $call test_c_expression 7 | 8 | #---------------------------------------- 9 | subcode: test_expand_macro 10 | use MyDef::utils 11 | # my $line = "test \$"."(macro \$"."(nested (arbitary) ) )" 12 | my $line="test \$(\$(a))" 13 | $print line: [$line] 14 | my $t=MyDef::utils::expand_macro($line, \&expand) 15 | $print result: [$t] 16 | 17 | $sub expand($s) 18 | $print $s 19 | $if $s eq "a" 20 | return "b" 21 | $elif $s eq "b" 22 | return "c" 23 | $else 24 | return "[-]" 25 | 26 | #---------------------------------------- 27 | subcode: test_proper_split 28 | use MyDef::utils 29 | my $param="a, b, (c1, c2, c3[1, 2, 3], c4), \"any, thing '(' goes,\", , skiped 1" 30 | #my $param=" {{1, 2, 3}, {3, 4, 5}, {4, 5, 6}} " 31 | 32 | my @t=MyDef::utils::proper_split($param) 33 | $foreach $t in @t 34 | print " [$t]\n" 35 | 36 | subcode: test_benchmark 37 | use Benchmark 38 | use MyDef::utils 39 | # my $param="char *, struct nonsense *, int, unsigned int" 40 | my $param="a, b, (c1, c2, c3[1, 2, 3], c4), \"any, thing '(' goes,\", , skiped 1" 41 | 42 | timethis(1000000, 'my @t=split /,\s*/, $param;') 43 | #- 0.13 sec 44 | timethis(1000000, 'my @t=MyDef::utils::proper_split($param);') 45 | #- 0.55 sec 46 | 47 | #---------------------------------------- 48 | subcode: test_c_expression 49 | use MyDef::utils 50 | use MyDef::output_c 51 | 52 | my $l="A[(i)*3+j]=-A[(i)*3+j]+A[(i)*3+j+1]*A[(i-1)*3+j]" 53 | my $t=MyDef::output_c::check_expression($l) 54 | print "Before: $l\n" 55 | print "After: $t\n" 56 | -------------------------------------------------------------------------------- /deflib/perl/parse_utils.def: -------------------------------------------------------------------------------- 1 | 2 | subcode: skip(@pat) 3 | $case $src=~/\G$(pat)/gc 4 | next 5 | 6 | subcode: symbol(@pat) 7 | $case $src=~/\G($(pat))/gc 8 | $cur = [$1, $1] 9 | 10 | subcode: token(type, @pat) 11 | $case $src=~/\G($(pat))/gc 12 | $cur = [$1, "$(type)"] 13 | 14 | # -------------- 15 | subcode: double_quote 16 | $case $src=~/\G("(?:[^\\]+|\\.)*")/gc 17 | $cur = [$1, '"'] 18 | 19 | subcode: single_quote 20 | $case $src=~/\G('(?:[^\\]+|\\.)*')/gc 21 | $cur = [$1, "'"] 22 | 23 | subcode: bracket 24 | $case $src=~/\G([\(\[\{])/gc 25 | #-- %prec '('=>-1, 't('=>100, ... 26 | $cur = [$1, "t$1"] 27 | $elif $src=~/\G([\)\]\}])/gc 28 | $cur = [$1, $1] 29 | 30 | subcode: brace 31 | $case $src=~/\G(\{)/gc 32 | #-- %prec '('=>-1, 't('=>100, ... 33 | $cur = [$1, "t$1"] 34 | $elif $src=~/\G(\})/gc 35 | $cur = [$1, $1] 36 | 37 | # ---- routines for grab ---------------- 38 | subcode: grab_brace 39 | $(set:o={) 40 | $(set:c=}) 41 | $call grab_group 42 | 43 | subcode: grab_bracket 44 | $(set:o=[) 45 | $(set:c=]) 46 | $call grab_group 47 | 48 | subcode: grab_paren 49 | $(set:o=() 50 | $(set:c=)) 51 | $call grab_group 52 | 53 | subcode: grab_group 54 | $(if:type=brace) 55 | my $t 56 | &call if_lex, \s*\$(o) 57 | my $level=1 58 | $while 1 59 | &call if_lex, (\\.|[^\\]+) 60 | $t.=$1 61 | &call if_lex, \$(o) 62 | $level++ 63 | $t.='$(o)' 64 | &call if_lex, \$(c) 65 | $level-- 66 | $if $level>0 67 | $t.='$(c)' 68 | $else 69 | break 70 | 71 | # ---- routines for process ----------- 72 | # -- check_precedence, reduce_stack 73 | 74 | -------------------------------------------------------------------------------- /old/set_macro_join.def: -------------------------------------------------------------------------------- 1 | #- $(stub::bypasscode) works much better 2 | # ref: tests/perl_STUB.def 3 | subcode:: preproc_elifs 4 | $elif $preproc=~/^set:\s*(\w+)(\)|$)/ 5 | # $(set:word) join ... # consider deprecate 6 | my $name=$1 7 | $if $2 eq ')' 8 | $if $l=~/\$\(.*?\)\s*(.*)/ 9 | $tail = $1 10 | $call set_macro_join 11 | 12 | #---------------------------------------- 13 | #- $(set:name) join, sep, pattern, listitem1, ... 14 | #- replaces the * in pattern with list 15 | subcode: set_macro_join 16 | $if !$tail 17 | $deflist->[-1]->{$name}="" 18 | $else 19 | $tail=~s/^\s+// 20 | expand_macro(\$tail) 21 | my @tlist=MyDef::utils::proper_split($tail) 22 | my $verb=shift @tlist 23 | $if $verb eq "join" 24 | my $sep=shift @tlist 25 | my $pat=shift @tlist 26 | $map strip_quote, $sep, $pat 27 | my $subblock=grabblock($block, \$lindex) 28 | my @out_list 29 | $if $pat 30 | $call @join_pattern 31 | $else 32 | $call @join_direct 33 | $deflist->[-1]->{$name}= join($sep, @out_list) 34 | # ---------- 35 | subcode: join_pattern 36 | $foreach $t in @$subblock 37 | $if $t!~/^SOURCE:/ 38 | expand_macro(\$t) 39 | push @tlist, MyDef::utils::proper_split($t) 40 | $foreach $t2 in @tlist 41 | my $t3=$pat 42 | $t3=~s/\*/$t2/g 43 | push @out_list, $t3 44 | # ---------- 45 | subcode: join_direct 46 | $foreach $t in @$subblock 47 | $if $t!~/^SOURCE:/ 48 | expand_macro(\$t) 49 | push @out_list, $t 50 | 51 | subcode: strip_quote(v) 52 | $if $(v)=~/^["'](.*)["']$/ 53 | $(v)=$1 54 | 55 | -------------------------------------------------------------------------------- /tests/perl_template.def: -------------------------------------------------------------------------------- 1 | # A general binary format interface, started, to be finished 2 | 3 | page: t 4 | my $cw = 50 5 | my $w = $cw*8 6 | my $h = $cw*8 7 | 8 | my $lines=[] 9 | $for $i=0:$h 10 | push @$lines, [] 11 | 12 | $for $i=0:8 13 | $for $j=0:8 14 | $call get_color 15 | $call fill_cell 16 | 17 | subcode: get_color 18 | my $color = 0 19 | $if ($i+$j) %2 ==0 20 | $color=255 21 | subcode: fill_cell 22 | $for $i2 = 0:$cw 23 | my $l = $lines->[$i*$cw+$i2] 24 | $for $j2 = 0:$cw 25 | $l->[$j*$cw+$j2]=$color 26 | 27 | &call open_w, t.bmp 28 | $call write_binary, bmp 29 | 30 | template: bmp 31 | BMP: BITMAPFILEHEADER BITMAPINFOHEADER IMAGE 32 | BITMAPFILEHEADER: [C2x8I] - 'BM', (offset:IMAGE) 33 | BITMAPINFOHEADER: [Iiissx8x16] - (size:), w, h, 1, bpp(8) 34 | IMAGE: LINE[h] - lines 35 | LINE: C[w] pad4 36 | 37 | perlcode: write_binary 38 | my $codelib = MyDef::compileutil::get_def_attr("codes", $param) 39 | my $source = $codelib->{source} 40 | 41 | my (%h, $root) 42 | $call load_fmt 43 | $foreach @$source 44 | $if /^\s*(\w+):\s*(.*)/ 45 | $h{$1}=$2 46 | $if !$root 47 | $root = $2 48 | $call parse_fmt 49 | 50 | push @$out, @$source 51 | 52 | subcode: load_fmt 53 | my %bits, %bytes 54 | $(for:b,B,h,H and 1,1,4,4) 55 | $bits{$1}=$2 56 | $(for:a,A,c,C) 57 | $bytes{$1}=1 58 | $(for:f,i,I,l,L,N 59 | subcode: parse_fmt 60 | $if $2=~/(.*?)\s*-\s*(.*)/ 61 | my ($t, $v) = ($1, $2) 62 | my @v = split /,\s*/, $v 63 | $h{values}=\@v 64 | my $size 65 | $while $t=~/\G\s*([a-zA-Z])(\d*)/gc 66 | 67 | -------------------------------------------------------------------------------- /bootstrap.sh: -------------------------------------------------------------------------------- 1 | C='\033[0;32m' 2 | NC='\033[0m' 3 | 4 | if [ -z "$MYDEFLIB" ]; then 5 | printf "\n${C}#---- New install ----${NC}\n" 6 | NEWINSTALL=1 7 | else 8 | printf "\n${C}#---- Install Path ----${NC}\n" 9 | echo PATH: $PATH 10 | echo PERL5LIB: $PERL5LIB 11 | echo MYDEFLIB: $MYDEFLIB 12 | save_PATH=$PATH 13 | save_PERL5LIB=$PERL5LIB 14 | save_MYDEFLIB=$MYDEFLIB 15 | fi 16 | 17 | # make sure we have mydef_boot 18 | git submodule update --init 19 | 20 | BOOT=mydef_boot 21 | export PATH=$BOOT/bin:$PATH 22 | export PERL5LIB=$BOOT/lib/perl5 23 | export MYDEFLIB=$BOOT/lib/MyDef:deflib 24 | 25 | printf "\n${C}#---- Compile from fresh MyDef source ----${NC}\n" 26 | perl $BOOT/bin/mydef_make 27 | touch *.def 28 | make 29 | 30 | printf "\n${C}#---- Install updated MyDef ----${NC}\n" 31 | if [ "$NEWINSTALL" = 1 ]; then 32 | bin_dir=$HOME/bin 33 | lib_dir=$HOME/lib 34 | 35 | install -d $bin_dir 36 | install -d $lib_dir 37 | install -d $lib_dir/perl5 38 | install -d $lib_dir/MyDef 39 | 40 | export PATH=$bin_dir:$PATH 41 | export PERL5LIB=$lib_dir/perl5 42 | export MYDEFLIB=$lib_dir/MyDef 43 | else 44 | export PATH=$save_PATH 45 | export PERL5LIB=$save_PERL5LIB 46 | export MYDEFLIB=$save_MYDEFLIB 47 | fi 48 | 49 | MY_INSTALL="perl out/script/mydef_install" 50 | $MY_INSTALL deflib . def 51 | $MY_INSTALL out/lib . pm 52 | $MY_INSTALL out/script . - 53 | 54 | if [ "$NEWINSTALL" = 1 ]; then 55 | printf "\n${C}#---- MyDef INSTALLED ----${NC}\n" 56 | echo "By Default, MyDef is intalled in $bin_dir and $lib_dir" 57 | echo " to use MyDef, you need:" 58 | echo " * add $bin_dir to your PATH" 59 | echo " * set PERL5LIB=$lib_dir/perl5" 60 | echo " * set MYDEFLIB=$lib_dir/MyDef" 61 | echo " * set MYDEFSRC=`pwd`" 62 | echo " It is recommended to set them in your ~/.bashrc" 63 | fi 64 | -------------------------------------------------------------------------------- /macros_output/types.def: -------------------------------------------------------------------------------- 1 | 2 | subcode:: parsecode_func_param_other 3 | $elif $func eq "register_prefix" 4 | my @tlist=split /,\s*/, $param1 5 | $foreach $t in @tlist 6 | $type_prefix{$t}=$param2 7 | return 8 | $elif $func eq "register_name" 9 | my @tlist=split /,\s*/, $param1 10 | $foreach $t in @tlist 11 | $type_name{$t}=$param2 12 | return 13 | 14 | #---- type from name ------ 15 | macros: 16 | type_prefix_chars: t 17 | 18 | fncode: get_type_name($name, $no_prefix) 19 | # typename 20 | $if $type_name{$name} 21 | return $type_name{$name} 22 | $elif $type_prefix{$name} 23 | return $type_prefix{$name} 24 | $elif $name=~/^([a-zA-Z]+)\d+$/ and ($type_name{$1} or $type_prefix{$1}) 25 | return get_type_name($1) 26 | # --------------------- 27 | $elif !$no_prefix and $name=~/^([$(type_prefix_chars)]+)_(.+)$/ 28 | # p_nxxx 29 | my $type = get_type_name($2, 1) 30 | $if $type 31 | return get_type_word_prefix($1, $type) 32 | 33 | $if !$no_prefix and $name=~/^([$(type_prefix_chars)]+)(.)(_.+)?$/ and $type_prefix{$2} 34 | # pn_xxx 35 | return get_type_word_prefix($1, $type_prefix{$2}) 36 | # --------------------- 37 | $elif $name=~/^([^_]+)/ && $type_prefix{$1} 38 | return $type_prefix{$1} 39 | $elif $name=~/^([^_0-9]+)/ && $type_prefix{$1} 40 | return $type_prefix{$1} 41 | $elif $name=~/_([^_]+)$/ && length{$1}>1 && $type_name{$1} 42 | return $type_name{$1} 43 | return undef 44 | 45 | #-- modify $type with $(type_prefix_chars) -- 46 | fncode: get_type_word_prefix($prefix, $type) 47 | $foreach $c in reverse(split //, $prefix) 48 | $if $c eq "t" 49 | # NOOP 50 | $call @type_word_prefix 51 | $else 52 | return undef 53 | return $type 54 | 55 | -------------------------------------------------------------------------------- /deflib/ext.def: -------------------------------------------------------------------------------- 1 | macros: 2 | hascode: $MyDef::def->{codes}->{"$1"} or $MyDef::page->{codes}->{"$1"} 3 | callsub: MyDef::compileutil::callsub($1) 4 | getmacro: MyDef::compileutil::get_macro_word($1, 1) 5 | setmacro: MyDef::compileutil::set_current_macro 6 | 7 | #---------------------------------------- 8 | #-- level 2 facility, called within perlcode 9 | #-- ref: output_www/deflib/html/code.def 10 | 11 | subcode: replace_output(name) 12 | my $old_out=MyDef::compileutil::set_output($(name)) 13 | BLOCK 14 | MyDef::compileutil::set_output($old_out) 15 | 16 | subcode: push_indent_block 17 | $(allow_recurse:10) 18 | push @$out, "INDENT" 19 | BLOCK 20 | push @$out, "DEDENT" 21 | 22 | #---- &call perlcode [optional approach] 23 | subcode: grab_codelist 24 | require MyDef::ext 25 | my $codelist = MyDef::ext::grab_codelist() 26 | 27 | subcode: filter_codelist 28 | my $codelist = $MyDef::compileutil::named_blocks{"last_grab"} 29 | my @source 30 | $if $codelist 31 | $foreach $t in @$codelist 32 | $if $t =~/^SOURCE/ 33 | push @source, $t 34 | $else 35 | BLOCK 36 | # $call @debug 37 | $else 38 | $call @direct 39 | $if @source 40 | MyDef::compileutil::parseblock({source=>\@source, name=>"filtered"}) 41 | 42 | subcode: debug 43 | $foreach $l in @source 44 | $print [$l] 45 | 46 | #---------------------------------------- 47 | #-- used in perl prgrams 48 | subcode: grab_block 49 | my $codelist = $MyDef::compileutil::named_blocks{"last_grab"} 50 | push @$out, "my \@source=(\n" 51 | $foreach $l in @$codelist 52 | $if $l=~/^SOURCE_INDENT/ 53 | push @$out, " 'INDENT'," 54 | $elif $l=~/^SOURCE_DEDENT/ 55 | push @$out, " 'DEDENT'," 56 | $elif $l!~/^SOURCE/ 57 | $l=~s/'/\\'/g 58 | push @$out, " '$l'," 59 | push @$out, ");" 60 | -------------------------------------------------------------------------------- /tests/perl_ext.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: perl 3 | 4 | $(if:0) 5 | $call test_inject_sub 6 | $(elif:1) 7 | $call test_grab_block 8 | $(elif:1) 9 | $call test_grab_ogdl 10 | 11 | subcode: test_inject_sub 12 | $call inject_sub 13 | $call P, world 14 | 15 | perlcode: inject_sub 16 | require MyDef::ext 17 | my @src 18 | push @src, "\$print Hello \x24(name)!" 19 | MyDef::ext::inject_sub("P(name)", \@src) 20 | 21 | #----------------------------------------------- 22 | subcode: test_grab_block 23 | &call grab_block, param1 24 | Some text 25 | indented by 2 spaces 26 | 27 | MOre text 28 | 29 | perlcode: grab_block 30 | require MyDef::ext 31 | $print param: $param 32 | my $codelist = MyDef::ext::grab_codelist(do_macro=>1) 33 | $foreach @$codelist 34 | $print " [$_]" 35 | 36 | #----------------------------------------------- 37 | subcode: test_grab_ogdl 38 | &call grab_ogdl 39 | item 1 40 | item 2 41 | item 3 42 | k1: v1 43 | k2: v2 44 | k3: v3 45 | a: 1 46 | b: 2 47 | 48 | $call print_ogdl 49 | 50 | 51 | perlcode: grab_ogdl 52 | require MyDef::ext 53 | my $ogdl = MyDef::ext::grab_ogdl(1) 54 | $MyDef::def->{_ogdl}=$ogdl 55 | 56 | perlcode: print_ogdl 57 | my $ogdl = $MyDef::def->{_ogdl} 58 | $foreach $t in @$ogdl 59 | my @stack=([0,undef,$t]) 60 | $while my $_t = pop(@stack) 61 | my ($indent, $k, $v)=@$_t 62 | my $sp = " " x $indent 63 | $if defined $k 64 | $print "$sp$k: -" 65 | $if ref($v) eq "HASH" 66 | $print [$v->{_}] 67 | $foreach $k2 in sort {$b cmp $a} keys(%$v) 68 | $if $k2 ne "_" 69 | push @stack, [$indent+1, $k2, $v->{$k2}] 70 | $else 71 | $print [$v] 72 | -------------------------------------------------------------------------------- /deflib/perl/make_dist.def: -------------------------------------------------------------------------------- 1 | subcode: make_dist(name) 2 | $call get_version 3 | $call get_date 4 | $call mk_root 5 | $call copy_manifest 6 | $if !-f "$root/version.def" 7 | $call create_version_def 8 | $else 9 | $call update_version_def 10 | $print " --> [$root.tar.gz]" 11 | system "tar czf $root.tar.gz $root" 12 | 13 | subcode: get_version 14 | my $version = $ARGV[0] 15 | $if $version!~/^\d+\.\S+/ 16 | die "Usage: $0 version\n" 17 | 18 | subcode: get_date 19 | my @t = localtime 20 | # ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) 21 | my $date = sprintf("%4d/%02d/%02d", $t[5]+1900, $t[4]+1, $t[3]) 22 | 23 | subcode: mk_root 24 | my $root = "$(name)-$version" 25 | $if -d $root 26 | system "rm -r $root" 27 | mkdir $root 28 | 29 | subcode: create_version_def 30 | &call open_w, $root/version.def 31 | print Out "macros:\n version: $version\n date: $date\n" 32 | 33 | subcode: update_version_def 34 | $call get_file_lines, ../version.def 35 | &call open_w, $root/version.def 36 | $foreach $l in @lines 37 | $if $l=~/^\s+version:/ 38 | print Out " version: $version\n" 39 | $elif $l=~/^\s+date:/ 40 | print Out " date: $date\n" 41 | $else 42 | print Out $l 43 | 44 | 45 | subcode: copy_manifest 46 | &call open_r, manifest 47 | $if /^(.+)\/(\S+)/ -> $d, $f 48 | $if $d!~/[\*\?]/ 49 | $call copy_path, $d, $f 50 | $else 51 | my @all = glob("../$d") 52 | $foreach $a in @all 53 | $a=~s/^\.\.\/// 54 | $call copy_path, $a, $f 55 | 56 | $elif /^(\S+)/ 57 | system "cp -r ../$1 $root/" 58 | subcode: copy_path(d, f) 59 | system "mkdir -p $root/$(d)" 60 | system "cp -r ../$(d)/$(f) $root/$(d)/" 61 | -------------------------------------------------------------------------------- /macros_parse/default_page.def: -------------------------------------------------------------------------------- 1 | # start with $in_default_page set 2 | # reset on abort 3 | subcode: _autoload 4 | $global $in_default_page 5 | 6 | subcode:8 import_file_init 7 | $if $file_type eq "main" 8 | $call start_default_page 9 | $in_default_page = $page 10 | $call parse_default_page_macros 11 | 12 | subcode:: import_file_finish 13 | $if $file_type eq "main" 14 | $if $in_default_page 15 | $call add_default_page, $in_default_page 16 | 17 | subcode:: post_parsing 18 | $if $in_default_page 19 | # use basic_frame if available 20 | $call check_default_page_framecode 21 | 22 | subcode: abort_default_page 23 | undef $in_default_page 24 | 25 | #------------------------------------- 26 | subcode: start_default_page 27 | my $page={_pagename=>$def->{_defname}} 28 | $call add_default_page_main_code 29 | $codetype = "code" 30 | $codeindent = 0 31 | $curindent = 0 32 | $lastindent = 0 33 | 34 | subcode: add_default_page_main_code 35 | $source=[] 36 | # default page contains only main code 37 | $(set:parent=$page) 38 | $call add_subcode, $source, "sub","main" 39 | $call start_code_indent, code, 0, $_t 40 | 41 | subcode: add_default_page(page) 42 | my $pagename = $def->{_defname} 43 | $def->{pages}->{$pagename} = $(page) 44 | push @{$def->{pagelist}}, $pagename 45 | $def->{in_default_page}=1 46 | 47 | subcode: check_default_page_framecode 48 | $if $def->{codes}->{basic_frame} 49 | $in_default_page->{_frame}="basic_frame" 50 | 51 | subcode: parse_default_page_macros 52 | $while $plines->[$cur_line]=~/^(\w+):\s*(.*)/ -> $k, $v 53 | $v=~s/\s*#.*// 54 | $if $k =~ /^(page|macros|\w+code|template)$/ 55 | last 56 | $elif $k eq "output_dir" 57 | $MyDef::var->{output_dir}=$v 58 | $call @default_page_include 59 | $else 60 | $page->{$k}=$v 61 | $cur_line++ 62 | 63 | -------------------------------------------------------------------------------- /tests/perl_test.def: -------------------------------------------------------------------------------- 1 | page: test 2 | type: pl 3 | subcode: main 4 | $call test_read_file 5 | $call test_sub 6 | $call test_for 7 | $call test_case, 1 8 | $call test_case, 2 9 | 10 | subcode: test_read_file 11 | $(set:f=perl_test.def) 12 | print "\nTest \&call open_r $(f)...\n" 13 | &call read_sub 14 | print " subcode: $1\n" 15 | 16 | subcode: read_sub 17 | &call open_r, $(f) 18 | $if /^\s*subcode:\s+(\w+)/ 19 | BLOCK 20 | 21 | subcode: test_sub 22 | print "\nTest \$sub and \$global ...\n" 23 | test_global("Hui") 24 | test_global("Xiaoyi") 25 | test_global("Harry") 26 | 27 | $sub test_global($name) 28 | $global $index=10 29 | $index++ 30 | print " $index: $name\n" 31 | 32 | subcode: test_for 33 | print "\nTest \$for ...\n" 34 | print " \$for \$i=0:10 (with , )\n " 35 | $for $i=0:10 36 | print $i 37 | $if $i<10-1 38 | print ", " 39 | 40 | print "\n \$for \$i=10:0\n " 41 | $for $i=10:0 42 | print $i, " " 43 | print "\n" 44 | 45 | # ------------------------------------ 46 | subcode: test_case(option) 47 | # DEBUG case 48 | print "\nTest \$case option $(option)...\n" 49 | my $t=4 50 | print " * \$case -> if/elsif: 4 < 5\n" 51 | $case $t<5 52 | print "$t < 5\n" 53 | $case $t<10 54 | print "5 <= $t < 10\n" 55 | 56 | $(if:option=2) 57 | print " \$case restart before \$call othercase ...\n" 58 | $call othercase 59 | 60 | $case $t<1000 61 | print "100 <= $t < 1000\n" 62 | $else 63 | print "1000 <= $t\n" 64 | 65 | subcode: othercase 66 | $case $t<100 67 | $if $t<5 68 | print "$t < 5\n" 69 | $case $t<10 70 | print "5 <= $t < 10\n" 71 | $else 72 | print "$t >= 10\n" 73 | 74 | -------------------------------------------------------------------------------- /macros_util/makestring.def: -------------------------------------------------------------------------------- 1 | #--- MAKE_STRING/POP_STRING: facilitate open gl programs 2 | 3 | subcode: compile_make_string 4 | $elif $l=~/^\$-:\s*(.*)/ 5 | push @$out, "MAKE_STRING:$1" 6 | my $subblock=grabblock($block, \$lindex) 7 | $global $MAKE_STRING 8 | $MAKE_STRING++ 9 | parseblock({source=>$subblock, name=>"MAKE_STRING"}) 10 | $MAKE_STRING-- 11 | push @$out, "POP_STRING" 12 | $elif $MAKE_STRING>0 13 | push @$out, $l 14 | 15 | #---- 16 | subcode: dumpout_make_string 17 | $elif $l=~/^MAKE_STRING:(.*)/ 18 | $call start_make_string, $1 19 | $elif $l =~/^POP_STRING/ 20 | $call pop_make_string 21 | $elif @make_string_stack 22 | $call print_line_string 23 | 24 | $(block:dumpout_init) 25 | my @make_string_stack 26 | my $string_list=undef 27 | 28 | subcode: start_make_string(line) 29 | $string_list=[] 30 | push @make_string_stack, {quote=>'"', join=>'\n', line=>$(line), list=>$string_list, indent=>$indentation} 31 | 32 | subcode: pop_make_string 33 | my $h=pop @make_string_stack 34 | $if !$h 35 | die "Error POP_STRING\n" 36 | $if @make_string_stack 37 | $string_list=$make_string_stack[-1]->{list} 38 | $else 39 | $string_list=undef 40 | 41 | my $l=$h->{line} 42 | my $join='' 43 | $if $l=~/\bSTRING\[([^\]]*)\]/ 44 | $join=$1 45 | $l=~s/\bSTRING\[[^\]]*\]/STRING/g 46 | #-- ?: STRING[, ]word? 47 | my $t=join($join, @{$h->{list}}) 48 | 49 | $if $l=~/"STRING"/ 50 | $t=~s/"/\\"/g # avoid \"? 51 | 52 | $l=~s/\bSTRING\b/$t/ 53 | $call print_line 54 | 55 | subcode: print_line_string 56 | $(set:indent=($indentation-$make_string_stack[-1]->{indent}-1)) 57 | $if $l=~/^\s*$/ 58 | # push @$f, "\n" 59 | $elif $l=~/^\s*NEWLINE\b/ 60 | push @$string_list, "" 61 | $else 62 | push @$string_list, " "x$(indent) . $l 63 | 64 | -------------------------------------------------------------------------------- /Guide.md: -------------------------------------------------------------------------------- 1 | ## MyDef Developer's Guide 2 | 3 | MyDef consists of a set of perl modules and perl scripts. 4 | 5 | Perl Modules: 6 | 7 | * mydef.def -> MyDef.pm 8 | -- Global $def, $page, $var, uses core modules, loads def files 9 | 10 | * parseutil.def -> MyDef/parseutil.pm 11 | -- def parsing routines 12 | 13 | * compileutil.def -> MyDef/compileutil.pm 14 | -- compiles, implements preprocessors and macros 15 | 16 | * dumpout.def -> MyDef/dumpout.pm 17 | -- commits to output files, implements _STUBs and spells out indentations 18 | 19 | * mydef_utils.def -> MyDef/utils.pm 20 | -- list parsing, proper splits, expand_macro, uniq_name, symbol_name 21 | 22 | Perl Scripts: 23 | 24 | * mydef_page.def -> mydef_page 25 | -- [.def] -> [.pl] (or whatever output specified by the module) 26 | 27 | * mydef_make.def -> mydef_make 28 | -- -> Makefile 29 | 30 | * mydef_run.def -> mydef_run 31 | -- [.def] -> [.pl] -> {run} (convenient script for single execution code) 32 | 33 | Output Modules: 34 | 35 | * output.def 36 | -- frame code that shared by most output modules 37 | 38 | * output_general.def -> MyDef/output_general.pm 39 | -- plain from output.def, no specials, just the facilities from compileutil.pm 40 | 41 | * output_perl.def -> MyDef/output_perl.pm 42 | -- perl. It is needed to self compile, of course 43 | 44 | Macro folders: 45 | 46 | * macros_parse/ -- for parseutil.def 47 | * macros_compile/ -- for compileutil.def 48 | * macros_make/ -- for mydef_make.def, small 49 | * macros_util/ -- certain util routines that are shared 50 | * macros_output/ -- lots of routines that can be shared among output_modules, e.g. scopes, variables, and functions 51 | 52 | Bootstrap: 53 | 54 | * bootstrap/ -- a compiled MyDef perl code from one of the previous snapshot that can be used to compile the def base 55 | 56 | * bootstrap.sh -- run it on first installation or when your MyDef installation is messed up. 57 | 58 | Others: 59 | 60 | * Misc -- omit first, then simply read the code. 61 | -------------------------------------------------------------------------------- /macros_parse/macros.def: -------------------------------------------------------------------------------- 1 | subcode:: parse_init 2 | my $macros=$def->{macros} 3 | #- import from config 4 | $while my ($k, $v)=each %$MyDef::var 5 | $if $k=~/macro_(\w+)/ 6 | $macros->{$1}=$v; 7 | 8 | #---- macros ------------------------------------ 9 | subcode: macros_start 10 | $call get_parent, macros 11 | 12 | subcode: process_macros 13 | my $macros = $codeitem 14 | $if $line=~/^(\w+):([:!=])?\s*(.*)/ 15 | my ($k,$dblcolon, $v)=($1, $2, $3) 16 | expand_macro(\$v, $macros); 17 | # $v=~s/\s+$// 18 | $if $macros->{$k}!~/^$/ 19 | $if $dblcolon eq ':' 20 | # :: append 21 | $if $v!~/^$/ 22 | $macros->{$k}.=", $v" 23 | $elif $dblcolon eq '!' 24 | # :! overwrite 25 | $macros->{$k}=$v 26 | $elif $macros->{$k} ne $v 27 | # $print "[$cur_file:$cur_line] Denied overwriting macro $k" 28 | $elif $dblcolon eq '=' 29 | # := eval 30 | $macros->{$k} = eval($v) 31 | $else 32 | $macros->{$k}=$v 33 | $elif $line=~/^(.*):\s*(.*)/ -> $t1, $t2 34 | # a, b: 1, 2 --> a=1, b=2 35 | my @klist=split /,\s*/, $t1 36 | my @vlist=MyDef::utils::get_tlist($t2) 37 | $foreach $k, $v in @klist, @vlist 38 | $macros->{$k}=$v 39 | 40 | #----------------------------------------------------- 41 | #- parse time macro expansion, 42 | #- limited to global simple macros 43 | #- only with macros defined earlier 44 | fncode: expand_macro($lref, $macros) 45 | $while $$lref=~/\$\(\w+\)/ 46 | my @segs=split /(\$\(\w+\))/, $$lref; 47 | my $j=0; 48 | my $flag=0; 49 | $foreach my $s in @segs 50 | $if $s=~/\$\((\w+)\)/ 51 | my $t=$macros->{$1}; 52 | $if $t eq $s 53 | die "Looping macro $1 in \"$$lref\"!\n"; 54 | $if defined $t 55 | $segs[$j]=$t; 56 | $flag++; 57 | $j++; 58 | $if $flag 59 | $$lref=join '', @segs; 60 | $else 61 | last; 62 | 63 | -------------------------------------------------------------------------------- /macros_parse/hacks.def: -------------------------------------------------------------------------------- 1 | subcode:8 post_parsing 2 | post_foreachfile($def); 3 | # post_matchblock($def); 4 | 5 | #---------------------------------------- 6 | # Hack for the following work: 7 | #page: order$1 8 | # output_dir: sales 9 | # foreachfile: templates/order(*).php 10 | # htmlcode: main 11 | # $call basic_process 12 | # $include templates/order$1.php 13 | 14 | fncode: post_foreachfile($def) 15 | my $pages=$def->{pages}; 16 | my $pagelist=$def->{pagelist} 17 | $while my ($name, $p)=each(%$pages) 18 | $if $p->{foreachfile} 19 | my $pat_glob=$p->{foreachfile}; 20 | my $pat_regex=$p->{foreachfile}; 21 | my $n; 22 | $n=$pat_glob=~s/\(\*\)/\*/g; 23 | $pat_regex=~s/\(\*\)/\(\.\*\)/g; 24 | my @files=glob($pat_glob); 25 | $foreach my $f in @files 26 | my @pat_list=($f=~/$pat_regex/); 27 | dupe_page($def, $p, $n, @pat_list); 28 | delete $pages->{$name}; 29 | 30 | fncode: dupe_page 31 | my ($def, $orig, $n, @pat_list)=@_; 32 | my $pagename=dupe_line($orig->{name}, $n, @pat_list); 33 | print " foreach file $pagename $n: ", join(",", @pat_list), "\n"; 34 | my $page={}; 35 | $while my ($k, $v)=each(%$orig) 36 | $if $k eq "pagename" 37 | $page->{_pagename}=$pagename; 38 | $elif $k eq "codes" 39 | my $codes={}; 40 | $while my ($tk, $tv)=each(%$v) 41 | my $tcode={}; 42 | $tcode->{type}=$tv->{type}; 43 | $tcode->{params}=$tv->{params}; 44 | my @source; 45 | my $tsource=$tv->{source}; 46 | $foreach $l in @$tsource 47 | push @source, dupe_line($l, $n, @pat_list); 48 | $tcode->{source}=\@source; 49 | $codes->{$tk}=$tcode; 50 | $page->{codes}=$codes; 51 | $elif $k ne "foreachfile" 52 | $page->{$k}=dupe_line($v); 53 | 54 | my $pages=$def->{pages}; 55 | my $pagelist=$def->{pagelist} 56 | $call add_page 57 | 58 | fncode: dupe_line 59 | my ($l, $n, @pat_list)=@_; 60 | $for my $i=1; $i<=$n; $i++ 61 | my $rep=$pat_list[$i-1]; 62 | $l=~s/\$$i/$rep/g; 63 | return $l; 64 | 65 | -------------------------------------------------------------------------------- /tests/perl_loop.def: -------------------------------------------------------------------------------- 1 | # reference: http://hz2.org/blog/einstein_notation.html 2 | 3 | #-- $sum, $loop, $sumcode means the same thing 4 | page: test 5 | module: perl 6 | 7 | $(if:0) 8 | $call test_1 9 | $(elif:1) 10 | $print \n== sumcode simple ============= 11 | $call test_sumcode 12 | $call test_sumcode_2 13 | $(else) 14 | my @a 15 | $loop(10) $a[i]=i+1 16 | print "a: ", join(', ', @a), "\n" 17 | $loop(10) $b = $a[i] 18 | $print b=$b 19 | 20 | subcode: test_sumcode 21 | $my @a 22 | print '$loop(10) $a[i]=i ', "\n" 23 | print '$loop(10) $print " i: $a[i]"', "\n" 24 | $loop(10) $a[i]=i 25 | $loop(10) $print " i: $a[i]" 26 | 27 | subcode: test_sumcode_2 28 | $my @a, @T=(0,1,1,0) 29 | print '$loop(2,2) $a[i,j]=i+j', "\n" 30 | print '$loop(2,2) $print " (i,j): $a[i,j]"', "\n" 31 | $loop(2,2) $a[i,j]=i+j 32 | $loop(2,2) $print " (i,j): $a[i,j]" 33 | 34 | $print 35 | $my @b 36 | print '$sum(2,2,2) $b[i,j]=$T[i,k]*$a[k,j]', "\n" 37 | print '$loop(2,2) print " (i,j): $b[i,j]\n"', "\n" 38 | $sum(2,2,2) $b[i,j]=$T[i,k]*$a[k,j] 39 | $loop(2,2) print " (i,j): $b[i,j]\n" 40 | 41 | #---------------------------------------- 42 | subcode: test_1 43 | my $n=5 44 | print "\$n = 5\n" 45 | 46 | $call test_for, 10, $i 47 | $call test_for, $n:0, $i 48 | $call test_for, $n:10, $i 49 | 50 | print "\n---- i0:i1:step ----\n" 51 | $call test_for, j=10:0, $j 52 | $call test_for, j=10:0:-1, $j 53 | $call test_for, j=0:10:1, $j 54 | 55 | $call test_for, k=0:100:$n, $k 56 | $call test_for, k=100:0:-$n, $k 57 | 58 | $call test_foreach, $t in 1, $t 59 | 60 | subcode: test_for(param, var) 61 | $(if:param~\$) 62 | print "\nTest \$for \$(param) ...\n " 63 | $(else) 64 | print "\nTest \$for $(param) ...\n " 65 | $for $(param) 66 | print "$(var) " 67 | print "\n" 68 | 69 | subcode: test_foreach(param, var) 70 | $(if:param~\$) 71 | print "\nTest \$foreach \$(param) ...\n " 72 | $(else) 73 | print "\nTest \$foreach $(param) ... ...\n " 74 | $foreach $(param) 75 | print "$(var) " 76 | print "\n" 77 | 78 | -------------------------------------------------------------------------------- /macros_output/perl_like.def: -------------------------------------------------------------------------------- 1 | # subcodes that used in output_perl that are reusable, e.g. output_python 2 | subcode: parse_func_list 3 | $elif $func eq "list" 4 | my @flist = MyDef::utils::proper_split($param) 5 | $foreach $name in @flist 6 | $call add_function, $name, warn 7 | return 0 8 | 9 | subcode: survey_functions 10 | $global %fn_hash 11 | %fn_hash=() 12 | &call each_subcode, fn 13 | $fn_hash{$name}=$code 14 | $call dbl_list, functions 15 | 16 | subcode: add_function(name, warn) 17 | $if $fn_hash{$(name)} 18 | $if !$functions{$(name)} 19 | push @functions, $(name) 20 | $functions{$(name)} = $MyDef::def->{codes}->{$(name)} 21 | $(if:warn=warn) 22 | $else 23 | $call warn, add_function: [$(name)] not found 24 | 25 | subcode: dump_fn_block 26 | #-- to be processed by dumpout -- reverse order due to unshift 27 | $if @$fn_block 28 | $dump->{fn_block}=$fn_block 29 | $(if:0) 30 | # subs before main 31 | push @tmp_out, "INCLUDE_BLOCK fn_block" 32 | $(else) 33 | # subs after main 34 | push @$out, "NEWLINE?" 35 | push @$out, "# ---- subroutines ----"."-"x40 36 | push @$out, "INCLUDE_BLOCK fn_block" 37 | 38 | # called if $l=~/^NOOP POST_MAIN/ 39 | subcode: list_functions 40 | $global $fn_block=[], @fn_decls 41 | &call replace_output, $fn_block 42 | $call autolist_functions 43 | 44 | # $while my $name = pop @functions 45 | $foreach $name in @functions 46 | my $code = $functions{$name} 47 | parse_function($name, $code) 48 | 49 | subcode: autolist_functions 50 | &call each_subcode, fn 51 | # $name, $code 52 | $if !$functions{$name} 53 | $if $page->{autolist} 54 | $call add_, $name, $code 55 | $else 56 | &call check_autolist 57 | $call add_, $name, $code 58 | subcode: add_(name, code) 59 | push @functions, $(name) 60 | $functions{$(name)} = $(code) 61 | 62 | subcode: check_autolist 63 | my $autolist 64 | $foreach $l in @{$code->{source}} 65 | $if $l=~/autolist:\s(.*)/ 66 | $autolist=$1 67 | $l="NOOP" 68 | last 69 | $if $autolist 70 | BLOCK 71 | -------------------------------------------------------------------------------- /docs/mydef.vim: -------------------------------------------------------------------------------- 1 | :syntax match CallPlace /^\s*\$call\s+@\i\+/ 2 | :highlight link CallPlace Special 3 | 4 | :syntax match xKey /^\s*\$\i\+/ 5 | :syntax match xHTML /^\s*\$Call.*/ 6 | :syntax match label /^\s*\$label.*/ 7 | :syntax match xPrefix /\$\./ 8 | :syntax match xKey /^\s*&call/ 9 | :syntax match xKey /^\s*\$(set:.*)/ 10 | :syntax match xMacro /\$([^)]*)/ 11 | 12 | :syntax match xCode /^\s*\$\(subclass\|method\)\s/ 13 | :syntax match xHTML /HTML_\I\+/ 14 | :syntax match xHTML /BLOCK\|DUMP_STUB/ 15 | :syntax match xCode /^\s*\(sub\|fn\|js\|perl\|php\|html\)code:/ 16 | :syntax match xStage /^\(subpage\|page\|form\|table\|fields\|macros\|resource\):/ 17 | " Comments with #. Caution with cases CSS color, Perl $# 18 | :syntax match xComment /^\s*#[^-].*/ " Leading # 19 | :syntax match xComment /\s#[ :][^-].*$/ " Trailing [ ]# 20 | :syntax match xCommentImportant /^\s*#[-#].*/ 21 | :syntax match xCommentImportant /\s# -.*$/ " Trailing [ ]# 22 | 23 | :syntax match xHighlight /^.*\(#:\)\@=/ 24 | :highlight xHighlight ctermfg=9 25 | 26 | :syntax region xComment start=/\(\/\|\\x2f\)\*/ end=/\*\// 27 | 28 | :syntax region dString start=/"/ skip=/\\"/ end=/"/ oneline contains=xMacro 29 | :syntax region sString start=/'/ skip=/\\'/ end=/'/ oneline 30 | 31 | :syntax match perlKey /^\s*\(push\|shift\|unshift\|pop\|print\|return\|goto\|last\|next\|break\|continue\)\>/ 32 | :syntax match pythonKey /^\s*\(if\|elif\|else\|while\|for\|def\|class\)\>/ 33 | 34 | :syntax match xLabel /^\s*\i\+:/ contains=xCode,xStage 35 | :syntax match xInclude /^\(include\|path\):.*/ 36 | :syntax match xCSS /CSS: .*/ 37 | 38 | :syntax match perlVar /\(\$\|@\|%\)\i\+/ 39 | :syntax match perlKey /^\s*\(our\|my\|package\|use\|require\|sub\)\s/ 40 | :syntax region perlRegex start=+\(\([!=][~]\|split\|if\|while\)\s*\)\@<=/+ skip=+\\/+ end=+/[cgimopsx]*+ oneline 41 | 42 | :highlight link dString String 43 | :highlight link sString String 44 | :highlight link xKey Type 45 | :highlight link xMacro Type 46 | :highlight link xCSS Underlined 47 | :highlight link xCode Statement 48 | :highlight link xStage Statement 49 | :highlight link xComment NonText 50 | :highlight link xCommentImportant Comment 51 | 52 | " :highlight link xInclude Include 53 | :highlight xInclude term=underline cterm=bold ctermfg=81 guifg=#ff80ff 54 | :highlight xLabel term=bold cterm=bold 55 | 56 | :highlight link xHTML Special 57 | 58 | :highlight link perlVar Comment 59 | :highlight link perlKey Statement 60 | :highlight link pythonKey Type 61 | :highlight link perlRegex String 62 | 63 | " :highlight link xPrefix Keyword 64 | " :highlight xPrefix term=bold cterm=bold 65 | 66 | -------------------------------------------------------------------------------- /macros_util/ogdl.def: -------------------------------------------------------------------------------- 1 | fncode: grab_ogdl 2 | my ($ogdl, $llist)=@_; 3 | my $cur_i=0; 4 | my $cur_item=$ogdl 5 | my $last_item; 6 | my $last_item_type; 7 | my $last_item_key; 8 | 9 | my @ogdl_stack; 10 | $foreach my $l in @$llist 11 | $if $l=~/^(\d)+:(.*)/ 12 | my ($i, $l)=($1, $2) 13 | $if $l=~/^NOOP/ 14 | next 15 | # ---- check indentation 16 | $if $i>$cur_i 17 | push @ogdl_stack, $cur_item; 18 | $cur_item={"_list"=>[]} 19 | $if $last_item_type eq "array" 20 | $cur_item->{"_name"}=$last_item->[-1] 21 | $last_item->[-1]=$cur_item 22 | $elif $last_item_type eq "hash" 23 | $cur_item->{"_name"}=$last_item->{$last_item_key} 24 | $last_item->{$last_item_key}=$cur_item 25 | # ---- 26 | $cur_i=$i; 27 | $elif $i<$cur_i 28 | $while $i<$cur_i 29 | $cur_item=pop @ogdl_stack 30 | $cur_i--; 31 | 32 | # ---- add item 33 | $if $cur_item 34 | $if $l=~/(^\S+?):\s*(.+)/ 35 | my ($k, $v)=($1, $2); 36 | $cur_item->{$k}=$v; 37 | $last_item=$cur_item 38 | $last_item_type="hash" 39 | $last_item_key=$k 40 | $elif $l=~/(^\S+):\s*$/ 41 | my $k=$1; 42 | $cur_item->{$k}="" 43 | $last_item=$cur_item 44 | $last_item_type="hash" 45 | $last_item_key=$k 46 | $else 47 | my @t 48 | $if $l !~/\(/ 49 | @t=split /,\s*/, $l; 50 | $else 51 | push @t, $l 52 | $foreach my $t in @t 53 | push @{$cur_item->{_list}}, $t 54 | $last_item=$cur_item->{_list} 55 | $last_item_type="array" 56 | return $ogdl; 57 | 58 | fncode: print_ogdl 59 | my $ogdl=shift; 60 | my $indent=shift; 61 | $if ref($ogdl) eq "HASH" 62 | $if $ogdl->{_name} ne "_" 63 | print " "x$indent, $ogdl->{_name}, "\n"; 64 | $indent++ 65 | $while my ($k, $v) = each %$ogdl 66 | $if $k!~/^_(list|name)/ 67 | print " "x$indent, $k, ":\n"; 68 | print_ogdl($v, $indent+1) 69 | $foreach my $v in @{$ogdl->{_list}} 70 | print_ogdl($v, $indent) 71 | $else 72 | print " "x$indent, $ogdl, "\n"; 73 | 74 | -------------------------------------------------------------------------------- /docs/block_release.txt: -------------------------------------------------------------------------------- 1 | In the output module we may need implement some construct that will wrap up at the end of a code block. For example, in output_c, we have $local_allocate to *malloc* some memory that will be *free* at the end of the block. 2 | 3 | However, what is a block is of question. Often, mydef blocks are narrower then a semantic block. For example: 4 | 5 | fncode: t 6 | $local pf_temp 7 | $call setup 8 | work with pf_temp 9 | 10 | subcode: setup 11 | $local_allocate(100) pf_temp 12 | 13 | and you will be suprised to find pf_temp is being freed right after being allocated (in fact, at the end of subcode: setup). Of course that is not ideal. To remedy, there is `BLOCK RELEASE`: 14 | 15 | subcode: setup 16 | BLOCK RELEASE 17 | $local_allocate(100) pf_temp 18 | 19 | From compile/parse.def, what `BLOCK RELEASE` does is simply: 20 | 21 | $block_stack[-1]->{eindex}=$block_stack[-2]->{eindex} 22 | 23 | Each MyDef block has an auto increasing index; and each block have two stub -- block$idx_pre and block$idx_post -- so the output modules and mydef code could inject initialization and collection code into them. 24 | 25 | `eindex` means effective index and is by default the same as block index. Upon `BLOCK RELEASE`, the eindex is set to the block index of one level higher. So with it, the wrapping code will be injected to the end of block at one level higher. 26 | 27 | # Block chain 28 | 29 | Block levels are maintained by a simple stack (`compile/parse.def:@block_stack). Each time `MyDef::compileutils::parseblock` is called, one new block level is established which will get released upon exit. So it is essentially `parseblock` recursive levels. 30 | 31 | It is trivia to understand simple `$call` 32 | 33 | subcode: a 34 | $call b 35 | 36 | subcode: b 37 | blah 38 | 39 | Here, a is one level higher than b. However, parseblock is not only used in calling subcode. New level is also established at preproc blocks: 40 | 41 | $(if:macroname) 42 | This will be a new block with one level deeper 43 | 44 | Module implemented blocks: 45 | 46 | # module: c 47 | $if condition 48 | # new block level here 49 | 50 | And there is this tricky callback: 51 | 52 | &call subcode_with_BLOCK 53 | code to be inserted 54 | 55 | `&call` will `parseblock` the subcode, which is just as normal subcode (which establishes a new level). And upon parsing `BLOCK` line, `parseblock` will recurse and parse the inserted block. So the inserted block is actually two levels deeper than the text just above. Then inserted code block is being pushed onto a `@callback_block_stack` so nested callbacks are possible and levels will just gets deeper upon nesting. 56 | -------------------------------------------------------------------------------- /macros_make/makefile_c.def: -------------------------------------------------------------------------------- 1 | macros: 2 | win32_cc: x86_64-w64-mingw32-gcc 3 | win32_rc: x86_64-w64-mingw32-windres 4 | 5 | subcode: makefile_c(dir) 6 | my $t_module 7 | $(for:CC,CFLAGS,LIB,RC) 8 | $my $$1 9 | 10 | $call get_target_list 11 | $if !$t_module 12 | $t_module = $module 13 | $print " module: $t_module" 14 | $if @target_list 15 | &call open_w, $(dir)/Makefile 16 | $call dump_variable 17 | $call dump_target 18 | $call dump_implicit 19 | 20 | # -------------------------- 21 | subcode: target_page_specific 22 | $(for:CC,CFLAGS,LIB) 23 | $if $page->{$1} 24 | $$1 = $page->{$1} 25 | 26 | $if $page->{make}=~/win32/ 27 | $CC = "$(win32_cc)" 28 | 29 | # --------------------- 30 | subcode: dump_variable 31 | $call set_CC 32 | $(for:CC,CFLAGS,LIB) 33 | print Out "$1=$$1\n" 34 | $if $RC 35 | print Out "RC=$RC\n" 36 | print Out "\n" 37 | 38 | subcode: set_CC 39 | $if !$CC 40 | $if $t_module eq "win32" 41 | $CC = "$(win32_cc)" 42 | $RC = "$(win32_rc)" 43 | $LIB = "-Wl,-subsystem,windows" 44 | $else 45 | $CC = "gcc" 46 | 47 | # --------------------- 48 | subcode: dump_target 49 | $foreach $t in @target_list 50 | my ($page, $name)=@$t 51 | $call get_obj_list 52 | $call get_lib_list 53 | my $target = $name 54 | $if $t_module eq "win32" or $page->{make}=~/win32/ 55 | $target = "$name.exe" 56 | 57 | print Out "$target: $obj_list\n" 58 | $: print Out "\t\$(CC) -o $target \$^ \$(LIB) $lib_list \n"; 59 | print Out "\n" 60 | 61 | subcode: get_obj_list 62 | my @objs = ("$name.o") 63 | $if $page->{other} 64 | my @tlist = split /,\s*/, $page->{other} 65 | $foreach $p in @tlist 66 | push @objs, "$p.o" 67 | my $obj_list = join(' ', @objs) 68 | 69 | subcode: get_lib_list 70 | my $lib_list 71 | # if $name.c exists and it is forced mydef_make, 72 | # it can be copied from head comment 73 | $if -f "$(dir)/$name.c" 74 | &call open_r, $(dir)/$name.c 75 | $if /^\/\*\s*link:\s*(.*?)\s*\*\/$/ 76 | $lib_list = $1 77 | last 78 | 79 | # --------------------- 80 | subcode: dump_implicit 81 | print Out "%.o: %.c\n" 82 | $: print Out "\t\$(CC) -c \$(CFLAGS) -o \$@ \$<\n"; 83 | print Out "\n" 84 | 85 | $if $RC 86 | print Out "%.o: %.rc\n" 87 | $: print Out "\t\$(RC) \$< \$@ \n"; 88 | print Out "\n" 89 | 90 | -------------------------------------------------------------------------------- /manual/mydef.def: -------------------------------------------------------------------------------- 1 | # A manual in a style of https://www.gnu.org/software/m4/manual/m4.html 2 | include: html/code.def 3 | 4 | include: intro.def 5 | include: install.def 6 | include: syntax.def 7 | include: output_general.def 8 | include: output_perl.def 9 | 10 | page: mydef, basic_frame 11 | module: www 12 | title: MyDef Manual 13 | 14 | $call css_manual 15 | $call css_code 16 | $h1 17 | $(title) 18 | $call TOC 19 | $call @sections 20 | $call section, c, $(code:output_c) 21 | $p 22 | [To be continued.] 23 | $call section, www, $(code:output_www) 24 | $p 25 | [To be continued.] 26 | $call section, python, $(code:output_python) 27 | $p 28 | [To be continued.] 29 | $call section, java, $(code:output_java) 30 | $p 31 | [To be continued.] 32 | 33 | $call end_section 34 | 35 | #---------------------------------------- 36 | subcode: TOC 37 | $(anchor:TOC) 38 | $h2 contents-heading 39 | Table of Contents 40 | $div contents 41 | $ul no-bullet id1 42 | DUMP_STUB _toc 43 | 44 | subcode: section(name, @title) 45 | $call end_section 46 | $(setmacro:id1+=1) 47 | $(block:_toc) 48 |
  • $(id1) $(title) 49 | $(setmacro:id2=0) 50 | # -------------------- 51 | $(anchor:$(name)) 52 | $h2 chapter 53 | $(id1) $(title) 54 | 55 | subcode: subsection(name, @title) 56 | $(block:_toc) 57 | $(if:id2=0) 58 |
      59 | $(setmacro:id2+=1) 60 |
    • $(id1).$(id2) $(title)
      • 61 | # -------------------- 62 | $(anchor:$(name)) 63 | $h3 section 64 | $(id1).$(id2) $(title) 65 | 66 | subcode: end_section 67 | $(block:_toc) 68 | $(if:id1>0) 69 | $(if:id2>0) 70 |
    71 |
    • 72 | 73 | subcode: css_manual 74 | CSS: body {padding: 50px} 75 | CSS: ul.no-bullet {list-style: none; padding: 0} 76 | CSS: ul.id1 {font-weight:bold} 77 | CSS: ul.id2 {font-weight:normal} 78 | CSS: li {margin: 0.5em 1em; line-height:1.3em;} 79 | CSS: a[href] {color: #005090} 80 | CSS: a {text-decoration: none; outline-style:none;} 81 | CSS: pre {border-radius: 0.3em; background-color: #f2efe4} 82 | 83 | subcode: css_code 84 | CSS: pre {margin: 4px 10px; padding-left: 20px;} 85 | CSS: pre strong {color: #444; font-weight:700} 86 | CSS: .mydef-comment {color: #888; font-style: italic} # gray 87 | CSS: .mydef-label {color: #22f;} # blue 88 | CSS: .mydef-label2 {color: #228;} # blueish 89 | CSS: .mydef-keyword {color: #494; font-weight: 700} # green 90 | CSS: .mydef-preproc {color: #844;} # reddish 91 | CSS: .mydef-include {color: #444; text-decoration: underline;} 92 | CSS: .mydef-quote {color: #a2a;} 93 | CSS: .mydef-macro {color: #474;} 94 | CSS: .mydef-special {color: #888; font-weight: 700} 95 | 96 | subcode:: other_code_filters 97 | $case $type eq "sh" 98 | $call sh_filter 99 | -------------------------------------------------------------------------------- /macros_parse/indentation.def: -------------------------------------------------------------------------------- 1 | macros: 2 | top: "top",0,$def 3 | 4 | subcode:: import_file_init 5 | my $curindent=0 6 | my ($codetype, $codeindent, $codeitem) = ($(top)) 7 | my @indent_stack 8 | 9 | macros: 10 | top_scope: $curindent == $codeindent and $codetype ne "macro" 11 | in_code: $codetype eq "code" and ($codeindent>0 or $in_default_page) 12 | in_macro: $codetype eq "macro" and $codeindent>0 13 | 14 | subcode: start_code_indent(type, indent, item) 15 | # $print start_code_indent $(type) - $(indent) - $(item) 16 | $(if:type=page) 17 | @indent_stack=([$(top)]) 18 | $(else) 19 | push @indent_stack, [$codetype, $codeindent, $codeitem] 20 | $codetype = "$(type)" 21 | $codeindent = $(indent) 22 | $codeitem = $(item) 23 | # prevent starting empty line triger dedent 24 | $curindent=$(indent) 25 | $lastindent = $curindent 26 | 27 | subcode: check_end_codeindent 28 | $while $curindent <$codeindent or ($(stub:default_page_end)) 29 | $call @codeitem_pre_end 30 | my $t = pop @indent_stack 31 | ($codetype, $codeindent, $codeitem) = @$t 32 | $lastindent = $codeindent 33 | $call @codeitem_post_end 34 | 35 | bypasscode: default_page_end 36 | $in_default_page 37 | and $line=~/^END/ 38 | and $curindent==0 39 | and @indent_stack 40 | 41 | #---------------------------------------- 42 | subcode:: import_file_init 43 | my $pages=$def->{pages} 44 | my $pagelist=$def->{pagelist} 45 | my $macros=$def->{macros} 46 | 47 | #---------------------------------------- 48 | subcode: update_source_pos 49 | $if $line_skipped 50 | $call set_source_pos_1 51 | $line_skipped=0 52 | 53 | subcode:: import_file_init 54 | my $lastindent; 55 | 56 | subcode: get_source_indent(curindent) 57 | $while $(curindent)>$lastindent 58 | $lastindent++; 59 | $call source_indent 60 | 61 | subcode: get_source_dedent(curindent) 62 | $while $(curindent)<$lastindent 63 | $lastindent--; 64 | $call source_dedent 65 | # -------------------- 66 | subcode:: codeitem_pre_end 67 | $if $codetype eq "code" 68 | $call get_source_dedent, $codeindent 69 | 70 | #---------------------------------------- 71 | subcode: get_parent(what) 72 | $(if:parent) 73 | # hack used in jump_to_main_code and add_default_page_main_code 74 | my $parent=$(parent) 75 | $(else) 76 | my $parent 77 | $if $curindent==0 78 | $parent = $def 79 | $elif $curindent==1 and $#indent_stack==1 and !$in_default_page 80 | # [page, main code]: take page 81 | # [main code, top code]: take top 82 | $parent = $indent_stack[1]->[2] 83 | $else 84 | $parent = $codeitem 85 | # -------------------- 86 | my $$(what) 87 | $if !$parent->{$(what)} 88 | $(if:what=code_list) 89 | $$(what) = [] 90 | $(else) 91 | $$(what) = {} 92 | $parent->{$(what)}=$$(what) 93 | $else 94 | $$(what) = $parent->{$(what)} 95 | 96 | -------------------------------------------------------------------------------- /manual/output_general.def: -------------------------------------------------------------------------------- 1 | subcode:: sections 2 | $call section, general, $(code:output_general) 3 | 4 | $p 5 | In this chapter, we will explain the internals of $(code:MyDef). 6 | $p 7 | $(code:output_general) is the default output module. It essentially only uses the syntax we have covered so far; nothing more. 8 | $p 9 | However, much of the power of $(code:MyDef) eventually will come from language or application specific output modules. So at some point, you would need to understand some of $(code:MyDef)'s internal working. $(code:output_general) module is the starting point for every output module. 10 | 11 | $call subsection, general_code, $(code:output_general.def) 12 | 13 | &call codeprint, mydef 14 | include: output.def 15 | 16 | page: output_general, output_main 17 | type: pm 18 | output_dir: lib/MyDef 19 | ext: txt 20 | package: MyDef::output_general 21 | 22 | $p 23 | The actual code is in a subcode $(code:output_main) defined in $(code:output.def). 24 | 25 | $call subsection, general_output, $(code:output.def) 26 | $p 27 | File $(code:output.def) provides boiler-plate code that most output modules will share: 28 | 29 | &call codeprint, mydef 30 | subcode: output_main 31 | $global $debug=0 32 | $global $out 33 | $global $mode 34 | $global $page 35 | $call @package_globals 36 | 37 | $sub get_interface 38 | return (\&init_page, \&parsecode, \&set_output, \&modeswitch, \&dumpout); 39 | 40 | $sub init_page($t_page) 41 | $page=$t_page 42 | # [... omitted code for per page initialization ...] 43 | 44 | $sub set_output($newout) 45 | $out = $newout 46 | 47 | $sub modeswitch($mode, $in) 48 | $call @modeswitch 49 | 50 | # ---- All specialized parsing goes here. 51 | $sub parsecode($l) 52 | $if $l=~/^\$warn (.*)/ 53 | $call warn, $1 54 | return 55 | $elif $l=~/^\$template\s+(.*)/ 56 | # [... omitted code to read-in template ...] 57 | return 58 | $call parsecode_debug 59 | $call parsecode_eval 60 | $call parsecode 61 | 62 | # ---- Final output, allows for 2nd pass translation 63 | $sub dumpout($f, $out) 64 | my $dump={out=>$out,f=>$f} 65 | $call @dumpout 66 | MyDef::dumpout::dumpout($dump); 67 | 68 | $call single_blocks 69 | $call @support_subs 70 | 71 | 1; 72 | $p 73 | $(code:subcode: parsecode) is where we apply preprocessing logic for each line. $(code:output.def) provides a default stub which simply pushes the line straight to $(code:@$out). It is supposed to be overwritten in the actual output module. For $(code:output_general), it is good enough: 74 | &call codeprint, mydef 75 | subcode:@ parsecode 76 | push @$out, $l 77 | 78 | -------------------------------------------------------------------------------- /tests/perl_macros.def: -------------------------------------------------------------------------------- 1 | page: test 2 | module: perl 3 | a: a 4 | b: 1 5 | 6 | $(if:1) 7 | $call test_for_in_list 8 | $(elif:1) 9 | $print [join:(..):sep:list] $(join:($1-1):*:x,y,z) 10 | $print [join:pat:sep:list] $(join:*:-:a-z) 11 | $print [nest:n:pat:inner] $(nest:5:sqrt(*):10) 12 | $print [x10,:pat] $(x10,:pat) 13 | $print [join:::and list] $(join:$1$2:,:x-z and 1-3) 14 | $print [join:::mul list] $(join:$1$2:,:x,y mul 1,2,3) 15 | $(elif:0) 16 | $call test_eval 17 | $(elif:1) 18 | print "page macro a: $(a)\n" 19 | $(if:word:a) 20 | $warn macro a is a word : [$(a)] 21 | $(if:!word:b) 22 | $warn macro b is not a word : [$(b)] 23 | $call test_inline, example 24 | $call test_for_list 25 | $call test_macro_join 26 | $call test_macro_split 27 | $(else) 28 | $call test_named_macros 29 | 30 | subcode: test_for_in_list 31 | $print [for in a-c,1-5] - 32 | $(for:a in a-c,1-5) 33 | $print "$(a)-" 34 | $print 35 | 36 | $print [for in eclusion] - 37 | $(for:a in 1-3) 38 | $(set:b=$(join:$1:,:1-3/$(a))) 39 | $print $(b) - - 40 | $print 41 | 42 | $print [join rotate] - 43 | $(for:a in 0-2) 44 | $(export:t$(a)=$(join:rot$(a):,:1-3)) 45 | $print ($(t0)) ($(t1)) ($(t2)) 46 | 47 | subcode: test_named_macros 48 | # DEBUG macro 49 | $(set:a=current) 50 | $print test_current: a = $(a) 51 | $(if:1) 52 | $(set:a=new value) 53 | $print test_set_in_if (should change): a = $(a) 54 | 55 | $call subset1 56 | $print test_named_macros (def,macro,page): $(a1), $(a2), $(a3), $(a4), $(a5), $(a6) 57 | $call immediate 58 | $print test_immediate (should expire): a1 = $(a1) 59 | $call oneup 60 | $print test_oneup (should overwrite): a1 = $(a1) 61 | 62 | subcode: subset1 63 | $(setdef:a1=def) 64 | $(setmacro:a2=macro) 65 | $(setpage:a3=page) 66 | $(set0:a4=def) 67 | $(set1:a5=macro) 68 | $(set2:a6=page) 69 | subcode: immediate 70 | $(set:a1=immediate) 71 | subcode: oneup 72 | $(set-1:a1=oneup) 73 | 74 | subcode: test_eval 75 | $(set:t=lowercase) 76 | $(eval:t2=ucfirst("$(t)")) 77 | $print test_eval: t=$(t) ucfirst("\x24(t)") -> $(t2) 78 | 79 | $(set:t=1) 80 | $(eval:t3=t+1) 81 | $print test_eval: t=$(t), t+1 -> $(t3) 82 | 83 | subcode: test_inline(t) 84 | $(set:inline=test_inline(\"$1\")) 85 | $print "test_inline: $(t) -> $(inline:$(t))" 86 | 87 | subcode: test_for_list 88 | $print "\nfor list:\n" 89 | $(for:i, j, k and x, y, z and 1, 2, 3) 90 | $print " $2_$1 -> $3" 91 | 92 | subcode: test_macro_join 93 | $(set:cond) join, ' or ', 'N!=*', 2, 4, 8, 16 94 | $print test_macro_join: $(cond) 95 | 96 | subcode: test_macro_split 97 | $(set:s=a-b-c) 98 | $(split:-:s) 99 | $print split $(s): $(p_1) - $(p_2) - $(p_3) 100 | 101 | $(set:s=192.168.2.8) 102 | $(split:\.:s) 103 | $print split $(s): $(p_1) - $(p_2) - $(p_3) - $(p_4) 104 | -------------------------------------------------------------------------------- /docs/blockscope.txt: -------------------------------------------------------------------------------- 1 | compile/parse.def: parseblock($code) 2 | ... 3 | parse_stack_push($code) 4 | $while ... 5 | ... 6 | $call compile_line 7 | ... 8 | parse_stack_pop() 9 | 10 | #---- pre/post scope (local_allocate) ------------------------------------------- 11 | fncode: parse_stack_push($code) 12 | my $blk={out=>, index=>$block_index, ...} 13 | $if $code->{scope} 14 | $f_parse->("SUBBLOCK BEGIN $idx $scope") 15 | push @$out, "DUMP_STUB block$idx\_pre" 16 | 17 | fncode: parse_stack_pop 18 | $if $blk->{scope} 19 | $f_parse->("SUBBLOCK END $blk->{index} $blk->{scope}") 20 | $if $named_blocks{"block$idx\_post"} 21 | push @$out, "DUMP_STUB block$idx\_post" 22 | 23 | # MyDef::compileutil::get_named_block("_pre/post") gets the pre/post blocks of blk eindex 24 | 25 | subcode: parse_catch_meta 26 | ... 27 | $elif $l =~ /^BLOCK RELEASE/i 28 | $block_stack[-1]->{eindex}=$block_stack[-2]->{eindex} 29 | next 30 | 31 | #--- macro scope --------------------- 32 | All callsubs establishes new macro context 33 | 34 | #--- grep callblock ----------------- 35 | compile/callsub.def: &call parseblock_with_macro 36 | compile/callsub.def: parseblock($codelib) 37 | compile/callsub.def: parseblock($codelib) 38 | compile/callsub.def: &call parseblock_with_macro 39 | compile/callsub.def: &call parseblock_with_macro 40 | compile/callsub.def: &call parseblock_with_macro 41 | compile/callsub.def:subcode: parseblock_with_macro 42 | compile/callsub.def: parseblock($codelib); 43 | 44 | compile/list.def: parseblock({source=>$subblock, name=>"list_each $key"}) 45 | compile/ogdl.def:subcode:: parseblock_init 46 | compile/ogdl.def: parseblock({source=>$subblock, name=>"\${ogdl_each}"}) 47 | 48 | compile/parse.def:#- parseblock() 49 | compile/parse.def:fncode: parseblock($code) 50 | compile/parse.def: warn "parseblock: undefined block [$code]\n" 51 | compile/parse.def: $call @parseblock_init 52 | compile/parse.def: parseblock($block) 53 | compile/parse.def: parseblock({source=>$subblock, name=>"MAKE_STRING"}) 54 | compile/parse.def: parseblock({source=>$blk, name=>"capture"}) 55 | compile/parse.def: parseblock({source=>$subblock, name=>"BLOCK", scope=>$callback_scope}) 56 | 57 | compile/preproc.def: parseblock({source=>$subblock, name=>"block:$name"}) 58 | compile/preproc.def: parseblock({source=>$subblock, name=>"\${for}"}) 59 | compile/preproc.def: parseblock({source=>\@block, name=>"\${for:list}"}) 60 | compile/preproc.def: parseblock({source=>$subblock, name=>"\${foreach}"}) 61 | compile/preproc.def:subcode:: parseblock_init 62 | compile/preproc.def: parseblock({source=>$subblock, name=>"\${else}"}) 63 | compile/preproc.def: parseblock({source=>$subblock, name=>"\${ifeach:}"}) 64 | compile/preproc.def: parseblock({source=>$subblock, name=>"\${if:}"}) 65 | 66 | deflib/ext.def: MyDef::compileutil::parseblock({source=>\@source, name=>"filtered"}) 67 | 68 | macros_output/sumcode.def: MyDef::compileutil::parseblock({source=>$codelist, name=>"sumcode"}) 69 | -------------------------------------------------------------------------------- /macros_util/resource.def: -------------------------------------------------------------------------------- 1 | # 2 | subcode: fetch_named_resource(type) 3 | my $resource_name="$(type)_$name" 4 | $if $name=~/^$(type)_/ 5 | $resource_name=$name 6 | $$(type) = $MyDef::def->{resource}->{$resource_name} 7 | $if !$$(type) 8 | print "Resource $(type): $name does not exist\n" 9 | return 10 | 11 | # ----------------------------------- 12 | subcode: collect_view_attr(view) 13 | my ($x, $y, $w, $h) 14 | $if !$view->{processed} 15 | my $name=$(view)->{_name} 16 | # default 0 17 | $call res_init_attr, view 18 | # default 1 19 | $call res_update, "view_$name" 20 | $call res_update, "ctl_$name" 21 | # last 22 | $call res_fill_attr, $(view) 23 | # ---- position, size --------- 24 | ($x, $y)=split /,\s*/, $(view)->{position} 25 | ($w, $h)=split /,\s*/, $(view)->{size} 26 | $if $x=~/-(.*)/ and $w=~/-.*/ 27 | $x=$1 28 | $if $y=~/-(.*)/ and $h=~/-.*/ 29 | $y=$1 30 | $(view)->{x}=$x 31 | $(view)->{y}=$y 32 | $(view)->{w}=$w 33 | $(view)->{h}=$h 34 | $if $x=~/-(.*)/ or $y=~/-(.*)/ or $w=~/-(.*)/ or $h=~/-(.*)/ 35 | $(view)->{docked}=1 36 | $else 37 | $(view)->{docked}=0 38 | # ---- flag ---- 39 | $(view)->{processed}=1 40 | $else 41 | $x=$(view)->{x} 42 | $y=$(view)->{y} 43 | $w=$(view)->{w} 44 | $h=$(view)->{h} 45 | 46 | 47 | subcode: get_res_view_attr(view) 48 | # default 0 49 | $call res_init_attr, view 50 | # default 1 51 | $call res_update, "view_$name" 52 | $call res_update, "ctl_$name" 53 | # last 54 | $call res_update_attr, $(view) 55 | my ($x, $y)=split /,\s*/, $attr{position} 56 | my ($w, $h)=split /,\s*/, $attr{size} 57 | $if $x=~/-(.*)/ and $w=~/-.*/ 58 | $x=$1 59 | $if $y=~/-(.*)/ and $h=~/-.*/ 60 | $y=$1 61 | 62 | 63 | subcode: check_window_dock(view) 64 | my $docked=0 65 | $call get_res_view_attr, $(view) 66 | $if $x=~/-(.*)/ 67 | $docked=1 68 | $x="rect_client.right-$w-$1" 69 | $if $y=~/-(.*)/ 70 | $docked=1 71 | $y="rect_client.bottom-$h-$1" 72 | $if $w=~/-(.*)/ 73 | $docked=1 74 | $w="rect_client.right-$x-$1" 75 | $if $h=~/-(.*)/ 76 | $docked=1 77 | $h="rect_client.bottom-$y-$1" 78 | $view->{position}="$x, $y" 79 | $view->{size}="$w, $h" 80 | $view->{docked}=$docked 81 | 82 | 83 | # -------- --------------------------------------- 84 | subcode: res_update_attr(a) 85 | $while my ($k, $v)=each %$(a) 86 | $if $k!~/^_(name|list)/ 87 | $attr{$k}=$v 88 | 89 | subcode: res_fill_attr(a) 90 | $while my ($k, $v)=each %attr 91 | $if !defined $(a)->{$k} 92 | $(a)->{$k} = $v 93 | # ---- 94 | subcode: res_init_attr(type) 95 | my %attr; 96 | my $default=$MyDef::def->{resource}->{default_$(type)} 97 | $call res_update_attr, $default 98 | 99 | subcode: res_update(tag) 100 | my $a=$MyDef::def->{resource}->{$(tag)} 101 | $if $a 102 | $call res_update_attr, $a 103 | 104 | subcode: res_fill(s) 105 | $while my ($k, $v)=each %attr 106 | $if $k!~/^_(name|list)/ 107 | $if $v=~/^"(.*)"/ 108 | push @$out, "strcpy($(s).$k, $v);" 109 | $else 110 | push @$out, "$(s).$k = $v;" 111 | 112 | -------------------------------------------------------------------------------- /macros_compile/ogdl.def: -------------------------------------------------------------------------------- 1 | 2 | subcode:: preproc_elifs 3 | $elif $preproc=~/^ogdl_/ 4 | $call ogdl_parse 5 | 6 | subcode:: testcondition_elifs 7 | $elif $cond=~/^ogdl_/ 8 | $call ogdl_condition 9 | 10 | # --------------------------- 11 | fncode: get_ogdl($name) 12 | $cur_ogdl=$MyDef::def->{resource}->{$name} 13 | $if !$cur_ogdl 14 | die "Resource $name does not exist!\n" 15 | $else 16 | $call ogdl_inherit 17 | return $cur_ogdl 18 | 19 | subcode: ogdl_inherit 20 | $if $cur_ogdl->{_parents} 21 | my @parent_list=@{$cur_ogdl->{_parents}} 22 | $while my $pname=pop @parent_list 23 | my $ogdl=$MyDef::def->{resource}->{$pname} 24 | $if $ogdl 25 | $while my ($k, $v)=each %$ogdl 26 | $if !$cur_ogdl->{$k} 27 | $cur_ogdl->{$k}=$v 28 | $elif $k eq "_list" 29 | $if @$v 30 | unshift @{$cur_ogdl->{_list}}, @$v 31 | # --------------------------- 32 | subcode:: parseblock_init 33 | $global $cur_ogdl 34 | my @ogdl_stack 35 | my @ogdl_path 36 | my $ogdl_path_index_base 37 | my %ogdl_path_index 38 | 39 | subcode: ogdl_parse 40 | expand_macro(\$preproc) 41 | $if $preproc=~/^ogdl_load:\s*(\w+)/ 42 | get_ogdl($1) 43 | $elif $preproc=~/^ogdl_each/ 44 | my $subblock=grabblock($block, \$lindex); 45 | my $itemlist=$cur_ogdl->{_list} 46 | push @ogdl_stack, $cur_ogdl 47 | $foreach $item in @$itemlist 48 | $cur_ogdl=$item 49 | parseblock({source=>$subblock, name=>"\${ogdl_each}"}) 50 | $cur_ogdl=pop @ogdl_stack 51 | $elif $preproc=~/^ogdl_set_path:(\d+)=(.*)/ 52 | $ogdl_path[$1]=$2 53 | $elif $preproc=~/^ogdl_path_init/ 54 | $ogdl_path_index_base=0 55 | $elif $preproc=~/^ogdl_path:(\d+)/ 56 | splice @ogdl_path, $1+1 57 | my $path=join('/', @ogdl_path) 58 | $ogdl_path_index{$path}=$ogdl_path_index_base 59 | $deflist->[-1]->{path}=$path 60 | $deflist->[-1]->{path_index}=$ogdl_path_index_base 61 | $ogdl_path_index_base++ 62 | $elif $preproc=~/^ogdl_get:(\w+)=(.*)/ 63 | my $key=$1 64 | my $val; 65 | my @klist=split /,\s*/, $2 66 | $foreach $k in @klist 67 | $if defined $cur_ogdl->{$k} 68 | $val=$cur_ogdl->{$k} 69 | $else 70 | # Use it as default 71 | $val=$k 72 | $deflist->[-1]->{$key}=$val 73 | $elif $preproc=~/^ogdl_get:(\w+)/ 74 | $deflist->[-1]->{$1}=$cur_ogdl->{$1} 75 | 76 | subcode: ogdl_condition 77 | $if $cond=~/^ogdl_text/ 78 | return !ref($cur_ogdl) 79 | $elif $cond=~/^ogdl_list/ 80 | $if ref($cur_ogdl) eq "HASH" 81 | my $tlist=$cur_ogdl->{_list} 82 | $if @$tlist 83 | return 1 84 | return 0 85 | $elif $cond=~/^ogdl_text:(.*)/ 86 | $if ref($cur_ogdl) eq "SCALAR" 87 | return $cur_ogdl eq $1 88 | $else 89 | return ($cur_ogdl->{_name} eq $1) 90 | $elif $cond=~/^ogdl_attr:(\w+)(.*)/ 91 | $if ref($cur_ogdl) ne "HASH" 92 | $if $1 eq "_text" 93 | return test_op($cur_ogdl, $2) 94 | $else 95 | return 0 96 | $else 97 | my $t=$cur_ogdl->{$1} 98 | return test_op($t, $2) 99 | 100 | -------------------------------------------------------------------------------- /deflib/perl/statistics.def: -------------------------------------------------------------------------------- 1 | # get $mean, $dev, $min, $max, $min_i, $max_i 2 | 3 | # ----- example of using mean loops 4 | subcode: stat_loop(loop) 5 | $call mean_init 6 | &call $(loop) 7 | $call mean_step, $t 8 | $call mean_final 9 | # my $stat_str=sprintf "cnt: $cnt, min $min_i: %.2f, max $max_i: %.2f, mean: %.2f, dev: %.2f", $min, $max, $mean, $dev 10 | 11 | subcode: mean_init 12 | my ($sum1, $sum2, $min_i, $max_i, $min, $max) 13 | my $cnt=0 14 | 15 | subcode: mean_step(i) 16 | $sum1+=$(i) 17 | $sum2+=($(i))*($(i)) 18 | $if $cnt==0 19 | $min=$(i) 20 | $max=$(i) 21 | $min_i=0 22 | $max_i=0 23 | $else 24 | $if $min>$(i) 25 | $min=$(i) 26 | $min_i=$cnt 27 | $if $max<$(i) 28 | $max=$(i) 29 | $max_i=$cnt 30 | $cnt++ 31 | 32 | subcode: mean_final 33 | $if $cnt==0 34 | die "Error in calculating mean, 0 elements\n" 35 | $else 36 | $sum1/=$cnt 37 | $sum2/=$cnt 38 | $sum2-=$sum1*$sum1 39 | $if $sum2>0 40 | $sum2=sqrt($sum2) 41 | $else 42 | $sum2=0.0 43 | my ($mean, $dev)=($sum1, $sum2) 44 | 45 | # -- Correlation Coefficient ------------------------- 46 | subcode: ecc_init(array, start, end) 47 | my @ecc_target 48 | my $ecc_size=0 49 | my $sum1=0 50 | my $sum2=0 51 | $for $i=$(start):$(end) 52 | push @ecc_target, $$(array)[$i] 53 | $sum1+=$$(array)[$i] 54 | $sum2+=$$(array)[$i]*$$(array)[$i] 55 | $ecc_size++ 56 | $sum1/=$ecc_size 57 | $sum2/=$ecc_size 58 | $sum2-=$sum1*$sum1 59 | $if $sum2>0 60 | $sum2=sqrt($sum2) 61 | $else 62 | die "ECC error: Target is flat!\n" 63 | $for $i=0:$ecc_size 64 | $ecc_target[$i]=($ecc_target[$i]-$sum1)/$sum2 65 | 66 | subcode: ecc_calc(array, offset) 67 | my $sum_xy=0.0 68 | my $sum_y=0.0 69 | my $sum_y2=0.0 70 | $for $i=0:$ecc_size 71 | my $t=$$(array)[$i+$(offset)] 72 | $sum_xy+=$ecc_target[$i]*$t 73 | $sum_y+=$t 74 | $sum_y2+=$t*$t 75 | $sum_xy/=$ecc_size 76 | $sum_y/=$ecc_size 77 | $sum_y2/=$ecc_size 78 | my $avg=$sum_y 79 | my $ecc=$sum_xy/sqrt($sum_y2-$sum_y*$sum_y) 80 | 81 | # -- First Order Fit ------------------------- 82 | subcode: fit_init 83 | my $sum_xy=0 84 | my $sum_x2=0 85 | my $sum_x=0 86 | my $sum_y=0 87 | my $cnt=0 88 | 89 | subcode: fit_add(x, y) 90 | $sum_x+=$(x) 91 | $sum_y+=$(y) 92 | $sum_xy+=$(x)*$(y) 93 | $sum_x2+=$(x)*$(x) 94 | $cnt++ 95 | 96 | subcode: fit_final 97 | $sum_x/=$cnt 98 | $sum_y/=$cnt 99 | $sum_xy/=$cnt 100 | $sum_x2/=$cnt 101 | my $a1=($sum_xy-$sum_x*$sum_y)/($sum_x2-$sum_x*$sum_x) 102 | my $a0=$sum_y-$a1*$sum_x 103 | 104 | 105 | # -- Filter ------------------------------------------ 106 | # moving average 107 | subcode: average(array, size) 108 | my $n=@$(array) 109 | my $t=0 110 | $for $i=0:$(size) 111 | $t+=$$(array)[$i] 112 | $for $i=0:$n-$(size) 113 | my $a0=$$(array)[$i] 114 | $$(array)[$i]=$t/$(size) 115 | $t+=$$(array)[$i+$(size)]-$a0 116 | # -- center shift -- 117 | my $shift=int($(size)/2) 118 | $for $i=$n-$(size)+$shift-1:$shift-1:-1 119 | $$(array)[$i]=$$(array)[$i-$shift] 120 | $for $i=1:$shift 121 | $$(array)[$i]=$$(array)[0] 122 | $for $i=$n-$(size)+$shift:$n 123 | $$(array)[$i]=$$(array)[$i-1] 124 | 125 | 126 | -------------------------------------------------------------------------------- /macros_output/case.def: -------------------------------------------------------------------------------- 1 | subcode: parsecode_case_support(if, elif, style) 2 | $global $case_if="$(if)", $case_elif="$(elif)" 3 | 4 | $global @case_stack 5 | $global $case_state 6 | $call debug_case_l 7 | 8 | $if $l=~/^\x24(if|elif|elsif|elseif|case)\s+(.*)$/ 9 | my $cond=$2 10 | my $case=$case_if 11 | $call check_case_if 12 | $(if:parse_condition) 13 | $cond=parse_condition($cond) 14 | &call return_newblock, if 15 | $if $case eq $case_if 16 | $call if_$(style) 17 | $else 18 | $call elif_$(style) 19 | $call case_push, "if" 20 | $elif $l=~/^\$else/ 21 | $if !$case_state and $l!~/NoWarn/i 22 | $call warn, Dangling \$else 23 | &call return_newblock, else 24 | $call else_$(style) 25 | $call case_push, undef 26 | $elif $l!~/^SUBBLOCK/ 27 | # *************** 28 | undef $case_state 29 | $if $l eq "CASEPOP" 30 | $call case_pop 31 | return 0 32 | 33 | # -------------------------------- 34 | subcode: check_case_if 35 | $if $1 eq "if" 36 | $elif $1 eq "case" 37 | $if !$case_state 38 | $case=$case_if 39 | $else 40 | $case=$case_elif 41 | $else 42 | $case=$case_elif 43 | 44 | #---------------------------------------- 45 | subcode: case_push(state) 46 | push @src, "PARSE:CASEPOP" 47 | push @case_stack, {state=>$(state)} 48 | 49 | undef $case_state 50 | $call debug_case_push 51 | 52 | subcode: case_pop 53 | $call debug_case_pop 54 | my $t_case=pop @case_stack 55 | $if $t_case 56 | $case_state=$t_case->{state} 57 | 58 | #---- called from $list function --- 59 | subcode: case_reset 60 | $global @case_stack 61 | $global $case_state 62 | @case_stack=() 63 | undef $case_state 64 | $call debug_case_reset 65 | 66 | #----------------------------------------------- 67 | #----- c style ---------------------- 68 | #-- $call parsecode_case_support, if, else if, c_style 69 | subcode:0 if_c_style 70 | $call push_single_block, "if ($cond) {", "}" 71 | 72 | subcode:0 elif_c_style 73 | $call push_single_block, "else if ($cond) {", "}" 74 | 75 | subcode:0 else_c_style 76 | $call push_single_block, "else {", "}" 77 | 78 | #---- sh style ---------------- 79 | #-- $call parsecode_case_support, if, elif, sh_style 80 | subcode:0 if_sh_style 81 | $call push_single_block, "if $cond; then", "fi" 82 | 83 | subcode:0 elif_sh_style 84 | $call else_merge, fi 85 | $call push_single_block, "elif $cond; then", "fi" 86 | 87 | subcode:0 else_sh_style 88 | $call else_merge, fi 89 | $call push_single_block, "else", "fi" 90 | 91 | subcode:0 else_merge(fi) 92 | $if $out->[-1] ne "$(fi)" 93 | $call warn, "case: else missing $(fi) - [$out->[-1]]" 94 | pop @$out 95 | 96 | # ------------------------------------------- 97 | subcode: debug_case_push 98 | $if $debug eq "case" 99 | my $level=@case_stack 100 | print "Entering case [$level]: $l\n" 101 | subcode: debug_case_pop 102 | $if $debug eq "case" 103 | my $level=@case_stack 104 | print " Exit case [$level]\n" 105 | subcode: debug_case_l 106 | $if $debug eq "case" 107 | my $level=@case_stack 108 | print " $level:[$case_state]$l\n" 109 | 110 | subcode: debug_case_reset 111 | $if $debug eq "case" 112 | $print " CASE RESET\n" 113 | -------------------------------------------------------------------------------- /macros_output/scope.def: -------------------------------------------------------------------------------- 1 | #---------------------------------------- 2 | subcode: parsecode_scope 3 | $case $l=~/^SUBBLOCK BEGIN (\d+) (.*)/ 4 | # my ($blk_idx, $scope_name)=($1, $2) 5 | open_scope($1, $2) 6 | return 7 | $case $l=~/^SUBBLOCK END (\d+) (.*)/ 8 | # my ($blk_idx, $scope)=($1, $2) 9 | close_scope() 10 | return 11 | 12 | subcode:: _autoload 13 | $global @scope_stack, $cur_scope 14 | $cur_scope={var_list=>[], var_hash=>{}, name=>"default"} 15 | 16 | fncode: open_scope($blk_idx, $scope_name) 17 | push @scope_stack, $cur_scope 18 | $cur_scope={var_list=>[], var_hash=>{}, name=>$scope_name} 19 | 20 | fncode: close_scope($blk, $pre, $post) 21 | $if !$blk 22 | $blk=$cur_scope 23 | 24 | $(if:hascode:my_add_var) 25 | &call protect_return 26 | $call @process_scope_variables 27 | 28 | $cur_scope=pop @scope_stack 29 | 30 | # ---------------------------------- 31 | macros: 32 | _get_post: MyDef::compileutil::get_named_block("_post") 33 | _get_pre: MyDef::compileutil::get_named_block("_pre") 34 | 35 | subcode: protect_return 36 | my $return_line 37 | $(if:scope_return_pattern) 38 | $if $out->[-1]=~/$(scope_return_pattern)/ 39 | $return_line = pop @$out 40 | BLOCK 41 | $if $return_line 42 | $if !$post 43 | $post= $(_get_post) 44 | push @$post, $return_line 45 | 46 | # -- if there is no func_add_var etc., the following is noop 47 | # need fncode: var_declare, ref: variable.def 48 | subcode: process_scope_variables 49 | my ($var_hash, $var_list) 50 | $var_hash=$blk->{var_hash}; 51 | $var_list=$blk->{var_list}; 52 | 53 | $if @$var_list 54 | my @exit_calls 55 | $if !$pre 56 | $pre=$(_get_pre) 57 | $foreach $v in @$var_list 58 | my $var=$var_hash->{$v} 59 | my $decl=var_declare($var, 1) 60 | push @$pre, $decl 61 | 62 | $if $global_hash->{$v} 63 | $call warn, In $blk->{name}: local variable $v has existing global: $decl 64 | 65 | $if $var->{exit} 66 | push @exit_calls, "$var->{exit}, $v" 67 | $if @$var_list 68 | push @$pre, "\n" 69 | 70 | $if @exit_calls 71 | $if !$post 72 | $post=$(_get_post) 73 | my $out_save=$out 74 | MyDef::compileutil::set_output($post) 75 | $foreach $call_line in @exit_calls 76 | MyDef::compileutil::call_sub($call_line) 77 | MyDef::compileutil::set_output($out_save) 78 | 79 | fncode: find_var($name) 80 | $call debug_scopes 81 | $if $cur_scope->{var_hash}->{$name} 82 | return $cur_scope->{var_hash}->{$name} 83 | 84 | $for $i=$#scope_stack:0:-1 85 | $if $scope_stack[$i]->{var_hash}->{$name} 86 | return $scope_stack[$i]->{var_hash}->{$name} 87 | return undef 88 | 89 | subcode: debug_scopes 90 | $if $debug eq "scope" 91 | $call debug_scope, $cur_scope, cur_scope 92 | $for $i=$#scope_stack:0:-1 93 | $call debug_scope, $scope_stack[$i], scope $i 94 | 95 | subcode: debug_scope(scope, name) 96 | print " $(name)\[$(scope)->{name}]: " 97 | $foreach $v in @{$(scope)->{var_list}} 98 | print "$v, " 99 | print "\n" 100 | 101 | -------------------------------------------------------------------------------- /manual/intro.def: -------------------------------------------------------------------------------- 1 | subcode:: sections 2 | $call section, intro, Introduction 3 | $call subsection, intro_mydef, Introduction to $(code:MyDef) 4 | $p 5 | $(code:MyDef) is a general purpose preprocessor, in the sense that it processes input and generates output, rearranging blocks of text based on a small but powerful set of preprocessing directives as well as expanding macros that are marked with special syntax. $(code:MyDef) adds a meta-layer on top of any programming languages, which allows factoring code and customize syntax at a higher abstract level. 6 | $p 7 | A typical programming language consists of semantics layer and syntax layer. The former defines entities such as data types, variables and functions and their mechanism; the latter defines the text form that can describe these entities. $(code:MyDef) works purely on the syntax layer and provides extra control on how the code could be write and read. 8 | $p 9 | At its base level, $(code:MyDef) is used for code factoring and code rearrangement. The former cases include examples such as boiler-plate code and repetitive code. The latter include examples such as organizing code in a top-down form or group semantic related definitions, types, variables and code together. With $(code:MyDef), it is possible to put all feature related code in a single file, e.g. $(code:feature_A.def), and selectively including or excluding features become including or commenting out the inclusion of $(code:feature_A.def) in the main file. This is in contrast with the common practice of scattering feature related code across source code with $(code:#ifdef). 10 | 11 | $call subsection, intro_bugs, Problems and Bugs 12 | $p 13 | If you encounter problems with $(code:MyDef), please feel encouraged to raise an issue at $(url:https://github.com/hzhou/MyDef/issues). You are also welcome to send e-mail to mydef at hzsolutions.net. However, there is no guarantee that your issues or questions will be addressed in any time frame. 14 | $p 15 | Because $(code:MyDef) works only on syntax layer, almost all its error will result in syntax error and typical language compilers are very good at catching or reporting syntax errors. Syntax errors are generally easy to fix. The base features of $(code:MyDef) is fairly robust. However, the development of $(code:MyDef) is constantly adding and experimenting extra features. In addition, due to the flexibility of $(code:MyDef), users can develop custom plug-ins that introduces features that are fragile in nature. If you encounter errors from using certain features, in addition to learn more about the feature, there is always the option of bypassing the feature altogether. $(code:MyDef)'s syntax are designed to be distinct from most language syntax. You can always write your code in vanilla form and $(code:MyDef) will pass to the output directly. 16 | 17 | $call subsection, intro_usage, Using this manual 18 | $p 19 | This manual contains a number of examples of $(code:MyDef) input and output, and a simple notation is used to distinguish input, output and error messages from $(code:MyDef). Examples are set out from the normal text, and shown in a fixed width font, like this 20 | &call codeprint, mydef, test.def 21 | page: test 22 | module: perl 23 | $print Hello World! 24 | $p 25 | To illustrate command line examples, a shell prompt &lsquot;$ &rsquot; will be shown along with the command line input, while the program output will be shown without the prompt, like this: 26 | &call codeprint, sh 27 | $ mydef_run test.def 28 | PAGE: t 29 | --> [./t.pl] 30 | perl ./t.pl 31 | Hello World! 32 | 33 | -------------------------------------------------------------------------------- /mydef.def: -------------------------------------------------------------------------------- 1 | include: version.def 2 | include: modules.def 3 | 4 | page: MyDef 5 | type: pm 6 | output_dir: lib 7 | package: MyDef 8 | 9 | $global $def, $page, $var={} 10 | $use MyDef::utils 11 | $use MyDef::parseutil 12 | $use MyDef::compileutil 13 | $use MyDef::dumpout 14 | 15 | # ---------------------------------- 16 | import_config("config"); 17 | MyDef::parseutil::add_path($var->{include_path}) 18 | MyDef::parseutil::add_path($ENV{MYDEFLIB}) 19 | 20 | fncode: get_version 21 | return "$(version)" 22 | #---------------------------------------- 23 | #- embed "MyDef::debug()" and rund perl -d and break at MyDef::debug 24 | fncode: debug 25 | my @info = caller; 26 | $print "MyDef::debug @info" 27 | 28 | #---------------------------------------- 29 | fncode: init(%config) 30 | $while my ($k, $v) = each %config 31 | $var->{$k}=$v; 32 | my $module=$var->{module}; 33 | 34 | $if !$module and -f $config{def_file} 35 | &call open_r, $config{def_file} 36 | $if /^\s*module:\s+(\w+)\s*$/ 37 | $var->{module}=$1 38 | $module=$1 39 | 40 | check_module($module) 41 | 42 | fncode: import_data($file) 43 | $def= MyDef::parseutil::import_data($file) 44 | 45 | fncode: createpage($pagename) 46 | $page=$def->{pages}->{$pagename}; 47 | $if $page->{module} 48 | check_module($page->{module}) 49 | 50 | my $plines=MyDef::compileutil::compile() 51 | MyDef::compileutil::output($plines) 52 | 53 | fncode: pipe_page($module) 54 | #-- reads from STDIN 55 | #-- dump to STDOUT 56 | $var->{module}=$module 57 | check_module($module) 58 | $def = MyDef::parseutil::import_data("-pipe") 59 | my $pagename = $def->{pagelist}->[0] 60 | $if $pagename 61 | $page=$def->{pages}->{$pagename} 62 | my $plines=MyDef::compileutil::compile() 63 | $foreach $l in @$plines 64 | print $l 65 | 66 | #---- 67 | fncode: check_module($use_module) 68 | $global $module 69 | $if $use_module 70 | $if $use_module eq $module 71 | # nothing to do 72 | return 73 | $else 74 | $module = $use_module 75 | 76 | $if !$module 77 | die "Module type not defined in config!\n" 78 | 79 | $map require_module, $(module_list) 80 | $else 81 | die "Undefined module type $module\n"; 82 | # -------------------------- 83 | subcode: require_module(name) 84 | $elif $module eq "$(name)" 85 | require MyDef::output_$(name); 86 | MyDef::compileutil::set_interface(MyDef::output_$(name)::get_interface()); 87 | 88 | #---------------------------------------- 89 | fncode: addpath($path) 90 | $var->{path}=$path; 91 | 92 | fncode: is_sub($subname) 93 | $if $page->{codes}->{$subname} 94 | return 1; 95 | $elsif $def->{codes}->{$subname} 96 | return 1; 97 | $else 98 | return 0; 99 | 100 | fncode: set_page_extension($default_ext, $force) 101 | $if !defined $page->{_pageext} or $force 102 | my $ext=$default_ext 103 | $if exists $var->{filetype} 104 | $ext=$var->{filetype} 105 | 106 | $if exists $page->{type} 107 | $ext=$page->{type}; 108 | $elif $page->{_pagename}=~/(.+)\.(.+)/ 109 | $page->{_pagename}=$1 110 | $ext=$2 111 | 112 | $if $ext eq "none" 113 | $ext="" 114 | 115 | $page->{_pageext}=$ext 116 | 117 | # -------------------------- 118 | fncode: import_config($file) 119 | # print STDERR "Reading Config File: $file\n"; 120 | open In, $file or return; 121 | $while 122 | $if /^(\w+):\s*(.*\S)/ 123 | $var->{$1}=$2; 124 | close In; 125 | 126 | -------------------------------------------------------------------------------- /docs/mydef_run.md: -------------------------------------------------------------------------------- 1 | # Quick Workflow with mydef_run 2 | 3 | When I explain to people how MyDef works -- edit `.def` source, run `mydef_page` to produce the actual source code in your targeted language, run compiler of your targeted language, and finally run the executable -- it sounds so complicated. However in reality of typical experience, often it is simply edit code and press F5 (to run). It doesn't matter how many layers are involved in the work flow, as long as your editor is capable of rudimentary customization, all it mean to you is setup once, and a single key press to remember. 4 | 5 | In fact, this is nothing new. Almost any compiler, from GCC to Perl interpreter, they all go through multiple layers before they produce actual code that runs. Of course in these scenerios, those layers are hidden from you. Out of sight, out of mind. The philosophy of MyDef is to hide nothing, so it always trys to show you what is really going on and allow you the ability to peak and tweak at each layer. It only seems complicated to the novice; but nevertheless, novice needs help or get deterred. 6 | 7 | So here I show you one of my typical setup for quick code. It is by no mean to be the only workflow, but since it works for me, it may as well work for you. 8 | 9 | 1. Use vim. 10 | 11 | I use vim, and I know how to use vim. If you use another editor and assume you know how to use it, simply use this document as reference. 12 | 13 | 2. Add a shortcut key. 14 | 15 | In my case, that is to add following line in ~/.vimrc: 16 | 17 | :nmap :!mydef_run % 18 | 19 | `mydef_run` is a simple script that *guesses* your intended workflow and runs them for you. In my case, if it is C, it runs mydef_page, gcc, and finally runs the executable. Did I mention it is a simple script and it *guesses* your intention? There is nothing magic there; if it doesn't fit your workflow, simply edit mydef_run.def in your MyDef source tree and customize to your way -- make it more sophiscated if you would like. 20 | 21 | 3. You are all set! 22 | 23 | ## Quick Demo in C 24 | 25 | Let's say you want to dump a list from reddit homepage. 26 | 27 | 1. `wget -O t.html www.reddit.com` 28 | 29 | 2. `vim t.def` (t is my favorate name for anything quick or temorary) 30 | 31 | include: c/files.def 32 | include: c/regex.def 33 | 34 | page: test, basic_frame 35 | module: c 36 | 37 | s_file="t.html" 38 | 39 | $call stat_file, s_file 40 | n=$(fsize) 41 | $local_allocate(n+1, 0) s 42 | 43 | &call open_r, s_file 44 | fread(s, 1, n, file_in) 45 | 46 | $while s=~/class="title [^"]*" href="(http[^"]*)"/g 47 | $regex_capture ts_url 48 | $print link: $ts_url 49 | 50 | 3. `:w` and hit `F5` 51 | 52 | PAGE: test 53 | --> [./test.c] 54 | gcc -otest ./test.c -lpcre && ./test 55 | link: http://i.imgur.com/JmlEcvO.jpg 56 | link: http://edition.cnn.com/2016/05/24/middleeast/isis-offensive-raqq a/index.html 57 | ... 58 | 59 | Of course your experience may not as smooth as this. You may not have syntax highting or auto indentation -- why not set them up? Or your code may not compile either at MyDef compilation or gcc compilation or it conatains run-time bugs. That means to re-edit and re-press `F5`, rinse and repeat. I can't help you there, but there you are doing *real* work, aren't you? 60 | 61 | ## Demo in Perl 62 | Well C may not suit well for quick code. Try PERL for example, it may be easier: 63 | 64 | page: test 65 | system "wget -O t.html www.reddit.com" 66 | &call open_r, t.html 67 | $while /class="title [^"]*" href="(http[^"]*)"/g 68 | $print link: $1 69 | 70 | ... and press `F5` -- simple. Perl is MyDef's default module, so you don't even need specify the module type. 71 | -------------------------------------------------------------------------------- /macros_output/for.def: -------------------------------------------------------------------------------- 1 | subcode: parsecode_for_support(style) 2 | $if $param=~/(.*);(.*);(.*)/ 3 | &call return_newblock, for 4 | $(set:type=asis) 5 | $call for_$(style) 6 | # ----------------------------- 7 | my $var 8 | $if $param=~/^(.+?)\s*=\s*(.*)/ 9 | $var=$1 10 | $param=$2 11 | # ------------ 12 | my ($i0, $i1, $step) 13 | $if $param=~/^(.+?)\s+to\s+(.+)/ 14 | my $to 15 | ($i0, $to, $step) = ($1, $2, 1) 16 | $if $to=~/(.+?)\s+step\s+(.+)/ 17 | ($to, $step)=($1, $2) 18 | $i1=" <= $to" 19 | $elif $param=~/^(.+?)\s+downto\s+(.+)/ 20 | my $to 21 | ($i0, $to, $step) = ($1, $2, 1) 22 | $if $to=~/(.+?)\s+step\s+(.+)/ 23 | ($to, $step)=($1, $2) 24 | $i1=" >= $to" 25 | $if $step!~/^-/ 26 | $step="-$step" 27 | $else 28 | my @tlist=split /:/, $param 29 | $call parsecode_for_convention 30 | # ------------ 31 | $if defined $i0 32 | $call @for_i0_i1_step 33 | &call return_newblock, for 34 | $(set:type=i0_i1_step) 35 | $call for_$(style) 36 | 37 | subcode:@ for_i0_i1_step 38 | $call warn, "Supply subcode: for_i0_i1_step!" 39 | 40 | subcode: for_i0_i1_step_default(loop_var) 41 | $if $step eq "1" 42 | $step="++" 43 | $elif $step eq "-1" 44 | $step="--" 45 | $else 46 | $step=" += $step" 47 | 48 | $(if:loop_var!=-) 49 | $call $(loop_var) 50 | $(else) 51 | $if !$var 52 | $var = "i" 53 | 54 | $param="$var = $i0; $var$i1; $var$step" 55 | 56 | subcode: for_c_style 57 | $call push_single_block, "for ($param) {", "}" 58 | 59 | #---------------------------------------- 60 | #- counting up: [i0, i1) 61 | #- counting down: [i2, i1] !!! 62 | #- except (i2: 0] 63 | subcode: parsecode_for_convention 64 | $if @tlist==1 65 | $i0="0" 66 | $i1="<$param" 67 | $step="1" 68 | $elif @tlist==2 69 | # $for i0:i1 70 | $if $tlist[1] eq "0" 71 | # CAUTION 72 | # $i=n:0 be the reverse of $i=0:n 73 | $i0="$tlist[0]-1" 74 | $i1=">=$tlist[1]" 75 | $step="-1" 76 | $elif $tlist[1]=~/^[-0-9]+$/ && $tlist[0]=~/^[-0-9]+$/ && $tlist[0]>$tlist[1] 77 | $i0=$tlist[0] 78 | $i1=">=$tlist[1]" 79 | $step="-1" 80 | $else 81 | $i0=$tlist[0] 82 | $i1="<$tlist[1]" 83 | $step="1" 84 | $elif @tlist==3 85 | $i0=$tlist[0] 86 | $step=$tlist[2] 87 | $if $step=~/^-/ 88 | # Counting down is not zero based 89 | $i1=">=$tlist[1]" 90 | $else 91 | # we're used to zero based counting up 92 | $i1="<$tlist[1]" 93 | 94 | #---------------------------------------- 95 | subcode: parsecode_while_support(style) 96 | my ($init, $cond, $next) 97 | 98 | my @clause = split /\s*;\s*/, $param 99 | my $n = @clause 100 | $if $n>1 && !$clause[-1] 101 | $n-- 102 | 103 | $if $n>3 104 | $call warn, "error: [\$while $param]\n" 105 | $elif $n==3 106 | ($init, $cond, $next) = @clause 107 | $elif $n==2 108 | ($cond, $next) = @clause 109 | $elif $n==1 110 | $cond = $param 111 | $else 112 | $cond = 1 113 | 114 | &call return_newblock, while 115 | $call while_$(style) 116 | 117 | #---------------------------------------- 118 | subcode: while_c_style 119 | $if $init 120 | push @src, "$init;" 121 | push @src, "while($cond){" 122 | push @src, "INDENT" 123 | push @src, "BLOCK" 124 | $if $next 125 | push @src, "$next;" 126 | push @src, "DEDENT" 127 | push @src, "}" 128 | 129 | -------------------------------------------------------------------------------- /mydef_ext.def: -------------------------------------------------------------------------------- 1 | #- Provide MyDef::ext module to be used in perlcode 2 | #- Example: 3 | #- perlcode: codeprint 4 | #- require MyDef::ext 5 | #- my $codelist = MyDef::ext::grab_codelist() 6 | #- ... 7 | 8 | include: macros_ext/grab_file.def 9 | 10 | page: ext 11 | output_dir: lib/MyDef 12 | package: MyDef::ext 13 | type: pm 14 | 15 | fncode: grab_codelist(%opt) 16 | my $codelist = $MyDef::compileutil::named_blocks{"last_grab"} 17 | my $do_macro = $opt{do_macro} 18 | my $with_indent = $opt{with_indent} 19 | $if $codelist 20 | $call filter_SOURCE 21 | return $codelist 22 | 23 | subcode: filter_SOURCE 24 | #-- remove SOURCE line --- 25 | my (@t, $indent) 26 | $foreach $t in @$codelist 27 | $if $do_macro 28 | MyDef::compileutil::expand_macro(\$t) 29 | 30 | $if $t=~/^SOURCE:/ 31 | # skip 32 | $elif $t=~/^NEWLINE/ 33 | push @t, "\n" 34 | $else 35 | $if $with_indent 36 | push @t, $t 37 | $else 38 | $call filter_indent 39 | 40 | $while $t[-1]=~/^\s*$/ 41 | pop @t 42 | $codelist = \@t 43 | 44 | subcode: filter_indent 45 | $if $t=~/^SOURCE_INDENT/ 46 | $indent++ 47 | $elif $t=~/^SOURCE_DEDENT/ 48 | $indent-- 49 | $elif $indent>0 50 | push @t, " "x$indent . $t 51 | $else 52 | push @t, $t 53 | 54 | fncode: inject_sub($name, $src) 55 | my $param 56 | $if $name=~/(\w+)\s*(\(.*\))/ 57 | ($name, $param)=($1, $2) 58 | my $t_code=MyDef::parseutil::new_code("sub", $name, 9, $param) 59 | $t_code->{source}=$src 60 | $MyDef::def->{codes}->{$name}=$t_code 61 | 62 | fncode: run_src($src) 63 | my $t_code=MyDef::parseutil::new_code("sub", "_", 9) 64 | $t_code->{source}=$src 65 | $MyDef::def->{codes}->{"_"}=$t_code 66 | MyDef::compileutil::call_sub("_") 67 | 68 | #------------------------------------------ 69 | # item1: value 70 | # item2: value 71 | # item3: 72 | # value 73 | # Nested hash, only the top level can be a list 74 | fncode: grab_ogdl($is_list) 75 | my $codelist = grab_codelist("do_macro"=>1, "with_indent"=>1) 76 | $if $codelist 77 | my $ogdl 78 | $if $is_list 79 | $ogdl = [] 80 | $else 81 | $ogdl = {} 82 | $call parse_ogdl 83 | return $ogdl 84 | $else 85 | return undef 86 | 87 | subcode: parse_ogdl 88 | my @stack 89 | my $cur=$ogdl 90 | my $last_key 91 | $foreach $t in @$codelist 92 | $if $t=~/^SOURCE_INDENT/ 93 | $call _push 94 | $elif $t=~/^SOURCE_DEDENT/ 95 | $call _pop 96 | $elif $t=~/^\s*$/ 97 | next 98 | $elif !@stack and $is_list 99 | push @$cur, $t 100 | $elif $t=~/^(\w+):\s*(.*)/ 101 | $cur->{$1} = $2 102 | $last_key = $1 103 | $else 104 | warn "grab_ogdl: error in [$t]\n" 105 | return undef 106 | 107 | subcode: _push 108 | $if $last_key 109 | my $t = {"_"=>$cur->{$last_key}} 110 | $cur->{$last_key} = $t 111 | push @stack, $cur 112 | $cur = $t 113 | $else 114 | my $tmp = pop @$cur 115 | my $t = {"_"=>$tmp} 116 | push @$cur, $t 117 | push @stack, $cur 118 | $cur = $t 119 | undef $last_key 120 | 121 | subcode: _pop 122 | $if @stack 123 | $cur = pop @stack 124 | $else 125 | die "grab_ogdl: assert\n" 126 | -------------------------------------------------------------------------------- /dumpout.def: -------------------------------------------------------------------------------- 1 | include: macros_util/debug.def 2 | # include: macros_util/makestring.def 3 | 4 | page: dumpout 5 | type: pm 6 | output_dir: lib/MyDef 7 | package: MyDef::dumpout 8 | 9 | $sub dumpout 10 | my $dump=shift; 11 | my $f=$dump->{f}; 12 | my $out=$dump->{out}; 13 | my $custom=$dump->{custom}; 14 | $if !$out 15 | die "missing \$out\n"; 16 | $call dumpout 17 | # --------------- 18 | 19 | 1; 20 | 21 | #---------------------------------------- 22 | #---- dumpout: @$out --> @$f ------ 23 | subcode: dumpout 24 | my @source_stack; 25 | 26 | my $indentation=0 27 | my @indentation_stack 28 | 29 | DUMP_STUB dumpout_init 30 | $while 1 31 | $if !@$out 32 | $out=pop @source_stack; 33 | $if !$out 34 | last; 35 | $else 36 | next; 37 | 38 | my $l=shift @$out; 39 | $if $l=~/^\s*\\x[0-9a-f]+\b/ 40 | $l=~s/\\x([0-9a-f]+)\b/chr(hex($1))/ie # use leading \x23 to passthru # comments 41 | # $call @debug_dumpout, 50 42 | $case $l =~/^INCLUDE_FILE (\S+)/ 43 | # used to insert long docs with the functions 44 | &call open_r, $1 45 | push @$f, $_ 46 | next 47 | $elif $l =~/^INCLUDE_BLOCK (\S+)/ 48 | push @source_stack, $out 49 | $out=$dump->{$1} 50 | $elif $l =~ /^DUMP_STUB\s+([\w\-]+)/ 51 | my $source=$MyDef::compileutil::named_blocks{$1} 52 | $if $source 53 | push @source_stack, $out 54 | $out=$source 55 | $elif $l =~ /^INSERT_STUB\[(.*)\]\s+([\w\-]+)/ -> $sep, $name 56 | my $source=$MyDef::compileutil::named_blocks{$name} 57 | $if $source 58 | my $i=$#$f 59 | $while $i>=0 && $f->[$i]!~/\{STUB\}/ 60 | $i-- 61 | $if $i>=0 62 | my $t = join ($sep, @$source) 63 | $f->[$i]=~s/\{STUB\}/$t/g 64 | $elif $l=~/^(INDENT|DEDENT|PUSHDENT|POPDENT)\b(.*)/ 65 | $if $1 eq "INDENT" 66 | $indentation++; 67 | $elif $1 eq "DEDENT" 68 | $indentation-- if $indentation; 69 | $elif $1 eq "PUSHDENT" 70 | push @indentation_stack, $indentation 71 | $indentation=0 72 | $elif $1 eq "POPDENT" 73 | $indentation=pop @indentation_stack 74 | 75 | $l=$2; 76 | $if $l=~/^\s*;?$/ 77 | next; 78 | $else 79 | unshift @$out, $l; 80 | next; 81 | $elif $l=~/^SOURCE_INDENT/ 82 | $indentation++; 83 | $elif $l=~/^SOURCE_DEDENT/ 84 | $indentation-- if $indentation; 85 | $elif $l=~/^BLOCK_(\d+)/ 86 | push @source_stack, $out; 87 | $out=MyDef::compileutil::fetch_output($1); 88 | #$elif $l=~/^SCOPE:/ 89 | $elif $l=~/^SUBBLOCK (BEGIN|END)/ 90 | # messages from compileutil.pm 91 | $elif $l=~/^NOOP/ 92 | # messages from compileutil.pm 93 | $call @dumpout_make_string 94 | $else NoWarn 95 | $call print_line 96 | 97 | subcode: print_line 98 | $if $l=~/^\s*(NEWLINE\b.*)?$/ 99 | $if $1 eq "NEWLINE?" 100 | # prevent multiple empty lines 101 | $if $f->[-1] ne "\n" 102 | push @$f, "\n" 103 | $elif $1 104 | push @$f, "\n" 105 | $else 106 | # likely from template 107 | push @$f, $l 108 | $elif $l=~/^<-\|(.*)/ # e.g. C preprocessing 109 | push @$f, "$1\n" 110 | $else 111 | chomp $l 112 | push @$f, " "x$indentation."$l\n" 113 | 114 | subcode: debug_dumpout(N) 115 | $if $#$f <$(N) 116 | $print dumpout $out: [$l] 117 | 118 | -------------------------------------------------------------------------------- /mydef_page.def: -------------------------------------------------------------------------------- 1 | include: version.def 2 | 3 | page: mydef_page 4 | output_dir: script 5 | type: 6 | 7 | #Usage: perl createpages.pl def_file 8 | use MyDef; 9 | my $def_file 10 | my %config; 11 | my $default_module=$MyDef::var->{module} 12 | $call parse_arg 13 | 14 | $if $def_file eq "-pipe" 15 | #-- reads from STDIN 16 | #-- dump to STDOUT 17 | MyDef::pipe_page($config{module}) 18 | $else 19 | $config{def_file}=$def_file 20 | 21 | MyDef::init(%config); 22 | my $module=$MyDef::var->{module} 23 | 24 | $if $config{"debug-import"} 25 | $MyDef::parseutil::debug={import=>1} 26 | MyDef::import_data($def_file) 27 | $call @load_arg_macros 28 | 29 | $if $config{find} 30 | $call find_subcode 31 | $elif $config{dump} 32 | $call dump_source 33 | $elif $config{"debug-import"} 34 | # done 35 | $else 36 | $call compile_pages 37 | 38 | # ---------------------------------------- 39 | subcode: parse_arg 40 | $foreach $a in @ARGV 41 | $if $a =~ /^-m(\w+)/ 42 | $config{module} = $1 43 | $elif $a =~/^-o(\S+)/ 44 | $config{output_dir} = $1 45 | $elif $a =~/^-f(\S+)/ 46 | $config{find} = $1 47 | $elif $a =~/^-(dump|debug.*)/ 48 | $config{$1} = 1 49 | $elif $a=~/\.def$/ 50 | $if $def_file 51 | die "Multiple def source files not supported\n" 52 | $if -f $a 53 | $def_file=$a 54 | $else 55 | die "$a is not a regular file\n" 56 | $elif $a eq "-pipe" 57 | $def_file="-pipe" 58 | $call @check_arg_version, $a 59 | 60 | $if !$def_file 61 | die "Please supply data definition file."; 62 | 63 | subcode: load_arg_macros 64 | $foreach $a in @ARGV 65 | $if $a=~/-M(\w+)=(.*)/ 66 | $MyDef::def->{macros}->{$1} =$2 67 | 68 | # ---------------------------------------- 69 | subcode: compile_pages 70 | my $pages=$MyDef::def->{pages} 71 | my $pagelist=$MyDef::def->{pagelist} 72 | my ($n_skip, $n_create) 73 | 74 | $foreach $t in @$pagelist 75 | my $p=$pages->{$t} 76 | $if $p->{subpage} 77 | next 78 | 79 | my $t_module=$default_module 80 | $if $p->{module} 81 | $t_module=$p->{module} 82 | $if $t_module and ($t_module ne $module) 83 | # $print "skip page $t: module mismatch [page:$t_module][config:$module]" 84 | $n_skip++ 85 | next 86 | 87 | $n_create++ 88 | MyDef::createpage($t); 89 | $if $n_create==0 90 | $print skiped $n_skip pages (due to module mismatch), use -m to overide default module. 91 | 92 | # ---------------------------------------- 93 | subcode: find_subcode 94 | my $def=$MyDef::def 95 | my $name=$config{find} 96 | $if $def->{codes}->{$name} 97 | my $code=$def->{codes}->{$name} 98 | $call dump_code 99 | $elif $def->{macros}->{$name} 100 | $print macro: $name: $def->{macros}->{$name} 101 | $else 102 | $print name: $name not found. 103 | 104 | subcode: dump_code 105 | my $type=$code->{type} 106 | my $param=join ", ", @{$code->{params}} 107 | my $source=$code->{source} 108 | my $indent=1 109 | print $type, "code: $name($param)\n" 110 | $foreach $l in @$source 111 | $if $l=~/^SOURCE_INDENT/ 112 | $indent++ 113 | $elif $l=~/^SOURCE_DEDENT/ 114 | $indent-- 115 | $else 116 | print " "x$indent, $l, "\n" 117 | 118 | # ------------------------------------ 119 | subcode: dump_source 120 | my $def=$MyDef::def 121 | $foreach %{$def->{pages}} 122 | $print page: $k 123 | $if $v->{codes} 124 | $while my ($k2, $v2) = each %{$v->{codes}} 125 | $print " $v2->{type}code: $k2\n" 126 | 127 | $foreach %{$def->{codes}} 128 | $print $v->{type}code: $k 129 | 130 | -------------------------------------------------------------------------------- /deflib/perl/parse.def: -------------------------------------------------------------------------------- 1 | # deprecated, currently used in output_plot, parse_tex 2 | #---------------------------------------- 3 | #- used inside a parse function 4 | #- e.g. fncode: parse_expr($l, ...) 5 | 6 | #- calls: init, match, process, post 7 | 8 | #- $(set:strict=1）if strict mode is desired 9 | 10 | subcode: parse_frame 11 | macros: 12 | type: $stack[$1]->[1] 13 | atom: $stack[$1]->[0] 14 | cur_atom: $cur->[0] 15 | cur_type: $cur->[1] 16 | 17 | my @stack 18 | $call @init 19 | $while 1 20 | my $cur 21 | $if $l=~/\G$/gc 22 | $cur = [undef, "eof"] 23 | $call @match 24 | $else NoWarn 25 | $(if:strict) 26 | my $i=pos($l) 27 | my $a=substr($l, 0, $i) 28 | my $b=substr($l, $i) 29 | die "parse error: [$a][$b]\n" 30 | $(else) 31 | $l=~/\G(.)/gc 32 | $cur = [$1, "extra"] 33 | 34 | process: 35 | # print_token($cur) 36 | $call @process 37 | 38 | $if $(cur_type) eq "eof" 39 | $call @process_eof 40 | last 41 | $else 42 | $call @prepush 43 | push @stack, $cur 44 | $call @post 45 | $call return_stack 46 | 47 | # ----- 48 | subcode: return_stack 49 | $if @stack!=1 50 | my $n=@stack 51 | $print "---- dump stack [$n] ----\n" 52 | $foreach $t in @stack 53 | print_token($t) 54 | die "Unreduced expresion [$l].\n" 55 | return $stack[0] 56 | 57 | # ---- routines for match ---------------- 58 | subcode: if_lex(@pat) 59 | $case $l=~/\G$(pat)/gc 60 | BLOCK 61 | 62 | subcode: skip(@pat) 63 | $case $l=~/\G$(pat)/gc 64 | next 65 | 66 | subcode: symbol(@pat) 67 | $case $l=~/\G($(pat))/gc 68 | $cur = [$1, $1] 69 | 70 | subcode: token(type, @pat) 71 | $case $l=~/\G($(pat))/gc 72 | $cur = [$1, "$(type)"] 73 | 74 | # -------------- 75 | subcode: double_quote 76 | $case $l=~/\G("(?:[^\\]+|\\.)*")/gc 77 | $cur = [$1, '"'] 78 | 79 | subcode: single_quote 80 | $case $l=~/\G('(?:[^\\]+|\\.)*')/gc 81 | $cur = [$1, "'"] 82 | 83 | subcode: bracket 84 | $case $l=~/\G([\(\[\{])/gc 85 | #-- %prec '('=>-1, 't('=>100, ... 86 | $cur = [$1, "t$1"] 87 | $elif $l=~/\G([\)\]\}])/gc 88 | $cur = [$1, $1] 89 | 90 | subcode: brace 91 | $case $l=~/\G(\{)/gc 92 | #-- %prec '('=>-1, 't('=>100, ... 93 | $cur = [$1, "t$1"] 94 | $elif $l=~/\G(\})/gc 95 | $cur = [$1, $1] 96 | 97 | # ---- routines for grab ---------------- 98 | subcode: grab_brace 99 | $(set:o={) 100 | $(set:c=}) 101 | $call grab_group 102 | 103 | subcode: grab_bracket 104 | $(set:o=[) 105 | $(set:c=]) 106 | $call grab_group 107 | 108 | subcode: grab_group 109 | $(if:type=brace) 110 | my $t 111 | &call if_lex, \s*\$(o) 112 | my $level=1 113 | $while 1 114 | &call if_lex, (\\.|[^\\]+) 115 | $t.=$1 116 | &call if_lex, \$(o) 117 | $level++ 118 | $t.='$(o)' 119 | &call if_lex, \$(c) 120 | $level-- 121 | $if $level>0 122 | $t.='$(c)' 123 | $else 124 | break 125 | 126 | # ---- routines for process ----------- 127 | # -- check_precedence, reduce_stack 128 | 129 | # ---- debug ---------------------------- 130 | subcode: debug_stack 131 | $print "debug_stack:\n" 132 | $foreach $t in @$stack 133 | print_token($t) 134 | 135 | #---------------------------------------- 136 | fncode: print_token($t, $pre, $post) 137 | $if defined $pre 138 | print $pre 139 | $if ref($t->[0]) eq "ARRAY" 140 | print " ( " 141 | $foreach $t2 in @{$t->[0]} 142 | print_token($t2, "", ", ") 143 | print " $t->[1] )" 144 | $elif ref($t->[0]) eq "HASH" 145 | print " ( " 146 | $foreach %{$t->[0]} 147 | print "$k=>" 148 | print_token($v, "", "") 149 | print ", " 150 | print ", $t->[1] )" 151 | $else 152 | print " ( $t->[0], $t->[1] )" 153 | $if defined $post 154 | print $post 155 | $else 156 | print "\n" 157 | 158 | -------------------------------------------------------------------------------- /macros_parse/debug.def: -------------------------------------------------------------------------------- 1 | # DEBUG import --> print import_files 2 | # DEBUG def --> dumps macros,pagelist,... 3 | # DEBUG code: name --> dumps named subcode 4 | subcode:: post_parsing 5 | $if $debug 6 | $foreach $k in keys %$debug 7 | $if $k eq "def" 8 | debug_def($def) 9 | exit 10 | $elif $k=~/^code:\s*(\w+)::(\w+)/ 11 | my $codes = $def->{pages}->{$1}->{codes} 12 | debug_code($codes->{$2}) 13 | exit 14 | $elif $k=~/^code:\s*(\w+)/ 15 | debug_code($def->{codes}->{$1}) 16 | exit 17 | 18 | # ---------------------- 19 | fncode: parse_DEBUG($t) 20 | $global $debug 21 | $if !$debug 22 | $debug={} 23 | $if $t=~/^(\d+)/ 24 | $debug->{def}=1 25 | $debug->{n}=$1 26 | $elif $t 27 | $debug->{$t}=1 28 | $else 29 | $debug->{def}=1 30 | 31 | subcode: debug_import 32 | $if $debug->{import} 33 | $print import_file: $f 34 | 35 | fncode: debug_def($def) 36 | $call dump_macros, $def, 0 37 | $call dump_pagelist 38 | $call dump_pages 39 | $call dump_codes, $def, 0 40 | print_def_node($def, 0) 41 | 42 | subcode: dump_pagelist 43 | my $pagelist=$def->{pagelist} 44 | $if @$pagelist 45 | print "pagelist: ", join(', ', @$pagelist), "\n" 46 | undef $def->{pagelist} 47 | $print 48 | 49 | subcode: dump_pages 50 | $foreach %{$def->{pages}} 51 | $call dump_page, $k, $v 52 | undef $def->{pages} 53 | $print 54 | 55 | subcode: dump_macros(node, indent) 56 | my $macros = $(node)->{macros} 57 | $if $macros && %$macros 58 | print " " x $(indent) 59 | $print "macros:" 60 | debug_macros($macros, $(indent)+1) 61 | undef $def->{macros} 62 | $print 63 | 64 | subcode: dump_codes(node, indent) 65 | my $codes = $(node)->{codes} 66 | $if $codes && %$codes 67 | $foreach $k in sort keys %$codes 68 | my $v = $codes->{$k} 69 | debug_code($v, $(indent), 1) 70 | undef $(node)->{codes} 71 | $print 72 | 73 | subcode: dump_page(name, v) 74 | $print "page: $(name)" 75 | print " [" 76 | $(for:_pagename, _frame, module) 77 | $if $(v)->{$1} 78 | print "$1: $(v)->{$1}; " 79 | undef $(v)->{_pagename} 80 | $print ] 81 | $call dump_codes, $(v), 1 82 | $call dump_macros, $(v), 1 83 | 84 | #---------------------------------------- 85 | fncode: debug_code($code, $indent, $skip_source) 86 | print " " x $indent 87 | print "$code->{type}code $code->{name}: " 88 | my $params = $code->{params} 89 | $if $params && @$params 90 | print join(', ', @$params), " - " 91 | my $src = $code->{source} 92 | $if $skip_source 93 | my $n = @$src 94 | $print $n lines 95 | $else 96 | $print 97 | $foreach $l in @$src 98 | print " " x ($indent+1) 99 | print "$l\n" 100 | $if $code->{codes} 101 | $foreach $k in sort keys %{$code->{codes}} 102 | my $v = $code->{codes}->{$k} 103 | debug_code($v, $indent+1, $skip_source) 104 | $if $code->{macros} 105 | debug_macros($code->{macros}, $indent+1) 106 | 107 | #---------------------------------------- 108 | fncode: debug_macros($macros, $indent) 109 | $if %$macros 110 | $foreach $k in sort keys %$macros 111 | my $v = $macros->{$k} 112 | print " " x $indent 113 | $print $k: $v 114 | 115 | #----------------------------------------------- 116 | fncode: print_def_node($node, $indent, $continue) 117 | $if ref($node) eq "HASH" 118 | $if $continue 119 | print "\n" 120 | $foreach $k in sort keys %$node 121 | my $v = $node->{$k} 122 | $if $v 123 | print " "x$indent 124 | print "$k: " 125 | print_def_node($v, $indent+1, 1) 126 | $elif ref($node) eq "ARRAY" 127 | my $n = @$node 128 | my $m = $debug->{n} 129 | $if !$m 130 | $m = 3 131 | $elif $m>$n 132 | $m = $n 133 | $if $continue 134 | print "$n elements\n" 135 | $for $i=0:$m 136 | $if $i<$n 137 | print_def_node($node->[$i], $indent+1) 138 | $if $n>$m 139 | print_def_node("...", $indent+1) 140 | $else 141 | $if !$continue 142 | print " "x$indent 143 | print $node, "\n" 144 | 145 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | An old tutorial is available at http://huizhou.gitbooks.io/programming-with-mydef/ 2 | 3 | A more thorough manual that will be kept within the repository is currently in progress. You can view it [here](http://htmlpreview.github.io/?https://github.com/hzhou/MyDef/blob/master/manual/mydef.html). 4 | 5 | MyDef is not a new programming language. It is an additional layer on top of your programming language -- a layer that can do almost anything without affecting the demands of the underlying language. The layer can be very thin, in which case you still write your code exactly the same way you used to. And you should if you never had complaints in your programming career. But if you do, MyDef allows you to do something about it. 6 | 7 | * I have always complained about semicolons. Now with MyDef, I don't type them anymore. 8 | * I have complained about curly braces. Now with MyDef, I avoided them, along with the grammatical parentheses. 9 | * I have wished to refactor my code without worry about variable scopes. MyDef allows me to refactor with no side effects. 10 | * I have wished a less uglier way to write JavaScript, with MyDef, I like the new look. 11 | * etc. 12 | 13 | And they are not on/off switches. You may start refactoring part of your code, and simply paste the rest of your legacy code. Unlike other programming language which will tell you what to do -- often strictly, you just do what you want to do in MyDef. You do need know what you want to do though. 14 | 15 | I cannot show you the freedom unless you feel the restriction. Before you ask what good does MyDef buy you, recall what bad you have complained. MyDef offers solutions -- without changing your language and still allowing collaboration with your fellow coworkers even when they are stuck in their primal language. 16 | 17 | MyDef is not just syntax, it is about paradigm. If you have a vision on how you think to program, MyDef can realize them. Contrary to what others may preach, you don't need classes to do object oriented programming, you don't need first-class functions to do functional programming. You program in objects when you are thinking in objects, and you program functionally when you are thinking in pure functions. Do you want a language restrict you on how to think? MyDef liberates you. 18 | 19 | INSTALL 20 | ======= 21 | 22 | 0. Dependency: 23 | 24 | perl -- base language 25 | make, sh, git -- convenience requirement, only tested with GNU make, bash 26 | vim -- optional, but you need an editor that supports indentation, syntax, and short-cut keys 27 | 28 | 1. MyDef currently is in perl. First setup a custom installation environment: 29 | 30 | PATH=$PATH:$HOME/bin 31 | PERL5LIB=$HOME/lib/perl5 32 | MYDEFLIB=$HOME/lib/MyDef 33 | export PATH PERL5LIB MYDEFLIB 34 | 35 | The purpose is to install into one's home directory rather than system folders. I assume you will know how to change it into any installation destination. 36 | 37 | 2. Now install it: 38 | 39 | sh bootstrap.sh all 40 | 41 | 3. If you haven't, read the documentation: http://huizhou.gitbooks.io/programming-with-mydef 42 | 43 | 4. Try it. e.g. 44 | 45 | $ vim t.def 46 | page: t 47 | module: perl 48 | 49 | $print Hello World! 50 | 51 | $ mydef_run t.def 52 | 53 | Explanation: 54 | 55 | `page` outputs a file in that name with the default extension -- in this case `t.pl`. 56 | `$print` is special since it is used so often. It is customized in MyDef to provide many convenience (and a uniform syntax across languages) 57 | In this case, it is translated into `print("Hello World!\n");` 58 | `mydef_run` is a convenience for short script. 59 | Formally, `mydef_page` compiles `.def` into `.pl` (or whatever language of the module), and the normal toolchain of the language follows. 60 | `mydef_page` is what should be used in a `Makefile`. 61 | 62 | Try more: 63 | 64 | Who writes Perl nowadays? (I do!) If Python is your language, try replace the module with `module: python` and run it. 65 | You may also try `c`, `cpp`, `java`, `fortran`, `sh`, `js`, `php`, `lua`, `go`, `rust`, `tcl`, `pascal`, etc. (assuming you have necessary language toolchain in place). 66 | MyDef is a meta-layer that can easily work with any programming languages. You may download specific `output` module or write your own to extend your favorite languages. 67 | 68 | 5. If you use vim, there is simple mydef syntax. 69 | 70 | $ vim ~/.vim/filetype.vim 71 | augroup filetypedetect 72 | au BufNewFile,BufRead *.def setf mydef 73 | augroup END 74 | $ ln -s /path/to/MyDef/docs/mydef.vim ~/.vim/syntax/ 75 | 76 | lastly, in .vimrc, I would consider minimally: 77 | 78 | :set shiftwidth=4 79 | :set expandtab 80 | :nmap :!mydef_run % 81 | 82 | 6. Set those environment variables in step 1 in your login shell's startup file. In addition, set: 83 | 84 | MYDEFSRC=[your MyDef path] 85 | export MYDEFSRC 86 | 87 | This is needed when you install or develop specific output modules. 88 | 89 | More Output Modules 90 | =================== 91 | 92 | This repository only contains the general and perl output modules. You can use the general output module for any text based code. However, there are specialized output modules for various programming languages. For example, if you are working with C/C++ code, you may want to try the output_c module: https://github.com/hzhou/output_c. 93 | -------------------------------------------------------------------------------- /deflib/std_perl.def: -------------------------------------------------------------------------------- 1 | subcode: block 2 | { 3 | BLOCK 4 | } 5 | 6 | # -- DATA ------------------------- 7 | subcode: update_max(max, a) 8 | $if $(max)<$(a) 9 | $(max)=$(a) 10 | 11 | subcode: update_min(min, a) 12 | $if $(min)>$(a) 13 | $(min)=$(a) 14 | 15 | subcode: update_minmax(min, max, a) 16 | $if !defined $(min) 17 | $(min) = $(a) 18 | $(max) = $(a) 19 | $else 20 | $call update_min, $(min), $(a) 21 | $call update_max, $(max), $(a) 22 | 23 | subcode: swap(a, b) 24 | ($(a), $(b)) = ($(b), $(a)) 25 | 26 | 27 | subcode: approx_zero(a) 28 | $if abs($(a))<1e-8 29 | $(a) = 0 30 | 31 | # ---- 32 | subcode: dump(@a) 33 | $(for:$(a)) 34 | print '$1 = ', "$1 " 35 | $print 36 | 37 | subcode: dump_hash(h) 38 | $foreach $k in sort keys(%$(h)) 39 | print " $k: ", $$(h){$k} 40 | 41 | # -- IO ------------------------- 42 | macros: 43 | In: In 44 | Out: Out 45 | 46 | subcode: open_r(name) 47 | $(if:name~") 48 | $(set:name=$(name:strip)) 49 | $(if:In~\$) 50 | $(set:_my_in=my $(In)) 51 | $(else) 52 | $(set:_my_in=$(In)) 53 | open $(_my_in), "$(name)" or die "Can't open $(name): $!\n" 54 | $while <$(In)> 55 | BLOCK 56 | close $(In) 57 | 58 | subcode: open_w(name) 59 | $(if:name~") 60 | $(set:name=$(name:strip)) 61 | $(if:name!~[>|]) 62 | $(set:_name=>$(name)) 63 | $(else) 64 | $(set:_name=$(name)) 65 | $(if:Out~\$) 66 | $(set:_my_out=my $(Out)) 67 | $(else) 68 | $(set:_my_out=$(Out)) 69 | open $(_my_out), "$(_name)" or die "Can't write $(name): $!\n" 70 | BLOCK 71 | close $(Out) 72 | 73 | subcode: open_W(name) 74 | &call open_w, $(name) 75 | $print " --> [$(name)]" 76 | $(set:print_to=$(Out)) 77 | BLOCK 78 | 79 | subcode: assert(cond) 80 | $if !($(cond)) 81 | die "$(cond) - FALSE!\n" 82 | 83 | subcode: get_file_in_t(name) 84 | $(if:name~") 85 | $(set:name=$(name:strip)) 86 | my $t 87 | &call block 88 | open In, "$(name)" or die "Can't open $(name).\n" 89 | local $/ 90 | $t= 91 | close In 92 | 93 | subcode: get_file_lines(name, @lines) 94 | $(if:name~") 95 | $(set:name=$(name:strip)) 96 | $(if:!lines) 97 | $(set:lines=@lines) 98 | my $(lines) 99 | &call block 100 | open In, "$(name)" or die "Can't open $(name).\n" 101 | $(lines)= 102 | close In 103 | 104 | #---------------------------------------- 105 | subcode: bench(n) 106 | use Time::HiRes 107 | my $time_start=Time::HiRes::clock() 108 | $for $i_bench=0:$(n) 109 | BLOCK 110 | my $time_finish=Time::HiRes::clock() 111 | printf "bench $(n) iterations: %f sec/iter\n", ($time_finish-$time_start)/$(n) 112 | 113 | #---------------------------------------- 114 | #-- similar to HERE document ----------- 115 | perlcode: print_block 116 | my $codelist=MyDef::compileutil::get_named_block("last_grab") 117 | $if $codelist 118 | $foreach $t in @$codelist 119 | $t=~s/"/\\\"/g 120 | push @$out, "print Out \"$t\\n\";" 121 | 122 | # -- dbl_list ---------------- 123 | subcode: dbl_list(name) 124 | $global @$(name), %$(name) 125 | @$(name)=() 126 | %$(name)=() 127 | 128 | subcode: dbl_push(name, v) 129 | $if !$$(name){$(v)} 130 | $$(name){$(v)}=1 131 | push @$(name), $(v) 132 | 133 | subcode: dbl_push_key(name, k, v) 134 | $if !$$(name){$(k)} 135 | $$(name){$(k)}=1 136 | push @$(name), $(v) 137 | 138 | subcode: dbl_push_list(name, list) 139 | $(list)=~s/\s*;\s*$// 140 | my @tlist=split /,\s*/, $(list) 141 | $foreach $v in @tlist 142 | $call dbl_push, $(name), $v 143 | 144 | #-- Strange but useful... ------ 145 | # $call match_count, $n, $s=~/'/g 146 | subcode: match_count(n, @re) 147 | $(n) = () = $(re) 148 | 149 | macros: 150 | # uses possessive quantifier 151 | RE_PAREN: (\((?:[^()]++|(?-1))*+\)) 152 | 153 | #-- Parser ------------------- 154 | # for simple parsing; for more complicated cases, ref perl/parse.def 155 | subcode: parse_loop(l) 156 | $while 1 157 | $if $(l)=~/\G$/sgc 158 | last 159 | BLOCK 160 | $(if:!skip_else) 161 | $else 162 | die "parse_loop: nothing matches! [$(l)]\n" 163 | 164 | subcode: if_lex(@pattern) 165 | $case $(l)=~/\G$(pattern)/sgc 166 | BLOCK 167 | 168 | macros: 169 | quote: "(?:[^"\\]|\\.)*" 170 | 171 | #---------------------------------------- 172 | # all print goes to $debug_console 173 | subcode: init_debug_console 174 | use Socket 175 | $global $debug_console 176 | socket($debug_console, PF_INET, SOCK_STREAM, 0) or die "socket $!" 177 | my $port = 1300 178 | connect($debug_console, pack_sockaddr_in($port, inet_aton("localhost"))) or die "connect: $!" 179 | $print_to $debug_console 180 | { 181 | my $ofh = select $debug_console 182 | $|=1 183 | select $ofh 184 | } 185 | 186 | # -- PATTERNS (less-used) --------------- 187 | subcode: topdown_loop(name, top) 188 | my %$(name)_hash 189 | my @$(name)_list 190 | $global @topdown_list 191 | @topdown_list = ($(top)) 192 | 193 | $while my $$(name)=pop @topdown_list 194 | $if !$$(name)_hash{$$(name)} 195 | $$(name)_hash{$$(name)}=1 196 | BLOCK 197 | 198 | -------------------------------------------------------------------------------- /macros_output/print.def: -------------------------------------------------------------------------------- 1 | subcode: get_print_to 2 | my $print_to = MyDef::compileutil::get_macro_word("print_to", 1) 3 | 4 | #---------------------------------------- 5 | fncode: fmt_string($str, $add_newline) 6 | $if !$str 7 | $if $add_newline 8 | return (0, '"\n"') 9 | $else 10 | return (0, '""') 11 | # print "fmt_string: [$str]\n" 12 | $str=~s/\s*$// 13 | my @pre_list 14 | my $need_escape 15 | $if $str=~/^\s*"((?:[^"\\]|\\.)*)"$/ 16 | # stripping double quote 17 | $str=$1 18 | $elif $str=~/^\s*\"((?:[^"\\]|\\.)*)\"\s*,\s*(.*)$/ 19 | # looks like a printf 20 | $str=$1 21 | @pre_list=MyDef::utils::proper_split($2) 22 | $(if:hascode:check_expression) 23 | $foreach $a in @pre_list 24 | $a=check_expression($a) 25 | $else 26 | $need_escape = 1 27 | 28 | $if $add_newline and $str=~/(.*)-$/ 29 | $add_newline=0 30 | $str=$1 31 | 32 | my %colors=(red=>31,green=>32,yellow=>33,blue=>34,magenta=>35,cyan=>36) 33 | 34 | my @fmt_list 35 | my @arg_list 36 | my $missing = 0 37 | $call parse_fmt_string 38 | 39 | $if @pre_list 40 | my $s = join(', ', @pre_list) 41 | $call warn, Extra fmt arg list: $s 42 | $elif $missing>0 43 | $call warn, Missing $missing fmt arguments 44 | 45 | $call add_newline 46 | 47 | $if !@arg_list 48 | return (0, '"'.join('',@fmt_list).'"') 49 | $else 50 | $(if:hascode:fmt_string_return) 51 | $call fmt_string_return 52 | $(else) 53 | my $vcnt=@arg_list 54 | my $f = join('', @fmt_list) 55 | my $a = join(', ', @arg_list) 56 | return ($vcnt, "\"$f\", $a") 57 | 58 | # ------------------------ 59 | subcode: add_newline 60 | $if $add_newline 61 | my $tail=$fmt_list[-1] 62 | $if $tail=~/(.*)-$/ 63 | $fmt_list[-1]=$1 64 | $elif $tail!~/\\n$/ 65 | push @fmt_list, "\\n" 66 | 67 | subcode: printf_var_find_var 68 | #- $print $var --------- 69 | $(if:printf_var) 70 | push @fmt_list, "$(printf_var)" 71 | push @arg_list, $v 72 | $(else) 73 | my $var=find_var($v) 74 | $if $var->{direct} 75 | push @fmt_list, $var->{direct} 76 | $elif $var->{strlen} 77 | push @fmt_list, "%.*s" 78 | push @arg_list, $var->{strlen} 79 | push @arg_list, $v 80 | $else 81 | my @t=get_var_fmt($v, 1) 82 | push @fmt_list, shift @t 83 | $if @t 84 | push @arg_list, @t 85 | $else 86 | push @arg_list, $v 87 | # ----------------------- 88 | subcode: parse_fmt_string 89 | my @group 90 | my $flag_hyphen=0 91 | &call parse_loop, $str 92 | &call if_lex, % 93 | # -- explicit % format -- 94 | &call if_lex, % 95 | push @fmt_list, '%%' 96 | &call if_lex, [-+ #]*[0-9]*(\.\d+)?[hlLzjt]*[$(printf_formats)] 97 | #---------------------------------------- 98 | $if !@pre_list 99 | $missing++ 100 | push @arg_list, shift @pre_list 101 | push @fmt_list, "%$&" 102 | $else 103 | push @fmt_list, '%%' 104 | &call if_lex, \$ 105 | # -- explicit $ variable -- 106 | &call if_lex, (red|green|yellow|blue|magenta|cyan) 107 | #---------------------------------------- 108 | #- $print $green --------- 109 | push @fmt_list, "\\x1b[$colors{$1}m" 110 | &call if_lex, \{ 111 | push @group, $1 112 | &call if_lex, reset 113 | push @fmt_list, "\\x1b[0m" 114 | &call if_lex, clear 115 | push @fmt_list, "\\x1b[H\\x1b[J" 116 | &call if_lex, (\w+) 117 | #---------------------------------------- 118 | my $v=$1 119 | &call if_lex, (\[.*?\]) 120 | $v.=$1 121 | &call if_lex, (\{.*?\}) 122 | $v.=$1 123 | $v=check_expression($v) 124 | $call printf_var_find_var 125 | &call if_lex, - 126 | # print $var-follow ---- 127 | &call if_lex, \{(.*?)\} 128 | my $v=$1 129 | $call printf_var_find_var 130 | $else 131 | push @fmt_list, '$' 132 | &call if_lex, \\\$ 133 | push @fmt_list, '$' 134 | &call if_lex, \} 135 | #---------------------------------------- 136 | #- $print $green{some text} 137 | $if @group 138 | pop @group 139 | $if !@group 140 | push @fmt_list, "\\x1b[0m" 141 | $else 142 | my $c=$group[-1] 143 | push @fmt_list, "\\x1b[$colors{$c}m" 144 | $else 145 | push @fmt_list, '}' 146 | &call if_lex, ([^%\$\}]+) 147 | my $t = $1 148 | $if $need_escape 149 | $t =~ s/"/\\"/g 150 | push @fmt_list, $t 151 | -------------------------------------------------------------------------------- /deflib/perl/permutation.def: -------------------------------------------------------------------------------- 1 | subcode: permutation(n) 2 | &call permute_frame, $(n), $(n) 3 | BLOCK 4 | $call permute_inc 5 | 6 | subcode: permute(n, k) 7 | &call permute_frame, $(n), $(k) 8 | BLOCK 9 | $call permute_inc 10 | 11 | subcode: choose(n, k) 12 | &call permute_frame, $(n), $(k) 13 | BLOCK 14 | $call choose_inc 15 | 16 | subcode: permute_frame(n, k) 17 | # it is called lexicographic permutations 18 | my @perm 19 | $for $i=0:$(n) 20 | $perm[$i]=$i 21 | $call @skip_k 22 | 23 | $while 1 24 | BLOCK 25 | # $call permute_inc 26 | 27 | # 0 1 2 3 -> 0 1 3 2 -> 0 2 1 3 -> 0 2 3 1 -> ... 28 | # ^ \ 0 2 3 1 / 29 | subcode: permute_inc 30 | &call find_tail_descending 31 | $call swap_least_bigger 32 | $call reverse_tail, $i+1 33 | $call @skip_k 34 | 35 | subcode: find_tail_descending 36 | my $i=$(n)-2 37 | $while $i>=0; $i-- 38 | $if $perm[$i] < $perm[$i+1] 39 | break 40 | $if $i<0 41 | # ALL DONE 42 | break 43 | $else 44 | BLOCK 45 | 46 | subcode: swap_least_bigger 47 | $for $j=$(n):0 48 | $if $perm[$j]>$perm[$i] 49 | $call swap, $perm[$j], $perm[$i] 50 | break 51 | 52 | subcode: skip_k 53 | $(if:k!=$(n)) 54 | $call reverse_tail, $(k) 55 | 56 | subcode: reverse_tail(lead) 57 | my $j=$(lead) 58 | my $k=$(n)-1 59 | $while $j<$k 60 | $call swap, $perm[$j], $perm[$k] 61 | $j++ 62 | $k-- 63 | 64 | # ------------------------- 65 | subcode: choose_inc 66 | choose_inc: 67 | &call find_tail_descending 68 | $if $perm[$i]==$(n)-$(k)+$i 69 | $call skip_ahead 70 | $call swap_least_bigger 71 | $call choose_order 72 | 73 | subcode: skip_ahead 74 | # C(10,4) 0 1 8 9 ... -> 0 1 9 8 ... 75 | $while $perm[$i]==$(n)-$(k)+$i 76 | $i-- 77 | $if $i<0 78 | break 79 | $for $j=$i+1:$(k) 80 | $perm[$j]=$(n)-($j-$i) 81 | 82 | subcode: choose_order 83 | # after [i], is in strict descending order 84 | # first k digits in ascending order 85 | # after [k], in descending order 86 | # it results in minimal ascending [i]-[k-1] 87 | $i++ 88 | $while $i<$(k) and $perm[$i]>$perm[$i-1] 89 | # $print choose_order $i: @perm 90 | $for $j=$(n):0 91 | $if $perm[$j]>$perm[$i-1] 92 | my $t = $perm[$j] 93 | $for my $_j=$j;$_j>$i;$_j-- 94 | $perm[$_j]=$perm[$_j-1] 95 | $perm[$i]=$t 96 | $i++ 97 | last 98 | 99 | #---------------------------------------- 100 | #- n-digit count up 101 | #- 1st digit at i=0, each digit limit by k 102 | subcode: enum_count(n, k) 103 | my @perm 104 | $for $i=0:$(n) 105 | $perm[$i]=0 106 | 107 | $while 1 108 | BLOCK 109 | $call count_inc 110 | 111 | subcode: count_inc 112 | my $i=0 113 | $while $i<$(n) 114 | $perm[$i]++ 115 | $if $perm[$i]>=$(k) 116 | $perm[$i]=0 117 | $i++ 118 | $else 119 | last 120 | $if $i>=$(n) 121 | last 122 | 123 | #---------------------------------------- 124 | #- n-digit count up, non-descending digits k0<=[]<=k1 125 | subcode: ordered_count(n, k0, k1) 126 | my @perm 127 | $for $i=0:$(n) 128 | $perm[$i] = $(k0) 129 | $perm[$(n)]=$(k1) # sentinel 130 | $while 1 131 | BLOCK 132 | $call count_inc 133 | 134 | subcode: count_inc 135 | my $flag=0 136 | $for $i=0:$(n) 137 | $if $perm[$i]<$perm[$i+1] 138 | $perm[$i]++ 139 | $for $j=0:$i 140 | $perm[$j]=$(k0) 141 | $flag = 1 142 | # $call @check_limit 143 | last 144 | $if !$flag 145 | last 146 | 147 | #---- return a list ---- 148 | fncode: get_perm_list 149 | my $n=@_ 150 | &call ret_tlist, $n 151 | &call permute, $n, $n 152 | $call add_perm 153 | 154 | fncode: get_enum_list 155 | my $n = shift @_ 156 | my $k = @_ 157 | &call ret_tlist, $n 158 | &call enum_count, $n, $k 159 | $call add_perm 160 | 161 | subcode: ret_tlist(n) 162 | my @tlist 163 | BLOCK 164 | return \@tlist 165 | 166 | subcode: add_perm 167 | my @t 168 | $for $i=0:$(n) 169 | push @t, $_[$perm[$i]] 170 | push @tlist, \@t 171 | 172 | #---- 168 primes under 1000 ------------- 173 | macros: 174 | prime_list: 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181, 191, 193, 197, 199, 211, 223, 227, 229, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281, 283, 293, 307, 311, 313, 317, 331, 337, 347, 349, 353, 359, 367, 373, 379, 383, 389, 397, 401, 409, 419, 421, 431, 433, 439, 443, 449, 457, 461, 463, 467, 479, 487, 491, 499, 503, 509, 521, 523, 541, 547, 557, 563, 569, 571, 577, 587, 593, 599, 601, 607, 613, 617, 619, 631, 641, 643, 647, 653, 659, 661, 673, 677, 683, 691, 701, 709, 719, 727, 733, 739, 743, 751, 757, 761, 769, 773, 787, 797, 809, 811, 821, 823, 827, 829, 839, 853, 857, 859, 863, 877, 881, 883, 887, 907, 911, 919, 929, 937, 941, 947, 953, 967, 971, 977, 983, 991, 997 175 | 176 | -------------------------------------------------------------------------------- /compileutil.def: -------------------------------------------------------------------------------- 1 | include: macros_util/debug.def 2 | include: macros_compile/preproc.def 3 | include: macros_compile/callsub.def 4 | include: macros_compile/parse.def 5 | include: macros_compile/macro.def 6 | include: macros_compile/ogdl.def 7 | include: macros_compile/list.def 8 | include: macros_compile/util.def 9 | 10 | page: compileutil 11 | type: pm 12 | output_dir: lib/MyDef 13 | package: MyDef::compileutil 14 | 15 | 1; 16 | 17 | fncode: output($plines) 18 | my $page=$MyDef::page 19 | my $pagename=$page->{_pagename} 20 | my $pageext=$page->{_pageext} 21 | my $outdir=$page->{_outdir} 22 | 23 | my $outname=$outdir."/".$pagename; 24 | $if $pageext 25 | $outname.=".$pageext"; 26 | $if !${MyDef::var}->{silent} 27 | print " --> [$outname]\n"; 28 | my $n=@$plines 29 | $if $n==0 30 | $print "Strange, no output!" 31 | $else 32 | &call open_w, $outname 33 | $foreach $l in @$plines 34 | print Out $l; 35 | $page->{outname}=$outname 36 | 37 | fncode: compile 38 | my $page=$MyDef::page 39 | my $pagename=$page->{_pagename} 40 | $call output_outdir 41 | $call do_compile 42 | $call @end_compile_report 43 | # ----------------- 44 | subcode: output_outdir 45 | my $outdir="."; 46 | $if $MyDef::var->{output_dir} 47 | $outdir=$MyDef::var->{output_dir}; 48 | $if $page->{output_dir} 49 | $if $page->{output_dir}=~/^[\/\.]/ 50 | $outdir=$page->{output_dir}; 51 | $else 52 | $outdir=$outdir."/".$page->{output_dir}; 53 | $outdir=~s/^\s+//; 54 | # create output dir 55 | $if ! -d "$outdir/" 56 | my @tdir_list=split /\//, $outdir; 57 | my $tdir; 58 | my $slash=0; 59 | $foreach my $t in @tdir_list 60 | $if !$slash 61 | $tdir=$t; 62 | $slash=1; 63 | $else 64 | $tdir=$tdir.'/'.$t; 65 | if(!$tdir){next;} 66 | $if ! -d $tdir 67 | mkdir $tdir or die "Can't create output directory: $tdir\n"; 68 | #--------------------- 69 | $page->{_outdir}=$outdir 70 | 71 | # ----------------- 72 | subcode: do_compile 73 | $deflist=[$MyDef::def, $MyDef::def->{macros}, $page]; 74 | # for debug purpose 75 | $deflist->[0]->{_name_}="def_root" 76 | $deflist->[1]->{_name_}="macros" 77 | $deflist->[2]->{_name_}="page $page->{_pagename}" 78 | 79 | $call @merge_page_macros 80 | 81 | my $mode=$f_init->($page); 82 | $if $mode 83 | modepush($mode) 84 | init_output(); 85 | $if !${MyDef::var}->{silent} 86 | print "PAGE: $pagename\n"; 87 | 88 | #---- save var 89 | my %varsave; 90 | $while my ($k, $v)=each %$page 91 | $varsave{$k}=$MyDef::var->{$k}; 92 | $MyDef::var->{$k}=$v; 93 | 94 | #---- autoload 95 | $global $in_autoload 96 | $in_autoload=1 97 | 98 | # note: potentially a_autoload, b_autoload ... 99 | my $codelist=$MyDef::def->{codes}; 100 | $foreach $codename in sort keys %$codelist 101 | $if $codename=~/_autoload$/ 102 | call_sub($codename) 103 | $in_autoload=0 104 | 105 | #---- main 106 | # ref: callsub.def - fncode call_sub 107 | $main_called = 0 108 | 109 | $if !$page->{_frame} and $codelist->{basic_frame} 110 | $page->{_frame} = "basic_frame" 111 | 112 | $if $page->{_frame} and $page->{_frame} ne "-" 113 | call_sub($page->{_frame}) 114 | 115 | # if frame didn't call main -- 116 | $if !$main_called 117 | call_sub("main") 118 | 119 | $f_parse->("NOOP POST_MAIN") 120 | 121 | #---- restore var 122 | $while my ($k, $v)=each %varsave 123 | $MyDef::var->{$k}=$v; 124 | 125 | #---- Dump 126 | $if !$page->{subpage} 127 | my @buffer; 128 | $f_dumpout->(\@buffer, fetch_output(0)) 129 | return \@buffer 130 | 131 | subcode: merge_page_macros 132 | $if $page->{macros} 133 | $foreach %{$page->{macros}} 134 | $if !defined $page->{$k} 135 | $page->{$k} = $v 136 | 137 | ################################################# 138 | subcode: _autoload 139 | $global $deflist, %misc_vars 140 | $global $debug=0 141 | 142 | fncode: set_output($output) 143 | my $old=$out 144 | $out=$output 145 | $f_setout->($out) 146 | return $old 147 | 148 | macros: 149 | # ref output.def 150 | interface: $f_init, $f_parse, $f_setout, $f_modeswitch, $f_dumpout 151 | 152 | subcode: _autoload 153 | $global $(interface) 154 | 155 | fncode: set_interface 156 | ($(interface))=@_; 157 | 158 | fncode: set_interface_partial 159 | my $t 160 | ($f_init, $f_parse, $f_setout, $t, $f_dumpout)=@_; 161 | 162 | #----------------------------------------------- 163 | #- push/pop _interface is also used by output_www.def 164 | subcode: _autoload 165 | $global @interface_stack 166 | 167 | fncode: push_interface($module) 168 | push @interface_stack, [$(interface)] 169 | 170 | $(for:$(module_list)) 171 | $case $module eq "$1" 172 | $(set:M=MyDef::output_$1) 173 | require $(M) 174 | set_interface_partial($(M)::get_interface()) 175 | $else 176 | $call warn, " push_interface: module $module not found\n" 177 | return undef 178 | 179 | $f_setout->($out) 180 | 181 | fncode: pop_interface 182 | $if @interface_stack 183 | my $interface = pop @interface_stack 184 | set_interface_partial(@$interface) 185 | $else 186 | $call warn, " pop_interface: stack empty\n" 187 | 188 | -------------------------------------------------------------------------------- /mydef_install.def: -------------------------------------------------------------------------------- 1 | include: version.def 2 | 3 | page: mydef_install 4 | type: 5 | output_dir: script 6 | 7 | $call parse_args 8 | $if $b_debug 9 | $print mydef_install: ARGV = @ARGV 10 | # mydef_install deflib . def --> *.def -> ${MYDEFLIB} 11 | # mydef_install MyDef/lib . pm --> *.pm -> ${PERL5LIB} 12 | # mydef_install MyDef/script . - --> * -> ${PATH} 13 | # mydef_install - out/{a,b,c} --> * -> ${PATH} 14 | 15 | $call check_install_dir 16 | $if $dst ne "." 17 | $install_dir.="/$dst" 18 | $if $b_debug 19 | $print install_dir: $install_dir 20 | 21 | $if @$src_list 22 | install_all($src_list, $install_dir, $ext) 23 | 24 | subcode: parse_args 25 | $call @check_arg_version, $ARGV[0] 26 | $global $b_force, $b_debug 27 | $if $ARGV[0] eq "-f" 28 | $b_force = 1 29 | shift @ARGV 30 | $if $ARGV[0] eq "-debug" 31 | $b_debug = 1 32 | shift @ARGV 33 | 34 | my ($dst, $ext) 35 | my $src_list 36 | $if $ARGV[0] eq "-" 37 | $call install_arglist_to_PATH 38 | $else 39 | my $src 40 | ($src, $dst, $ext)=($ARGV[0], $ARGV[1], $ARGV[2]) 41 | $call install_src_dst_type 42 | 43 | subcode: install_arglist_to_PATH 44 | ($dst, $ext) = (".", "-") 45 | shift @ARGV 46 | $src_list=[] 47 | $foreach $a in @ARGV 48 | $if -f $a 49 | push @$src_list, $a 50 | $elif -d $a 51 | my $tlist = load_srcs_dir($a,"-") 52 | push @$src_list, @$tlist 53 | $else 54 | warn "[$a] not found\n" 55 | $if $a=~/\{.*\}/ 56 | warn " note: {*} expansion may not work in your shell, try bash.\n" 57 | 58 | subcode: install_src_dst_type 59 | $if !$ext 60 | $ext = "def" 61 | $if -d $src 62 | $src_list = load_srcs_dir($src, $ext) 63 | $else 64 | die "Not a directory [$src]\n" 65 | 66 | #---------------------------------------- 67 | fncode: load_srcs_dir($dir, $ext) 68 | $if $dir ne "." 69 | chdir $dir or die "Can't chdir $dir\n"; 70 | 71 | my @files=glob("*"); 72 | 73 | my @srcs; 74 | my @dirs; 75 | $foreach $f in @files 76 | $if -d $f 77 | push @dirs, $f; 78 | $elif $ext eq "-" 79 | push @srcs, $f; 80 | $elif $f=~/\.$ext$/ 81 | push @srcs, $f; 82 | $call load_dirs 83 | return \@srcs 84 | 85 | # ---- load a single level of dirs ---- 86 | subcode: load_dirs 87 | $foreach $d in @dirs 88 | $if -f "$d/skip" 89 | next 90 | my $pat = "$d/*.$ext" 91 | $if $ext eq "-" 92 | $pat = "$d/*" 93 | my @files=glob($pat); 94 | $if @files 95 | $foreach $f in @files 96 | push @srcs, $f; 97 | 98 | #---------------------------------------------- 99 | fncode: install_all($src_list, $install_dir, $ext) 100 | $call check_exist, $install_dir 101 | my @cmds 102 | $if $ext eq "-" 103 | &call load_cmds, install -m555 104 | my $t=$src 105 | $t=~s/^.*\/// 106 | my $dst = "$install_dir/$t" 107 | $else 108 | &call load_cmds, install -m644 109 | $if $src=~/(.*)\// 110 | $call check_exist, $install_dir/$1 111 | my $dst="$install_dir/$src" 112 | 113 | $if @cmds 114 | $print install_all: $install_dir [$ext] 115 | $foreach $cmd in @cmds 116 | $print " :| $cmd" 117 | system $cmd 118 | 119 | subcode: load_cmds(install) 120 | $foreach $src in @$src_list 121 | BLOCK 122 | $if !-e $dst or $b_force or (-M $src < -M $dst) 123 | push @cmds, "$(install) $src $dst" 124 | 125 | subcode: check_exist(d) 126 | $if !-d "$(d)" 127 | mkdir "$(d)" or die "Can't mkdir $(d)" 128 | 129 | #----------------------------------------------- 130 | subcode: check_install_dir 131 | my $home = $ENV{HOME} 132 | $call @get_home2 133 | my $install_dir 134 | $if $dst=~/^(\/.*)/ 135 | $install_dir=$1 136 | $dst = "." 137 | $elif $ext eq "def" 138 | $install_dir=$ENV{MYDEFLIB} 139 | $install_dir=~s/:.*// 140 | $if !$install_dir 141 | $print "Missing environment variable MYDEFLIB\n" 142 | $print " try put 'MYDEFLIB=\$HOME/lib/MyDef' in your .bashrc (and source it)\n" 143 | exit 144 | $elif $ext eq "pm" 145 | $install_dir=$ENV{PERL5LIB} 146 | $install_dir=~s/:.*// 147 | $if !$install_dir 148 | $print "Missing environment variable PERL5LIB\n" 149 | $print " try put 'PERL5LIB=\$HOME/lib/perl5' in your .bashrc (and source it)\n" 150 | exit 151 | $elif $ext eq "-" 152 | $if $ENV{MYDEFBIN} 153 | $install_dir = $ENV{MYDEFBIN} 154 | $else 155 | my $homebin = "$home/bin" 156 | $if $ENV{PATH} =~ /$homebin/ 157 | $install_dir = $homebin 158 | $else 159 | $install_dir=$ENV{PATH} 160 | $install_dir=~s/:.*// 161 | $call check_mydefbin 162 | 163 | $if !-d $install_dir 164 | mkdir $install_dir or die "Can't mkdir $install_dir\n"; 165 | 166 | subcode: get_home2 167 | my $home2 168 | $if $ENV{MYDEFLIB}=~/(.*)\/lib\/MyDef/ 169 | $home2 = $1 170 | 171 | subcode: check_mydefbin 172 | $if $install_dir ne "$home/bin" and $install_dir ne "$home2/bin" 173 | $print "This will install script into your leading path: [$install_dir]" 174 | $print " press 'y' to continute (abort otherwise)" 175 | my $t = 176 | $if $t!~/^\s*y\s*$/ 177 | undef $install_dir 178 | $if !$install_dir 179 | $print "Can't figure out installation dir\n" 180 | $print " try set MYDEFBIN (and add it to your PATH)\n" 181 | exit 182 | -------------------------------------------------------------------------------- /macros_output/sumcode.def: -------------------------------------------------------------------------------- 1 | # $sumcode sum = A[i] 2 | subcode: parsecode_sum_support(style) 3 | $(set:mode=full) 4 | &call parsecode_sum_frame 5 | $call _get_idx, left 6 | $if $right 7 | $call _get_idx, right 8 | 9 | # callback from _get_idx 10 | subcode: get_var_hash_dim 11 | my $var=find_var($v) 12 | 13 | my $i=0 14 | $foreach $idx in @idxlist 15 | $i++ 16 | $call get_idx_dim 17 | $call set_idx_dim 18 | # ---------------- 19 | subcode: get_idx_dim 20 | #-- get idx dimension based on var 21 | my $dim 22 | $if $var->{"dim$i"} 23 | $dim=$var->{"dim$i"} 24 | $elif $var->{"dimension"} and $i==1 25 | $dim=$var->{"dimension"} 26 | $else 27 | $call warn, sumcode: var $v missing dimension $i 28 | # ---------------- 29 | subcode: set_idx_dim 30 | #-- set dim_hash ---- 31 | $if !$h->{"$idx-dim"} 32 | push @$(left)_idx, $idx 33 | $call set_idx, $dim 34 | $else 35 | $if $h->{"$idx-dim"} ne $dim 36 | my $old_dim=$h->{"$idx-dim"} 37 | $print "sumcode dimesnion mismatch: $old_dim != $dim" 38 | 39 | # $sumcode(100) sum = A[i] 40 | subcode: parsecode_sum_simple(style) 41 | $(set:mode=simple) 42 | &call parsecode_sum_frame 43 | $call parse_dimstr 44 | $call _get_idx, left 45 | $if $right 46 | $call _get_idx, right 47 | 48 | subcode: parse_dimstr 49 | my @idxlist=('i','j','k','l') 50 | my @dimlist=MyDef::utils::proper_split($dimstr) 51 | $foreach $dim in @dimlist 52 | my $idx=shift @idxlist 53 | $call set_idx, $dim 54 | 55 | $if $left=~/\b$idx\b/ 56 | push @left_idx, $idx 57 | $else 58 | push @right_idx, $idx 59 | 60 | #----------------------------------------------- 61 | subcode: parsecode_sum_frame 62 | $if $debug 63 | $print parsecode_sum: [$param] 64 | my $h={} 65 | my (%k_hash, @k_list) 66 | my %var_hash 67 | my (@left_idx, @right_idx) 68 | 69 | $(if:style=c) 70 | # may need declare sum var and k idx 71 | $h->{style}="c" 72 | $(set:my=\$my int) 73 | $(else) 74 | $h->{style}="perl" 75 | $(set:my=my) 76 | my ($left, $right) 77 | $call get_left_right 78 | BLOCK 79 | $call parsecode_sum_common 80 | my $codelist=sumcode_generate($h) 81 | MyDef::compileutil::parseblock({source=>$codelist, name=>"sumcode"}) 82 | return 83 | 84 | subcode: set_idx(dim) 85 | # $print set_idx $idx dim $(dim) 86 | $h->{"$idx-dim"}=$(dim) 87 | # sumcode_idx defined in, e.g. output_perl 88 | $h->{"$idx-var"}="$(sumcode_idx:$idx)" 89 | 90 | subcode: get_left_right 91 | $if $param=~/(.*?)\s*(?<=])=(?!=)\s*(.*)/ 92 | ($left, $right)=($1, $2) 93 | $else 94 | $left=$param 95 | 96 | subcode: _get_idx(left) 97 | my @segs=split /(\w+\[[ijkl,]*?\])/, $$(left) 98 | $foreach $s in @segs 99 | $if $s=~/^(\w+)\[([ijkl,]*?)\]$/ 100 | $if $var_hash{$s} 101 | $s=$var_hash{$s} 102 | $else 103 | my ($v, $idx_str)=($1, $2) 104 | my @idxlist=split /,/, $idx_str 105 | $(if:mode=full) 106 | $call get_var_hash_dim 107 | my $t 108 | $call translate_idx 109 | $var_hash{$s}=$t 110 | $s=$t 111 | $$(left)=join '', @segs 112 | $$(left)=~s/\b([ijkl])\b/$(sumcode_idx:$1)/g 113 | 114 | subcode: translate_idx 115 | $if @idxlist==1 116 | my $idx=$idx_str 117 | $t="$v\[$(sumcode_idx:$idx)\]" 118 | $else 119 | my $s 120 | $foreach $idx in @idxlist 121 | $if !$s 122 | $s="$(sumcode_idx:$idx)" 123 | $else 124 | my $dim=$h->{"$idx-dim"} 125 | $if $s=~/\+/ 126 | $s="($s)" 127 | $s= "$s*$dim+$(sumcode_idx:$idx)" 128 | $t="$v\[$s\]" 129 | 130 | subcode: parsecode_sum_common 131 | $(for:left in left, right) 132 | $h->{$(left)}=$$(left) 133 | $h->{$(left)_idx}=\@$(left)_idx 134 | #---------------------------------------- 135 | #- '$' is not an operator, so if it appears, let's assume it is 136 | #- part of variable name 137 | #---------------------------------------- 138 | #- ToDo: Factor a[i,j]=b[i,k]*c[k,l]*d[l,j] 139 | #- maybe: a[i,j]=b[i,k]*{c[k,l]*d[l,j]} 140 | #----------------------------------------------- 141 | #- Used to manual k index increment 142 | #- now simplified since c optimizing compiler appears to do good job 143 | #- ref: http://nadeausoftware.com/articles/2012/06/c_c_tip_how_loop_through_multi_dimensional_arrays_quickly 144 | fncode: sumcode_generate($h) 145 | $(for:left, right, left_idx, right_idx, klist) 146 | my $$1 = $h->{$1} 147 | # $call sumcode_process_k 148 | 149 | my @code 150 | my %loop_i_hash 151 | # $call sumcode_init_each_k 152 | $if $debug 153 | print "left indexs: ", join(", ", @$left_idx), "\n" 154 | print "right indexs: ", join(", ", @$right_idx), "\n" 155 | 156 | &call sumcode_loop, left 157 | $if @$right_idx 158 | push @code, "$left = 0" 159 | &call sumcode_loop, right 160 | push @code, "$left += $right" 161 | $elif defined $right 162 | push @code, "$left = $right" 163 | $else 164 | push @code, $left 165 | return \@code 166 | 167 | subcode: sumcode_loop(left) 168 | $(allow_recurse:2) 169 | $foreach $i in @$$(left)_idx 170 | $loop_i_hash{$i}=1 171 | my $dim=$h->{"$i-dim"} 172 | my $var=$h->{"$i-var"} 173 | push @code, "\$for $var=0:$dim" 174 | push @code, "SOURCE_INDENT" 175 | # $call sumcode_set_each_k 176 | BLOCK 177 | $foreach $i in reverse @$$(left)_idx 178 | # $call sumcode_inc_each_k 179 | push @code, "SOURCE_DEDENT" 180 | 181 | --------------------------------------------------------------------------------