/pliant/language/parser/extend.pli
 
 1  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 2  # 
 3  # This program is free software; you can redistribute it and/or 
 4  # modify it under the terms of the GNU General Public License version 2 
 5  # as published by the Free Software Foundation. 
 6  # 
 7  # This program is distributed in the hope that it will be useful, 
 8  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 9  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 10  # GNU General Public License for more details. 
 11  # 
 12  # You should have received a copy of the GNU General Public License 
 13  # version 2 along with this program; if not, write to the Free Software 
 14  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 15   
 16  scope "/pliant/language/" "/pliant/install/" 
 17  module "/pliant/install/ring2.pli" 
 18   
 19   
 20  function operator2 name priority nb_before nb_after module 
 21    arg Str name ; arg Int priority nb_before nb_after ; arg_rw Module module 
 22    var Link:ParserFilterOperatorT1 op :> new ParserFilterOperatorT1 
 23    op name := name 
 24    op unary := false 
 25    op ident := name 
 26    op priority := priority 
 27    op nb_before := nb_before 
 28    if nb_before<=1 
 29      op before_value := null 
 30    else 
 31      var Link:Ident id :> new Ident 
 32      id := cast "()" Ident 
 33      op before_value := addressof:id 
 34    op nb_after := nb_after 
 35    if nb_after<=1 
 36      op after_value := null 
 37    else 
 38      var Link:Ident id :> new Ident 
 39      id := cast "()" Ident 
 40      op after_value := addressof:id 
 41    var Link:ParserFilter :> new ParserFilter 
 42    function :> the_function parser_filter_t1 ParserContext Str Address 
 43    parameter := addressof op 
 44    var Str section 
 45    if name:len=1 
 46      section := "pliant parser 1 char operators" 
 47    eif name:len=2 
 48      section := "pliant parser 2 chars operators" 
 49    else 
 50      section := "pliant parser several chars operators" 
 51    module define section addressof:f 
 52   
 53  meta operator e 
 54    if e:size<>or not e:0:is_pure_ident or not (e:cast Int) or not (e:cast Int) or not (e:cast Int) 
 55      return 
 56    suckup e:1 ; suckup e:2 ; suckup e:3 
 57    var Link:Module :> module 
 58    if (addressof m:external)<>null 
 59      :> external 
 60    var Link:Argument :> argument mapped_constant Module m 
 61    add (instruction (the_function operator2 Str Int Int Int Module) (argument constant Str e:0:ident) e:1:result e:2:result e:3:result a) 
 62    set_void_result 
 63   
 64  export operator 
 65   
 66   
 67  method e rewrite_dual_keywords_sequence i 
 68    arg_rw Expression e ; arg Int i 
 69    var Link:Expression e1 :> i 
 70    var Link:Expression e2 :> i+1 
 71    var Int := e1 size 
 72    e1:arguments 'size :=' s+1+e2:size 
 73    e1:arguments := addressof e2 
 74    for (var Int j) e2:size-1 
 75      e1:arguments s+1+:= e2:arguments j 
 76    e2:arguments 'size :=' 0 
 77    for (var Int j) i+e:size-2 
 78      e:arguments := e:arguments j+1 
 79    e:arguments 'size :=' e:size-1 
 80   
 81  type DualKeyword 
 82    field Str first ; field Int first_mini first_maxi 
 83    field Str second ; field Int second_mini second_maxi 
 84    field Link:Module module 
 85   
 86  function parser_rewrite_dual_keywords e d 
 87    arg_rw Expression e ; arg DualKeyword d 
 88    if e:ident="{}" 
 89      var Int := 0 
 90      while i<e:size-1 
 91        if e:i:ident=d:first and e:i:size>=d:first_mini and e:i:size<=d:first_maxi and e:(i+1):ident=d:second and e:(i+1):size>=d:second_mini and e:(i+1):size<=d:second_maxi and (e:module is_included d:module) 
 92          rewrite_dual_keywords_sequence i 
 93        else 
 94          := i+1 
 95   
 96  gvar List duals 
 97          
 98  function parser_rewrite_dual_keywords e 
 99    arg_rw Expression e 
 100    if e:ident="{}" 
 101      var Pointer:Arrow :> duals first 
 102      while c<>null 
 103        parser_rewrite_dual_keywords e (map DualKeyword) 
 104        :> duals next c 
 105   
 106  pliant_general_dictionary insert2 "pliant precompile rewrite" false addressof:(the_function parser_rewrite_dual_keywords Expression) the_module:"/pliant/language/parser/basic.pli" 
 107   
 108  function dual_keyword2 first first_mini first_maxi second second_mini second_maxi module 
 109    arg Str first second ; arg Int first_mini first_maxi second_mini second_maxi ; arg_rw Module module 
 110    var Link:DualKeyword :> new DualKeyword 
 111    first := first 
 112    first_mini := first_mini 
 113    first_maxi := first_maxi 
 114    second := second 
 115    second_mini := second_mini 
 116    second_maxi := second_maxi 
 117    module :> module 
 118    duals append addressof:d 
 119    var Link:Ident id :> new Ident ; id := cast second Ident 
 120    pliant_general_dictionary insert2 "pliant continue" false addressof:id the_module:"/pliant/language/parser/basic.pli" 
 121     
 122  meta dual_keyword e 
 123    if e:size<>or not e:0:is_pure_ident or not (e:cast Int) or not (e:cast Int) or not e:3:is_pure_ident or not (e:cast Int) or not (e:cast Int) 
 124      return 
 125    suckup e:1 ; suckup e:2 ; suckup e:4 ; suckup e:5 
 126    var Link:Module :> module 
 127    if (addressof m:external)<>null 
 128      :> external 
 129    var Link:Argument :> argument mapped_constant Module m 
 130    add (instruction (the_function dual_keyword2 Str Int Int Str Int Int Module) (argument constant Str e:0:ident) e:1:result e:2:result (argument constant Str e:3:ident) e:4:result e:5:result a) 
 131    set_void_result 
 132   
 133   
 134  export dual_keyword