Ignore:
Timestamp:
Jul 27, 2006, 8:40:44 AM (14 years ago)
Author:
orlov
Message:
  • Proper generation of debug info for use with Debug library (-dbg option).
  • Result expressions can contain blocks.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • to-imperative/trunk/compiler/rfp_debug.rf

    r1625 r2034  
    1 //  creating of label for debug
    2 
    3 $use "rfpc";         //  rfpc.rfi 
    4 $use "rfp_lex";      // rfp_lex.rfi
    5 $use "rfp_parse";    // rfp_parse.rfi
    6 $use "rfp_compile";  // rfp_compile.rfi
    7 $use "rfp_format";   // rfp_format.rfi
    8 $use "rfp_src";
    9 
    10 
    11 $use Box ;
    12 $use Convert ;
    13 $use Table ;
    14 $use StdIO ;
    15 $use Arithm ;
    16 $use Access;
    17 
    18 $func Debug-Call e.pos = e.debug;
    19 //  $func Debug s.id e.names = e.Debug ;
    20 $func Push-Vars  = ;
    21 $func Pop-Vars = ;
    22 $func Add-Vars t.var = ;
    23 $func Get-Vars-Str  e.list = e.result;
    24 $func Get-Vars e.list = e.vars;
    25 $func Names-List t.pragma ex = ey;
    26 $func AS-To-Ref e.as = e.rf;
    27 $func Save-Id s.id (e.pos) = ;
    28 $func Add-Pragma t.pragma e.list = e.vars;
    29 $func Debug-Sent e.sentence = e.Debug;
    30 $func Debug-Result e.result = e.Debug;
    31 $func Debug-Hard e.hard = e.Debug;
    32 $func Debug-Module e.module = e.Debug;
    33 $func Store-Pragma e.pragma = ;
    34 $func Debug-Pattern e.pattern = e.Debug;
    35 $func Debug-Call-Pattern t.pragma = e.Debug;
    36 $func Debug-Add e.sent = e.Debug;
    37 $func Format-Hard t.pragma e.expr = e.format;
    38 $func? Debug-Lib /*empty*/ = e.lib;
    39 $func? Try-Open e.path = e.dir;
    40 $func Get-Ready-To-Work e.lib = e.ImportLib;
    41 $func Correct-Tab-Sources s.tab e.key = ;
    42 $func Def-Key s.key = s.new;
    43 
    44 $box Debug-id;
    45 $box Vars;
    46 $box Pragma;    //  (e.filename) s.line s.col
    47 $box HardExpr;  // result format for ::
    48 $box Numb;     // for unical "_debug"
    49 
    50 $table Id-Position;
    51 
    52 //RFP-Debug ex = <PrintLN "Debug : "ex '\n'>, ex :
    53 //{
    54 //  t.Syntax e.rest = t.Syntax : {
    55 //    (MODULE t.Module e.ModuleBody) = <Push-Vars>
    56 //      (MODULE t.Module <Debug-Module e.ModuleBody>)<Pop-Vars>;                             
    57 //    (INTERFACE e.body)  = t.Syntax;
    58 //  } :: e.debug, e.debug <RFP-Debug e.rest>;
    59 //  /*empty*/;
    60 // };
    61 
    62 RFP-Debug  e.module = {
    63   <Table-Copy &RFP-Sources> :: s.tab,
    64   <Debug-Lib> <Correct-Tab-Sources s.tab <Domain s.tab>> 
    65   <Push-Vars> <Store &Debug-id 0>
    66   <Debug-Module e.module> <Pop-Vars>;
    67   e.module ;
     1// $Id$
     2
     3$use Convert List;
     4
     5$func Add-Env e.items (env) = e.items (env);
     6$func Gen-Debugs (e.in-result?) (e.debugs) e.items = (e.debugs) e.items;
     7
     8$func Gener-Debug e.debugs = e.debug-calls;
     9
     10Add-Debug e.items =
     11  <Add-Env e.items ()> :: e.items t,
     12  <Gen-Debugs () () e.items> :: t e.items,
     13  e.items;
     14
     15Add-Env e.items (env), e.items : {
     16  (BRANCH t.p e.branch) e.rest =
     17    <Add-Env e.branch (env)> :: e.branch t,
     18    (BRANCH t.p e.branch) <Add-Env e.rest (env)>;
     19  (s.tag t.p t.name) e.rest, s.tag : \{ EVAR; VVAR; SVAR; TVAR; } =
     20    {
     21      env : $r e (s.tag t t.name) e = env;
     22      env (s.tag t.p t.name);
     23    } :: env,
     24    (s.tag t.p t.name)
     25    <Add-Env e.rest (env)>;
     26  (e1 (PRAGMA e.p) e2) e.rest =
     27    <Add-Env e2 (env)> :: e2 (env2),
     28    (Comp-Debug (PRAGMA e.p) env)
     29    (e1 (PRAGMA e.p) e2) <Add-Env e.rest (env2)>;
     30  (e1) e.rest =
     31    <Add-Env e1 (env)> :: e1 (env),
     32    (e1) <Add-Env e.rest (env)>;
     33  t1 e.rest =
     34    t1 <Add-Env e.rest (env)>;
     35  /*empty*/ = (env);
    6836};
    6937
    70 Correct-Tab-Sources s.tab e.sources = e.sources : {
    71   /*empty*/;
    72   (s.key) e.rest = <Def-Key s.key> :: s.idx, 
    73     <Bind &RFP-Sources (s.idx) (<Lookup s.tab s.key>) > <Correct-Tab-Sources s.tab e.rest>;
    74 }; 
    75 
    76 Def-Key s.key = {
    77   <In-Table?  &RFP-Sources s.key> = <Def-Key <"+" s.key 1> >;
    78   s.key;                 
    79 };
    80 
    81 Debug-Module
    82 {
    83   /*empty*/;
    84   t.item e.rest = t.item : (s.type e.body), 
    85   {
    86     s.type : PRAGMA = t.item;   
    87     s.type : IMPORT,   
    88     {
    89       e.body : s.objtype t.pragma t.objname,
    90       {
    91          t.objname : CHANNEL = t.item;
    92 // ToDo    <Add-Vars t.objname>
    93          t.item;
    94       };
    95       t.item;     
    96     };
    97     s.type: \{ LOCAL; EXPORT; }, e.body : {
    98       CONST e.const = t.item;
    99       s.tag t.pragma t.fname t.input t.output e.sent = <Push-Vars>
    100          (s.type s.tag t.pragma t.fname t.input t.output <Debug-Sent e.sent>)
    101          <Pop-Vars>;
    102       s.objtype t.pragma t.objname =
    103       {
    104          t.objname : CHANNEL = t.item;
    105 // ToDo    <Add-Vars t.objname>
    106           t.item;
    107       };
    108     };
    109   } :: e.debug, e.debug <Debug-Module e.rest>;
    110 };
    111 
    112 Debug-Sent 
    113 {
    114   /*empty*/ ;
    115   (RESULT (PRAGMA) e.expr) e.rest = (RESULT (PRAGMA) e.expr)
    116     <Debug-Sent e.rest>;
    117 //  (RESULT (EVAR (PRAGMA) e.var) e.expr) e.rest =
    118 //    (RESULT (EVAR (PRAGMA) e.var) e.expr) <Debug-Sent e.rest>;
    119   (RESULT t.pragma e.expr) e.rest = 
    120 //   { e.rest : /*empty*/ = <Debug-Call><Store-Pragma t.pragma>
    121 //     (RESULT t.pragma <Debug-Result e.expr>) <Debug-Call-Pattern t.pragma > ;
    122     <Debug-Call> 
    123     <Store-Pragma t.pragma>   
    124       (RESULT t.pragma <Debug-Result e.expr>) <Debug-Add e.rest>;
    125 //  };
    126   t.stat e.rest = t.stat :
    127   {
    128     (PRAGMA e.pragma) = t.stat;
    129 //    (FORMAT (EVAR (PRAGMA) e.var)) = t.stat;
    130     (FORMAT t.pragma e.hard)  = (FORMAT t.pragma <Debug-Hard e.hard>);   
    131     (NOT t.branch)  = (NOT <Debug-Sent t.branch>) ;
    132     (ITER e.sent)  = (ITER <Debug-Sent e.sent>) ;
    133     (TRY t.try e.Nofail t.catch) =
    134       (TRY <Debug-Sent t.try> e.Nofail <Debug-Sent t.catch>);
    135     (CUT) = t.stat;
    136     (CUTALL t.pragma) = t.stat;
    137     (STAKE) = t.stat;
    138     (FAIL t.pragma) = <Debug-Call t.pragma> t.stat;
    139     (ERROR t.pragma) = <Store-Pragma t.pragma> t.stat;
    140     (NOFAIL) = t.stat;
    141     (BLOCK t.pragma e.branch) = <Push-Vars> <Store-Pragma t.pragma>
    142       (BLOCK t.pragma <Debug-Sent e.branch>) <Pop-Vars>;
    143     (BLOCK? t.pragma e.branch) = <Push-Vars>  <Store-Pragma t.pragma>
    144       (BLOCK? t.pragma <Debug-Sent e.branch>) <Pop-Vars>;
    145     (BRANCH t.pragma e.sent) = <Push-Vars> <Store-Pragma t.pragma>
    146 //      (BRANCH t.pragma <Debug-Sent e.sent> <Debug-Call>) <Pop-Vars>;
    147         (BRANCH t.pragma <Debug-Sent e.sent>) <Pop-Vars>;
    148     (BRANCH? t.pragma e.sent) = <Push-Vars> <Store-Pragma t.pragma>
    149 //    (BRANCH? t.pragma <Debug-Sent e.sent> <Debug-Call>) <Pop-Vars> ;
    150        (BRANCH? t.pragma <Debug-Sent e.sent>) <Pop-Vars>;
    151     (LEFT t.pragma e.expr) = (LEFT t.pragma <Debug-Pattern e.expr>);
    152     (RIGHT t.pragma e.expr) = (RIGHT t.pragma <Debug-Pattern e.expr>);
    153   } :: e.debug, e.debug <Debug-Sent e.rest>;
     38Gen-Debugs (e.in-result?) (e.debugs) e.items, e.items : {
     39  e1 (Comp-Debug e.d) = <Gen-Debugs (e.in-result?) ((e.d) e.debugs) e1>;
     40  e1 (Comp-Debug e.d) (RESULT t.p e.r) =
     41    <Gen-Debugs (In-Result!) () e.r> :: (e) e.r,
     42    <Gen-Debugs (e.in-result?) () e1>
     43    (RESULT t.p <Gener-Debug (e.d)> e.r <Gener-Debug e.debugs>);
     44  e1 (Comp-Debug e.d) (s.op t.p), s.op : \{ CUT; CUTALL; STAKE; FAIL; ERROR; } =
     45    <Gen-Debugs () () e1>
     46    <Gener-Debug (e.d)> (s.op t.p) (RESULT t.p <Gener-Debug e.debugs>);
     47  e1 (Comp-Debug e.d) (CALL t.p t.name e.r) =
     48    <Gen-Debugs (In-Result!) () e.r> :: (e) e.r,
     49    <Gen-Debugs (In-Result!) () e1>
     50    (CALL t.p t.name e.r <Gener-Debug (e.d)>);
     51  e1 (e2) =
     52    <Gen-Debugs (e.in-result?) () e2> :: (e.debugs2) e2,
     53    <Gen-Debugs (e.in-result?) (e.debugs2 e.debugs) e1> (e2);
     54  e1 t2 =
     55    <Gen-Debugs (e.in-result?) (e.debugs) e1> t2;
     56  /*empty*/ = (e.debugs);
    15457};
    15558
    156 Debug-Add e.sent = e.sent : {
    157 /*empty*/ = ;
    158 (FORMAT t.pragma e.expr) e.rest = <Store &Numb 1>
    159   <Store &HardExpr <Format-Hard t.pragma e.expr>>
    160   <Debug-Call-Pattern t.pragma> <Debug-Sent e.sent>;
    161 (BLOCK t.pragma e.expr) e.rest = <Debug-Call-Pattern t.pragma>
    162   <Debug-Sent e.sent>;
    163 (BLOCK? t.pragma e.expr) e.rest = <Debug-Call-Pattern t.pragma>
    164   <Debug-Sent e.sent>;
    165 (LEFT t.pragma e.expr) e.rest = <Debug-Call-Pattern t.pragma>
    166   <Debug-Sent e.sent>;
    167 (RIGHT t.pragma e.expr) e.rest = <Debug-Call-Pattern t.pragma>
    168   <Debug-Sent e.sent>;
    169 e.sent = <Debug-Sent e.sent>;
     59$func Conv-Var t.var = t.converted-var;
     60Conv-Var t.var =
     61  t.var : (t t (e.name)) = (PAREN <To-Chars e.name> (PAREN t.var));
     62 
     63$func Conv-Pragma t = e;
     64Conv-Pragma {
     65  ((PRAGMA (FILE e.file) (LINE s.line s.col)) env) =
     66    (RESULT (PRAGMA) (CALL (PRAGMA) (Debug Stop?) e.file s.line s.col));
     67  t = /*empty*/;
    17068};
    17169
    172 Format-Hard t.pragma e.expr = e.expr : {
    173 /*empty*/ = ;
    174 t1 e.rest = t1: {
    175   s.sym = (SVAR t.pragma ("_debug_" <To-Word <? &Numb>>));
    176   (PAREN e.hard) = (PAREN <Format-Hard t.pragma e.hard>);
    177   (e.type t.var-pragma t.name) =
    178     (e.type t.pragma ("_debug_" <To-Chars <? &Numb>>));
    179   } :: e.format,
    180   <? &Numb> : s.num, <Store &Numb <"+" s.num 1>>,
    181   e.format <Format-Hard t.pragma e.rest>;
     70Gener-Debug {
     71  v.debugs =
     72    v.debugs : (t.pragma env) e,
     73    <Map &Conv-Pragma (<Nub v.debugs>)> : {
     74      v.stop-cals =
     75        (BLOCK? (PRAGMA) (BRANCH (PRAGMA) v.stop-cals
     76          (RESULT (PRAGMA) (CALL (PRAGMA) (Debug Debug) <Map &Conv-Var (env)>)))
     77          (BRANCH (PRAGMA) (RESULT (PRAGMA))));
     78      empty = empty;
     79    };;
    18280};
    18381
    184 Debug-Pattern
    185 {
    186   (PAREN e.pat) = (PAREN <Debug-Pattern e.pat>);
    187   (e.type t.pragma t.name) =
    188     (e.type t.pragma t.name) <Add-Vars (e.type t.name)>;
    189   e.expr = e.expr;
    190 };
    191 
    192 Store-Pragma {
    193  (PRAGMA (FILE e.file) (LINE s.line s.col)) = <Store &Pragma (e.file) s.line s.col>;
    194 };
    195 
    196 Debug-Result
    197 {
    198   /*empty*/;
    199   t.res e.rest = t.res :
    200   {
    201     s1 = s1;
    202     (PAREN e.expr) = (PAREN <Debug-Result e.expr>);
    203     (REF t.name) = t.res;
    204     (CALL t.pragma t.name e.expr) = (CALL t.pragma t.name <Debug-Result e.expr>);
    205     (BLOCK t.pragma e.branch) = <Push-Vars> <Store-Pragma t.pragma>
    206       (BLOCK t.pragma <Debug-Sent e.branch>)<Pop-Vars>;
    207     (BLOCK? t.pragma e.branch) = <Push-Vars> <Store-Pragma t.pragma>
    208       (BLOCK? t.pragma <Debug-Sent e.branch>) <Pop-Vars>;
    209     (e.type t.pragma t.name) =
    210       <Add-Vars (e.type t.name)> t.res;     
    211   } :: e.debug, e.debug <Debug-Result e.rest>;
    212 };
    213 
    214 Debug-Hard
    215 {
    216   /*empty*/ =  ;
    217   t.hard e.rest = t.hard :
    218   {
    219     s1 = s1;
    220     (PAREN e.expr) = (PAREN <Debug-Hard e.expr>);
    221     (e.type t.pragma t.name) = 
    222       <Add-Vars (e.type t.name)> t.hard;
    223   } :: e.debug, e.debug <Debug-Hard e.rest>;
    224 };
    225 
    226 Debug-Call  {
    227 /*empty*/ =
    228      <? &Pragma> : (e.file) s.line s.col,
    229        <"+" s.col 1> :: s.col, 
    230        (e.file) s.line s.col :: e.pos,
    231        <Store &Pragma e.pos>,
    232        (PRAGMA (FILE e.file) (LINE s.line s.col)) :: t.pragma,
    233        <? &Debug-id> : s.id,
    234        <Store &Debug-id <"+" s.id 1>>,
    235        <Bind &Id-Position (s.id) (e.pos)>,
    236        (BLOCK t.pragma
    237          (BRANCH t.pragma
    238             (RESULT t.pragma
    239              (CALL t.pragma ("Debug" "Debug-Check") s.id)
    240              (CALL t.pragma ("Debug" "Debug")<Get-Vars-Str t.pragma <? &Vars>>)
    241             )
    242           )
    243           (BRANCH t.pragma (RESULT t.pragma))
    244        ); 
    245 //     <Debug s.id e.pos>;
    246 t.pragma = t.pragma : (PRAGMA (FILE e.file)(LINE s.line s.col)),
    247     (e.file) s.line s.col :: e.pos,
    248     <? &Debug-id> : s.id,
    249     <Store &Debug-id <"+" s.id 1>>,
    250     <Bind &Id-Position (s.id) (e.pos)>,
    251     (BLOCK t.pragma
    252       (BRANCH t.pragma
    253          (RESULT t.pragma
    254            (CALL t.pragma ("Debug" "Debug-Check") s.id)
    255            (CALL t.pragma ("Debug" "Debug")  <Get-Vars-Str t.pragma <? &Vars>> )
    256          )
    257        )
    258        (BRANCH t.pragma (RESULT t.pragma))
    259     );
    260 //  <Debug s.id e.pos >;
    261 };
    262 
    263 Debug-Call-Pattern t.pragma =
    264   t.pragma : (PRAGMA (FILE e.file)(LINE s.line s.col)),
    265   (e.file) s.line s.col :: e.pos,
    266   <? &Debug-id> : s.id,
    267   <Store &Debug-id <"+" s.id 1>>,
    268   <Bind &Id-Position (s.id)(e.pos)>,
    269   <? &HardExpr> :: e.format,
    270   <Store &HardExpr /*empty*/ >,
    271   { 
    272     e.format : /*empty*/ = (EVAR t.pragma ("_debug_"));
    273     e.format;
    274   } :: e.format,
    275   (FORMAT t.pragma e.format)
    276   (BLOCK t.pragma
    277     (BRANCH t.pragma
    278       (RESULT t.pragma
    279         (CALL t.pragma ("Debug" "Debug-Check") s.id)
    280         (CALL t.pragma ("Debug" "Debug") <Get-Vars-Str t.pragma <? &Vars>>)
    281       )
    282     )
    283     (BRANCH t.pragma (RESULT t.pragma)
    284     )
    285   )
    286   (RESULT t.pragma e.format);
    287 
    288 // Call of Debug-Function with variant- parameters
    289 // Debug s.id e.pos = e.pos : (e.file) s.line s.col, 
    290 //   <Save-Id s.id (e.idx s.line s.col)>
    291 //     <PrintLN 's.id = 's.id ' e.pos= ' e.file
    292 //     s.line s.col 'e.names ='<Names-List (e.pos) <Get-Vars <? &Vars>>> > ;
    293 
    294 // new level of vars-stack is added
    295 Push-Vars = <Store &Vars <? &Vars> () >;
    296 
    297 // level of vars-stack is deleted
    298 Pop-Vars  = <? &Vars> : e.var (e.last),
    299             <Store &Vars e.var>;
    300 
    301 Add-Vars t.var =  // t.var = (e.type t.name)
    302   <? &Vars> :: e.list, e.list : {
    303      e1 ( e2 t.var e3) e4 = ;
    304      e1 (e.last) = <Store &Vars e1 (e.last t.var) >;
    305   };
    306 
    307 Get-Vars
    308 {
    309   /*empty*/ = /*empty*/;
    310    (e.head) e.tail = e.head <Get-Vars e.tail>;
    311 };
    312 
    313 Get-Vars-Str   
    314 {
    315   t.pragma  = ;
    316   t.pragma (e.head) e.tail  =  {
    317     e.head : /*empty*/  = <Get-Vars-Str  t.pragma e.tail>;
    318     <Names-List t.pragma e.head> <Get-Vars-Str t.pragma e.tail>;
    319   };
    320 };
    321 
    322 Add-Pragma t.pragma e.list = e.list :
    323 {
    324   (s.type t.name) e.tail = (s.type t.pragma t.name) <Add-Pragma t.pragma e.tail>;
    325    /*empty*/ = ;;
    326 };
    327 
    328 Names-List
    329 { 
    330    t.pragma  = /*empty*/;
    331    t.pragma t.var e.tail = (PAREN <To-Word <AS-To-Ref t.var>>) (PAREN <Add-Pragma t.pragma  t.var>)
    332                   <Names-List t.pragma e.tail>;
    333 };     
    334 
    335 AS-To-Ref
    336 {
    337   SVAR = 's';
    338   TVAR = 't';
    339   EVAR = 'e';
    340   VVAR = 'v';
    341   (s.tag (e.name)) = <AS-To-Ref s.tag> '.' <To-Chars e.name> ;
    342 };
    343 
    344 Save-Id s.idx (e.pos) = ;  // e.pos : e.filename s.line s.col
    345 
    346 Try-Open {
    347 /*empty*/ = <PrintLN "File of debug-library " &Name-Debug-File "  not found ">
    348    $fail;
    349 (e.dir) e.rest = {
    350   <Channel> :: s.ch,
    351   <Open-File s.ch e.dir &Dir-Separator &Name-Debug-File "r">,
    352   <Close-Channel s.ch>,
    353   e.dir;
    354   <Try-Open e.rest>;
    355   };
    356 };
    357  
    358 Debug-Lib  =  <? &RFP-Include-Path> :: e.path, {
    359   <Try-Open e.path> :: e.dir,
    360   <RFP-Lexer e.dir &Dir-Separator &Name-Debug-File> :: e.source,
    361   <Store &RFP-Token-Stack e.source>,
    362   <RFP-Parser> : (INTERFACE t.name e.lib),      // Debug.rfi
    363   <Get-Ready-To-Work e.lib>; 
    364   $fail;
    365 };
    366 
    367 Get-Ready-To-Work 
    368 {
    369   /*empty*/ ;
    370   t.Item e.rest =
    371     t.Item : (s.Linkage s.ItemType t.Pragma t.ItemName e.ItemBody),
    372     s.ItemType : {
    373       FUNC = <Left 0 2 e.ItemBody> : (e.in) (e.out),
    374         &Fun (<Format-Exp e.in>) (<Format-Exp e.out>);
    375       FUNC? = <Left 0 2 e.ItemBody> : (e.in) (e.out),
    376         &Fun? (<Format-Exp e.in>) (<Format-Exp e.out>);
    377     } :: s.tab e.ItemDef,
    378     <Bind s.tab (t.ItemName) (IMPORT s.ItemType t.Pragma e.ItemDef)>,
    379     (IMPORT s.ItemType t.Pragma t.ItemName e.ItemBody)
    380     <Get-Ready-To-Work e.rest>;
    381 };
    382 
    383 
     82// Sveta: //  creating of label for debug
     83// Sveta:
     84// Sveta: $use "rfpc";         //  rfpc.rfi 
     85// Sveta: $use "rfp_lex";      // rfp_lex.rfi
     86// Sveta: $use "rfp_parse";    // rfp_parse.rfi
     87// Sveta: $use "rfp_compile";  // rfp_compile.rfi
     88// Sveta: $use "rfp_format";   // rfp_format.rfi
     89// Sveta: $use "rfp_src";
     90// Sveta:
     91// Sveta:
     92// Sveta: $use Box ;
     93// Sveta: $use Convert ;
     94// Sveta: $use Table ;
     95// Sveta: $use StdIO ;
     96// Sveta: $use Arithm ;
     97// Sveta: $use Access;
     98// Sveta:
     99// Sveta: $func Debug-Call e.pos = e.debug;
     100// Sveta: //  $func Debug s.id e.names = e.Debug ;
     101// Sveta: $func Push-Vars  = ;
     102// Sveta: $func Pop-Vars = ;
     103// Sveta: $func Add-Vars t.var = ;
     104// Sveta: $func Get-Vars-Str  e.list = e.result;
     105// Sveta: $func Get-Vars e.list = e.vars;
     106// Sveta: $func Names-List t.pragma ex = ey;
     107// Sveta: $func AS-To-Ref e.as = e.rf;
     108// Sveta: $func Save-Id s.id (e.pos) = ;
     109// Sveta: $func Add-Pragma t.pragma e.list = e.vars;
     110// Sveta: $func Debug-Sent e.sentence = e.Debug;
     111// Sveta: $func Debug-Result e.result = e.Debug;
     112// Sveta: $func Debug-Hard e.hard = e.Debug;
     113// Sveta: $func Debug-Module e.module = e.Debug;
     114// Sveta: $func Store-Pragma e.pragma = ;
     115// Sveta: $func Debug-Pattern e.pattern = e.Debug;
     116// Sveta: $func Debug-Call-Pattern t.pragma = e.Debug;
     117// Sveta: $func Debug-Add e.sent = e.Debug;
     118// Sveta: $func Format-Hard t.pragma e.expr = e.format;
     119// Sveta: $func? Debug-Lib /*empty*/ = e.lib;
     120// Sveta: $func? Try-Open e.path = e.dir;
     121// Sveta: $func Get-Ready-To-Work e.lib = e.ImportLib;
     122// Sveta: $func Correct-Tab-Sources s.tab e.key = ;
     123// Sveta: $func Def-Key s.key = s.new;
     124// Sveta:
     125// Sveta: $box Debug-id;
     126// Sveta: $box Vars;
     127// Sveta: $box Pragma;    //  (e.filename) s.line s.col
     128// Sveta: $box HardExpr;  // result format for ::
     129// Sveta: $box Numb;     // for unical "_debug"
     130// Sveta:
     131// Sveta: $table Id-Position;
     132// Sveta:
     133// Sveta: //RFP-Debug ex = <PrintLN "Debug : "ex '\n'>, ex :
     134// Sveta: //{
     135// Sveta: //  t.Syntax e.rest = t.Syntax : {
     136// Sveta: //    (MODULE t.Module e.ModuleBody) = <Push-Vars>
     137// Sveta: //      (MODULE t.Module <Debug-Module e.ModuleBody>)<Pop-Vars>;                             
     138// Sveta: //    (INTERFACE e.body)  = t.Syntax;
     139// Sveta: //  } :: e.debug, e.debug <RFP-Debug e.rest>;
     140// Sveta: //  /*empty*/;
     141// Sveta: // };
     142// Sveta:
     143// Sveta: RFP-Debug  e.module = {
     144// Sveta:   <Table-Copy &RFP-Sources> :: s.tab,
     145// Sveta:   <Debug-Lib> <Correct-Tab-Sources s.tab <Domain s.tab>> 
     146// Sveta:   <Push-Vars> <Store &Debug-id 0>
     147// Sveta:   <Debug-Module e.module> <Pop-Vars>;
     148// Sveta:   e.module ;
     149// Sveta: };
     150// Sveta:
     151// Sveta: Correct-Tab-Sources s.tab e.sources = e.sources : {
     152// Sveta:   /*empty*/;
     153// Sveta:   (s.key) e.rest = <Def-Key s.key> :: s.idx, 
     154// Sveta:     <Bind &RFP-Sources (s.idx) (<Lookup s.tab s.key>) > <Correct-Tab-Sources s.tab e.rest>;
     155// Sveta: }; 
     156// Sveta:
     157// Sveta: Def-Key s.key = {
     158// Sveta:   <In-Table?  &RFP-Sources s.key> = <Def-Key <"+" s.key 1> >;
     159// Sveta:   s.key;                 
     160// Sveta: };
     161// Sveta:
     162// Sveta: Debug-Module
     163// Sveta: {
     164// Sveta:   /*empty*/;
     165// Sveta:   t.item e.rest = t.item : (s.type e.body), 
     166// Sveta:   {
     167// Sveta:     s.type : PRAGMA = t.item;   
     168// Sveta:     s.type : IMPORT,   
     169// Sveta:     {
     170// Sveta:       e.body : s.objtype t.pragma t.objname,
     171// Sveta:       {
     172// Sveta:          t.objname : CHANNEL = t.item;
     173// Sveta: // ToDo    <Add-Vars t.objname>
     174// Sveta:          t.item;
     175// Sveta:       };
     176// Sveta:       t.item;     
     177// Sveta:     };
     178// Sveta:     s.type: \{ LOCAL; EXPORT; }, e.body : {
     179// Sveta:       CONST e.const = t.item;
     180// Sveta:       s.tag t.pragma t.fname t.input t.output e.sent = <Push-Vars>
     181// Sveta:          (s.type s.tag t.pragma t.fname t.input t.output <Debug-Sent e.sent>)
     182// Sveta:          <Pop-Vars>;
     183// Sveta:       s.objtype t.pragma t.objname =
     184// Sveta:       {
     185// Sveta:          t.objname : CHANNEL = t.item;
     186// Sveta: // ToDo    <Add-Vars t.objname>
     187// Sveta:           t.item;
     188// Sveta:       };
     189// Sveta:     };
     190// Sveta:   } :: e.debug, e.debug <Debug-Module e.rest>;
     191// Sveta: };
     192// Sveta:
     193// Sveta: Debug-Sent 
     194// Sveta: {
     195// Sveta:   /*empty*/ ;
     196// Sveta:   (RESULT (PRAGMA) e.expr) e.rest = (RESULT (PRAGMA) e.expr)
     197// Sveta:     <Debug-Sent e.rest>;
     198// Sveta: //  (RESULT (EVAR (PRAGMA) e.var) e.expr) e.rest =
     199// Sveta: //    (RESULT (EVAR (PRAGMA) e.var) e.expr) <Debug-Sent e.rest>;
     200// Sveta:   (RESULT t.pragma e.expr) e.rest = 
     201// Sveta: //   { e.rest : /*empty*/ = <Debug-Call><Store-Pragma t.pragma>
     202// Sveta: //     (RESULT t.pragma <Debug-Result e.expr>) <Debug-Call-Pattern t.pragma > ;
     203// Sveta:     <Debug-Call> 
     204// Sveta:     <Store-Pragma t.pragma>   
     205// Sveta:       (RESULT t.pragma <Debug-Result e.expr>) <Debug-Add e.rest>;
     206// Sveta: //  };
     207// Sveta:   t.stat e.rest = t.stat :
     208// Sveta:   {
     209// Sveta:     (PRAGMA e.pragma) = t.stat;
     210// Sveta: //    (FORMAT (EVAR (PRAGMA) e.var)) = t.stat;
     211// Sveta:     (FORMAT t.pragma e.hard)  = (FORMAT t.pragma <Debug-Hard e.hard>);   
     212// Sveta:     (NOT t.branch)  = (NOT <Debug-Sent t.branch>) ;
     213// Sveta:     (ITER e.sent)  = (ITER <Debug-Sent e.sent>) ;
     214// Sveta:     (TRY t.try e.Nofail t.catch) =
     215// Sveta:       (TRY <Debug-Sent t.try> e.Nofail <Debug-Sent t.catch>);
     216// Sveta:     (CUT) = t.stat;
     217// Sveta:     (CUTALL t.pragma) = t.stat;
     218// Sveta:     (STAKE) = t.stat;
     219// Sveta:     (FAIL t.pragma) = <Debug-Call t.pragma> t.stat;
     220// Sveta:     (ERROR t.pragma) = <Store-Pragma t.pragma> t.stat;
     221// Sveta:     (NOFAIL) = t.stat;
     222// Sveta:     (BLOCK t.pragma e.branch) = <Push-Vars> <Store-Pragma t.pragma>
     223// Sveta:       (BLOCK t.pragma <Debug-Sent e.branch>) <Pop-Vars>;
     224// Sveta:     (BLOCK? t.pragma e.branch) = <Push-Vars>  <Store-Pragma t.pragma>
     225// Sveta:       (BLOCK? t.pragma <Debug-Sent e.branch>) <Pop-Vars>;
     226// Sveta:     (BRANCH t.pragma e.sent) = <Push-Vars> <Store-Pragma t.pragma>
     227// Sveta: //      (BRANCH t.pragma <Debug-Sent e.sent> <Debug-Call>) <Pop-Vars>;
     228// Sveta:         (BRANCH t.pragma <Debug-Sent e.sent>) <Pop-Vars>;
     229// Sveta:     (BRANCH? t.pragma e.sent) = <Push-Vars> <Store-Pragma t.pragma>
     230// Sveta: //    (BRANCH? t.pragma <Debug-Sent e.sent> <Debug-Call>) <Pop-Vars> ;
     231// Sveta:        (BRANCH? t.pragma <Debug-Sent e.sent>) <Pop-Vars>;
     232// Sveta:     (LEFT t.pragma e.expr) = (LEFT t.pragma <Debug-Pattern e.expr>);
     233// Sveta:     (RIGHT t.pragma e.expr) = (RIGHT t.pragma <Debug-Pattern e.expr>);
     234// Sveta:   } :: e.debug, e.debug <Debug-Sent e.rest>;
     235// Sveta: };
     236// Sveta:
     237// Sveta: Debug-Add e.sent = e.sent : {
     238// Sveta: /*empty*/ = ;
     239// Sveta: (FORMAT t.pragma e.expr) e.rest = <Store &Numb 1>
     240// Sveta:   <Store &HardExpr <Format-Hard t.pragma e.expr>>
     241// Sveta:   <Debug-Call-Pattern t.pragma> <Debug-Sent e.sent>;
     242// Sveta: (BLOCK t.pragma e.expr) e.rest = <Debug-Call-Pattern t.pragma>
     243// Sveta:   <Debug-Sent e.sent>;
     244// Sveta: (BLOCK? t.pragma e.expr) e.rest = <Debug-Call-Pattern t.pragma>
     245// Sveta:   <Debug-Sent e.sent>;
     246// Sveta: (LEFT t.pragma e.expr) e.rest = <Debug-Call-Pattern t.pragma>
     247// Sveta:   <Debug-Sent e.sent>;
     248// Sveta: (RIGHT t.pragma e.expr) e.rest = <Debug-Call-Pattern t.pragma>
     249// Sveta:   <Debug-Sent e.sent>;
     250// Sveta: e.sent = <Debug-Sent e.sent>;
     251// Sveta: };
     252// Sveta:
     253// Sveta: Format-Hard t.pragma e.expr = e.expr : {
     254// Sveta: /*empty*/ = ;
     255// Sveta: t1 e.rest = t1: {
     256// Sveta:   s.sym = (SVAR t.pragma ("_debug_" <To-Word <? &Numb>>));
     257// Sveta:   (PAREN e.hard) = (PAREN <Format-Hard t.pragma e.hard>);
     258// Sveta:   (e.type t.var-pragma t.name) =
     259// Sveta:     (e.type t.pragma ("_debug_" <To-Chars <? &Numb>>));
     260// Sveta:   } :: e.format,
     261// Sveta:   <? &Numb> : s.num, <Store &Numb <"+" s.num 1>>,
     262// Sveta:   e.format <Format-Hard t.pragma e.rest>;
     263// Sveta: };
     264// Sveta:
     265// Sveta: Debug-Pattern
     266// Sveta: {
     267// Sveta:   (PAREN e.pat) = (PAREN <Debug-Pattern e.pat>);
     268// Sveta:   (e.type t.pragma t.name) =
     269// Sveta:     (e.type t.pragma t.name) <Add-Vars (e.type t.name)>;
     270// Sveta:   e.expr = e.expr;
     271// Sveta: };
     272// Sveta:
     273// Sveta: Store-Pragma {
     274// Sveta:  (PRAGMA (FILE e.file) (LINE s.line s.col)) = <Store &Pragma (e.file) s.line s.col>;
     275// Sveta: };
     276// Sveta:
     277// Sveta: Debug-Result
     278// Sveta: {
     279// Sveta:   /*empty*/;
     280// Sveta:   t.res e.rest = t.res :
     281// Sveta:   {
     282// Sveta:     s1 = s1;
     283// Sveta:     (PAREN e.expr) = (PAREN <Debug-Result e.expr>);
     284// Sveta:     (REF t.name) = t.res;
     285// Sveta:     (CALL t.pragma t.name e.expr) = (CALL t.pragma t.name <Debug-Result e.expr>);
     286// Sveta:     (BLOCK t.pragma e.branch) = <Push-Vars> <Store-Pragma t.pragma>
     287// Sveta:       (BLOCK t.pragma <Debug-Sent e.branch>)<Pop-Vars>;
     288// Sveta:     (BLOCK? t.pragma e.branch) = <Push-Vars> <Store-Pragma t.pragma>
     289// Sveta:       (BLOCK? t.pragma <Debug-Sent e.branch>) <Pop-Vars>;
     290// Sveta:     (e.type t.pragma t.name) =
     291// Sveta:       <Add-Vars (e.type t.name)> t.res;     
     292// Sveta:   } :: e.debug, e.debug <Debug-Result e.rest>;
     293// Sveta: };
     294// Sveta:
     295// Sveta: Debug-Hard
     296// Sveta: {
     297// Sveta:   /*empty*/ =  ;
     298// Sveta:   t.hard e.rest = t.hard :
     299// Sveta:   {
     300// Sveta:     s1 = s1;
     301// Sveta:     (PAREN e.expr) = (PAREN <Debug-Hard e.expr>);
     302// Sveta:     (e.type t.pragma t.name) = 
     303// Sveta:       <Add-Vars (e.type t.name)> t.hard;
     304// Sveta:   } :: e.debug, e.debug <Debug-Hard e.rest>;
     305// Sveta: };
     306// Sveta:
     307// Sveta: Debug-Call  {
     308// Sveta: /*empty*/ =
     309// Sveta:      <? &Pragma> : (e.file) s.line s.col,
     310// Sveta:        <"+" s.col 1> :: s.col, 
     311// Sveta:        (e.file) s.line s.col :: e.pos,
     312// Sveta:        <Store &Pragma e.pos>,
     313// Sveta:        (PRAGMA (FILE e.file) (LINE s.line s.col)) :: t.pragma,
     314// Sveta:        <? &Debug-id> : s.id,
     315// Sveta:        <Store &Debug-id <"+" s.id 1>>,
     316// Sveta:        <Bind &Id-Position (s.id) (e.pos)>,
     317// Sveta:        (BLOCK t.pragma
     318// Sveta:          (BRANCH t.pragma
     319// Sveta:             (RESULT t.pragma
     320// Sveta:              (CALL t.pragma ("Debug" "Debug-Check") s.id)
     321// Sveta:              (CALL t.pragma ("Debug" "Debug")<Get-Vars-Str t.pragma <? &Vars>>)
     322// Sveta:             )
     323// Sveta:           )
     324// Sveta:           (BRANCH t.pragma (RESULT t.pragma))
     325// Sveta:        ); 
     326// Sveta: //     <Debug s.id e.pos>;
     327// Sveta: t.pragma = t.pragma : (PRAGMA (FILE e.file)(LINE s.line s.col)),
     328// Sveta:     (e.file) s.line s.col :: e.pos,
     329// Sveta:     <? &Debug-id> : s.id,
     330// Sveta:     <Store &Debug-id <"+" s.id 1>>,
     331// Sveta:     <Bind &Id-Position (s.id) (e.pos)>,
     332// Sveta:     (BLOCK t.pragma
     333// Sveta:       (BRANCH t.pragma
     334// Sveta:          (RESULT t.pragma
     335// Sveta:            (CALL t.pragma ("Debug" "Debug-Check") s.id)
     336// Sveta:            (CALL t.pragma ("Debug" "Debug")  <Get-Vars-Str t.pragma <? &Vars>> )
     337// Sveta:          )
     338// Sveta:        )
     339// Sveta:        (BRANCH t.pragma (RESULT t.pragma))
     340// Sveta:     );
     341// Sveta: //  <Debug s.id e.pos >;
     342// Sveta: };
     343// Sveta:
     344// Sveta: Debug-Call-Pattern t.pragma =
     345// Sveta:   t.pragma : (PRAGMA (FILE e.file)(LINE s.line s.col)),
     346// Sveta:   (e.file) s.line s.col :: e.pos,
     347// Sveta:   <? &Debug-id> : s.id,
     348// Sveta:   <Store &Debug-id <"+" s.id 1>>,
     349// Sveta:   <Bind &Id-Position (s.id)(e.pos)>,
     350// Sveta:   <? &HardExpr> :: e.format,
     351// Sveta:   <Store &HardExpr /*empty*/ >,
     352// Sveta:   { 
     353// Sveta:     e.format : /*empty*/ = (EVAR t.pragma ("_debug_"));
     354// Sveta:     e.format;
     355// Sveta:   } :: e.format,
     356// Sveta:   (FORMAT t.pragma e.format)
     357// Sveta:   (BLOCK t.pragma
     358// Sveta:     (BRANCH t.pragma
     359// Sveta:       (RESULT t.pragma
     360// Sveta:         (CALL t.pragma ("Debug" "Debug-Check") s.id)
     361// Sveta:         (CALL t.pragma ("Debug" "Debug") <Get-Vars-Str t.pragma <? &Vars>>)
     362// Sveta:       )
     363// Sveta:     )
     364// Sveta:     (BRANCH t.pragma (RESULT t.pragma)
     365// Sveta:     )
     366// Sveta:   )
     367// Sveta:   (RESULT t.pragma e.format);
     368// Sveta:
     369// Sveta: // Call of Debug-Function with variant- parameters
     370// Sveta: // Debug s.id e.pos = e.pos : (e.file) s.line s.col, 
     371// Sveta: //   <Save-Id s.id (e.idx s.line s.col)>
     372// Sveta: //     <PrintLN 's.id = 's.id ' e.pos= ' e.file
     373// Sveta: //     s.line s.col 'e.names ='<Names-List (e.pos) <Get-Vars <? &Vars>>> > ;
     374// Sveta:
     375// Sveta: // new level of vars-stack is added
     376// Sveta: Push-Vars = <Store &Vars <? &Vars> () >;
     377// Sveta:
     378// Sveta: // level of vars-stack is deleted
     379// Sveta: Pop-Vars  = <? &Vars> : e.var (e.last),
     380// Sveta:             <Store &Vars e.var>;
     381// Sveta:
     382// Sveta: Add-Vars t.var =  // t.var = (e.type t.name)
     383// Sveta:   <? &Vars> :: e.list, e.list : {
     384// Sveta:      e1 ( e2 t.var e3) e4 = ;
     385// Sveta:      e1 (e.last) = <Store &Vars e1 (e.last t.var) >;
     386// Sveta:   };
     387// Sveta:
     388// Sveta: Get-Vars
     389// Sveta: {
     390// Sveta:   /*empty*/ = /*empty*/;
     391// Sveta:    (e.head) e.tail = e.head <Get-Vars e.tail>;
     392// Sveta: };
     393// Sveta:
     394// Sveta: Get-Vars-Str   
     395// Sveta: {
     396// Sveta:   t.pragma  = ;
     397// Sveta:   t.pragma (e.head) e.tail  =  {
     398// Sveta:     e.head : /*empty*/  = <Get-Vars-Str  t.pragma e.tail>;
     399// Sveta:     <Names-List t.pragma e.head> <Get-Vars-Str t.pragma e.tail>;
     400// Sveta:   };
     401// Sveta: };
     402// Sveta:
     403// Sveta: Add-Pragma t.pragma e.list = e.list :
     404// Sveta: {
     405// Sveta:   (s.type t.name) e.tail = (s.type t.pragma t.name) <Add-Pragma t.pragma e.tail>;
     406// Sveta:    /*empty*/ = ;;
     407// Sveta: };
     408// Sveta:
     409// Sveta: Names-List
     410// Sveta: { 
     411// Sveta:    t.pragma  = /*empty*/;
     412// Sveta:    t.pragma t.var e.tail = (PAREN <To-Word <AS-To-Ref t.var>>) (PAREN <Add-Pragma t.pragma  t.var>)
     413// Sveta:                   <Names-List t.pragma e.tail>;
     414// Sveta: };     
     415// Sveta:
     416// Sveta: AS-To-Ref
     417// Sveta: {
     418// Sveta:   SVAR = 's';
     419// Sveta:   TVAR = 't';
     420// Sveta:   EVAR = 'e';
     421// Sveta:   VVAR = 'v';
     422// Sveta:   (s.tag (e.name)) = <AS-To-Ref s.tag> '.' <To-Chars e.name> ;
     423// Sveta: };
     424// Sveta:
     425// Sveta: Save-Id s.idx (e.pos) = ;  // e.pos : e.filename s.line s.col
     426// Sveta:
     427// Sveta: Try-Open {
     428// Sveta: /*empty*/ = <PrintLN "File of debug-library " &Name-Debug-File "  not found ">
     429// Sveta:    $fail;
     430// Sveta: (e.dir) e.rest = {
     431// Sveta:   <Channel> :: s.ch,
     432// Sveta:   <Open-File s.ch e.dir &Dir-Separator &Name-Debug-File "r">,
     433// Sveta:   <Close-Channel s.ch>,
     434// Sveta:   e.dir;
     435// Sveta:   <Try-Open e.rest>;
     436// Sveta:   };
     437// Sveta: };
     438// Sveta: 
     439// Sveta: Debug-Lib  =  <? &RFP-Include-Path> :: e.path, {
     440// Sveta:   <Try-Open e.path> :: e.dir,
     441// Sveta:   <RFP-Lexer e.dir &Dir-Separator &Name-Debug-File> :: e.source,
     442// Sveta:   <Store &RFP-Token-Stack e.source>,
     443// Sveta:   <RFP-Parser> : (INTERFACE t.name e.lib),      // Debug.rfi
     444// Sveta:   <Get-Ready-To-Work e.lib>; 
     445// Sveta:   $fail;
     446// Sveta: };
     447// Sveta:
     448// Sveta: Get-Ready-To-Work 
     449// Sveta: {
     450// Sveta:   /*empty*/ ;
     451// Sveta:   t.Item e.rest =
     452// Sveta:     t.Item : (s.Linkage s.ItemType t.Pragma t.ItemName e.ItemBody),
     453// Sveta:     s.ItemType : {
     454// Sveta:       FUNC = <Left 0 2 e.ItemBody> : (e.in) (e.out),
     455// Sveta:         &Fun (<Format-Exp e.in>) (<Format-Exp e.out>);
     456// Sveta:       FUNC? = <Left 0 2 e.ItemBody> : (e.in) (e.out),
     457// Sveta:         &Fun? (<Format-Exp e.in>) (<Format-Exp e.out>);
     458// Sveta:     } :: s.tab e.ItemDef,
     459// Sveta:     <Bind s.tab (t.ItemName) (IMPORT s.ItemType t.Pragma e.ItemDef)>,
     460// Sveta:     (IMPORT s.ItemType t.Pragma t.ItemName e.ItemBody)
     461// Sveta:     <Get-Ready-To-Work e.rest>;
     462// Sveta: };
     463
     464
Note: See TracChangeset for help on using the changeset viewer.