Changes in / [20:30]


Ignore:
Location:
/to-imperative/trunk
Files:
5 added
12 edited

Legend:

Unmodified
Added
Removed
  • /to-imperative/trunk/compiler/rfp_err.rf

    r20 r30  
    1616// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    1717//
    18 // $Version: $
     18// $Source$
     19// $Revision$
     20// $Date$
    1921// Author: Andrey Slepuhin <pooh@msu.ru>
    2022
  • /to-imperative/trunk/compiler/rfp_err.rfi

    r20 r30  
     1//
     2// Copyright (C) 1999, 2000 Refal+ Development Group
     3//
     4// Refal+ is free software; you can redistribute it and/or modify
     5// it under the terms of the GNU General Public License as published by
     6// the Free Software Foundation; either version 2 of the License, or
     7// (at your option) any later version.
     8//
     9// Refal+ is distributed in the hope that it will be useful,
     10// but WITHOUT ANY WARRANTY; without even the implied warranty of
     11// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     12// GNU General Public License for more details.
     13//
     14// You should have received a copy of the GNU General Public License
     15// along with Refal+; if not, write to the Free Software
     16// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
     17//
     18// $Source$
     19// $Revision$
     20// $Date$
     21// Author: Andrey Slepuhin <pooh@msu.ru>
     22
    123$func RFP-Error (e.pos) (e.message) = ;
    224$func RFP-Warning (e.pos) (e.message) = ;
  • /to-imperative/trunk/compiler/rfp_lex.rf

    r20 r30  
    1616// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    1717//
    18 // $Version: $
     18// $Source$
     19// $Revision$
     20// $Date$
    1921// Author: Andrey Slepuhin <pooh@msu.ru>
    2022
     
    215217      } :: (e.tk) (e.new-line),
    216218        (((e.saved-position) (e.tk))) (e.new-line);
    217       <RFP-Error (<Token-Position>) (Error "Invalid character \'" s.char "\'")>,
     219      <RFP-Error (<Token-Position>) ("Invalid character \'" s.char "\'")>,
    218220        <Next-Column>,
    219221        <Scan-Token e.rest>;
     
    357359          '!';
    358360          '-';
     361          '.';
    359362        };
    360363      },
     
    447450    e = e.dir &RFP-Dir-Separator;
    448451  } :: e.dir,
     452  {
     453    e.name $iter { e.name : e1 '.' e2 = e1 &RFP-Dir-Separator e2; } :: e.name,
     454    # \{ e.name : e1 '.' e2; }, e.name;
     455  } :: e.name,
    449456  e.dir e.name '.rfi' :: e.full-name,
    450457<PrintLN "Trying to open \'" e.full-name "\'">,
  • /to-imperative/trunk/compiler/rfp_lex.rfi

    r20 r30  
     1//
     2// Copyright (C) 1999, 2000 Refal+ Development Group
     3//
     4// Refal+ is free software; you can redistribute it and/or modify
     5// it under the terms of the GNU General Public License as published by
     6// the Free Software Foundation; either version 2 of the License, or
     7// (at your option) any later version.
     8//
     9// Refal+ is distributed in the hope that it will be useful,
     10// but WITHOUT ANY WARRANTY; without even the implied warranty of
     11// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     12// GNU General Public License for more details.
     13//
     14// You should have received a copy of the GNU General Public License
     15// along with Refal+; if not, write to the Free Software
     16// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
     17//
     18// $Source$
     19// $Revision$
     20// $Date$
     21// Author: Andrey Slepuhin <pooh@msu.ru>
     22
    123$func RFP-Lexer e.filename = e.tokens ;
  • /to-imperative/trunk/compiler/rfp_parse.rf

    r20 r30  
    1616// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    1717//
    18 // $Version: $
     18// $Source$
     19// $Revision$
     20// $Date$
    1921// Author: Andrey Slepuhin <pooh@msu.ru>
    2022
     
    2931$use Table ;
    3032$use StdIO ;
     33$use Arithm ;
    3134
    3235$func Parse-Body e.tokens = e.items ;
    33 $func Parse-Const-Decls e.tokens = e.items ;
    34 $func Parse-Const-Decl (e.name) (e.tokens) = e.items ;
    35 $func Parse-Const-Expr e.tokens = (e.expr) (e.rest) ;
    36 $func Parse-Const-Term e.tokens = (e.term) (e.rest) ;
     36$func Parse-Const-Decls = e.items ;
     37$func Parse-Const-Decl e.name = e.items ;
     38$func Parse-Const-Expr = e.expr ;
     39$func Parse-Const-Term (e.pos) (s.type e.value) = e.term ;
    3740$func Module-Name = e.name ;
    38 $func Parse-Object-Decls s.type (e.tokens) = e.items ;
     41$func Parse-Object-Decls s.type  = e.items ;
     42$func Parse-Func-Decl s.type = e.items ;
     43$func Parse-Func-Def (e.pos) (s.type e.value) = e.items ;
    3944$func Full-Name s.idx (e.name) = e.fullname ;
    4045$func? Lookup-Name (e.pos) (e.name) = e.fullname ;
    4146$func Lookup-Check (e.pos) (e.name) (e.fullname) (e.rest) = ;
     47$func? Get-Token = (e.pos) (s.type e.value) ;
     48$func Unget-Token e.token = ;
     49$func? Expect-Token e.types = (e.pos) (s.type e.value) ;
     50$func Token-Descr s.type = e.string ;
     51$func Parse-Format = e.format ;
     52$func Parse-Format-Terms = e.terms ;
     53$func Parse-Result = e.format ;
     54$func Parse-Result-Term = e.terms ;
     55$func Parse-Hard-Expr = e.format ;
     56$func Parse-Hard-Expr-Terms = e.terms ;
     57$func Parse-Sentence = e.items ;
     58$func Parse-Pattern = e.items ;
     59$func Parse-Pattern-Expr = e.items ;
     60$func Parse-Pattern-Term = e.items ;
     61$func Parse-Ref = e.items ;
     62$func? Tail? = ;
     63$func Parse-Path = e.items ;
     64$func Parse-Source = e.items ;
     65$func Parse-Tail = e.items ;
     66$func Parse-Alt = e.items ;
    4267
    4368$box Module-Name-Box ;
     69$box Saved-Position ;
     70$box Unget-Stack ;
    4471$table Constants ;
    4572$table Names ;
    4673
     74// This function returns a token description according
     75// to its type
     76Token-Descr // s.type = e.string
     77{
     78  COMMA = "\',\'";
     79  COLON = "\':\'";
     80  SEMICOLON = "\';\'";
     81  EOF = "end of file";
     82  s.type = "token " s.type;
     83};
     84
     85// This function returns a next token
     86Get-Token // [] = (e.pos) (s.type e.value)
     87 = {
     88   // First check if there are any tokens in unget stack
     89   <? &Unget-Stack> : (e.tokens) ((e.pos) (s.type e.value)) =
     90     <Store &Unget-Stack e.tokens>, (e.pos) (s.type e.value);
     91   // If unget stack is empty, get a token in a usual way
     92   <? &RFP-Token-Stack> : (e.token) e.rest,
     93     <Store &RFP-Token-Stack e.rest> = e.token : (e.pos) (s.type e.value),
     94     (e.pos) (s.type e.value);
     95 };
     96
     97// This function puts a token to unget stack for future use
     98Unget-Token // e.token = []
     99  e.token =
     100    <Store &Unget-Stack (<? &Unget-Stack>) (e.token)>;
     101
     102// This function scans for a token of one of specified types
     103Expect-Token // e.types = (e.pos) (s.type e.value)
     104  e.types =
     105    T <Get-Token> $iter \{
     106      \{
     107        s.message : T;
     108        s.type : EOF;
     109      }, <RFP-Error (e.pos) ("Unexpected " <Token-Descr s.type>)>,$fail;
     110      F <Get-Token>;
     111    } :: s.message (e.pos) (s.type e.value),
     112      e.types :
     113        \{
     114           e s.type e =
     115//<WriteLN "Expect: got " s.type e.value>,
     116             (e.pos) (s.type e.value);
     117           e EMPTY e =
     118//<WriteLN "Expect: got " EMPTY>,
     119             <Unget-Token (e.pos) (s.type e.value)>, (e.pos) (EMPTY);
     120        };
     121
    47122RFP-Parser e.tokens =
    48123  <RFP-Clear-Table &Constants>,
     124  <RFP-Clear-Table &Names>,
     125  <Store &Unget-Stack>,
    49126  <Store &Module-Name-Box <RFP-Module-Name <Lookup &RFP-Sources 1>>>,
    50   ((MODULE <To-Word <Module-Name>>) <Parse-Body e.tokens>);
    51 
     127  $trap
     128    ((MODULE <To-Word <Module-Name>>) <Parse-Body>)
     129  $with {
     130    e = <? &Saved-Position> :: e.pos,
     131      <RFP-Error (e.pos) ("Unexpected end of file during declaration parsing")>,
     132      FAIL;
     133  };
     134
     135// This is a shortcut function to get a module name
    52136Module-Name = <? &Module-Name-Box>;
    53137
    54 Parse-Body
     138// The main parsing routine
     139Parse-Body =
    55140{
    56   ((e.pos) (s.type e.value)) e.rest =
    57     {
     141  <Expect-Token BOX TABLE VECTOR STRING CHANNEL CONST WORD FUNC FUNC? EOF>
     142    :: (e.pos) (s.type e.value),
     143    <Store &Saved-Position e.pos>,
     144    \{
     145      // If token type is BOX, TABLE, VECTOR, STRING or CHANNEL
     146      // then parse object declaration
    58147      s.type :
    59148        \{
     
    63152          STRING;
    64153          CHANNEL;
    65         } = <Parse-Object-Decls s.type (e.rest)>;
    66       s.type : CONST = <Parse-Const-Decls e.rest>;
    67       <Parse-Body e.rest>;
    68     };
    69   = ;
     154        } = <Parse-Object-Decls s.type>;
     155      // If token type is CONST then parse constant declaration
     156      s.type : CONST =
     157        <Parse-Const-Decls>;
     158      s.type :
     159        \{
     160          FUNC;
     161          FUNC?;
     162        } = <Parse-Func-Decl s.type>;
     163      s.type : WORD =
     164//<WriteLN e.pos e.value>,
     165//          (FUNCDEF <To-Word <Module-Name> '.' e.value> <Parse-Func-Def>) ;
     166          <Parse-Func-Def (e.pos) (s.type e.value)>;
     167      # \{ s.type : EOF; } ;
     168    } :: e.items = e.items <Parse-Body>;
     169  // If there are no tokens return
     170  ;
    70171};
    71172
    72173Parse-Const-Expr
     174  = <Expect-Token REF SYMBOLS NUMBER WORD LPAREN EMPTY>
     175    :: (e.pos) (s.type e.value),
     176    {
     177      s.type : EMPTY = ;
     178      <Parse-Const-Term (e.pos) (s.type e.value)> <Parse-Const-Expr>;
     179    };
     180
     181Parse-Const-Term (e.pos) (s.type e.value) =
     182  s.type :
     183  {
     184    REF = <Parse-Ref>;
     185    SYMBOLS = e.value;
     186    NUMBER = e.value;
     187    WORD = <To-Word e.value>;
     188    LPAREN = <Parse-Const-Expr> :: e.expr,
     189      <Expect-Token RPAREN> : e, (PAREN e.expr);
     190  };
     191
     192Parse-Object-Decls s.type =
    73193{
    74   v.tokens = <Parse-Const-Term v.tokens> :: (e.term) (e.rest),
    75     {
    76       e.term : = () (e.rest) ;
    77       <Parse-Const-Expr e.rest> :: (e.expr) (e.rest),
    78         (e.term e.expr) (e.rest);
     194  <Expect-Token WORD SEMICOLON> :
     195    {
     196      (e) (SEMICOLON) = ;
     197      (e.pos) (WORD e.name) = e.pos :
     198        {
     199          s S s s = LOCAL (<Module-Name>);
     200          s.idx e = {
     201            <RFP-Module-Name <Lookup &RFP-Sources s.idx>>
     202              :: e.module,
     203              <"/=" (e.module) (<Module-Name>)>, IMPORT (e.module);
     204            EXPORT (<Module-Name>);
     205          };
     206        } :: s.linkage (e.module),
     207        e.module '.' e.name :: e.name,
     208        <Bind &Names (e.name) (s.type)>,
     209        (s.linkage s.type <To-Word e.name>)
     210        <Parse-Object-Decls s.type>;
    79211    };
    80212};
    81213
    82 Parse-Const-Term
    83 {
    84   ((e.pos) (REF)) ((e) (WORD e.name)) e.rest =
    85     {
    86       <Lookup-Name (e.pos) (e.name)> :: e.name =
    87         <Lookup &Names e.name> :: e.nameinfo =
    88           {
    89             e.nameinfo : CONST e.expr = (e.expr) (e.rest);
    90             ((REF <To-Word e.name>)) (e.rest);
    91           };
    92       <RFP-Error (e.pos) ("Undefined name \'" e.name"\'" )>,
    93         ((REF <To-Word e.name>)) (e.rest);
    94     };
    95   ((e) (SYMBOLS e.symbols)) e.rest = (e.symbols) (e.rest);
    96   ((e) (LPAREN)) e.rest = <Parse-Const-Expr e.rest> :: (e.expr) (e.rest),
    97     e.rest :
     214Parse-Const-Decls
     215  = <Expect-Token WORD SEMICOLON COMMA> :: (e.pos) (s.type e.value),
     216    s.type :
    98217      {
    99         ((e) (RPAREN)) e.rest2 = ((PAREN e.expr)) (e.rest2);
    100         ((e.pos) (e)) e = <RFP-Error (e.pos) ("\')\' expected")>,
    101           ((PAREN e.expr)) (e.rest);
     218        WORD = e.pos : s.idx e,
     219          <Parse-Const-Decl <Full-Name s.idx (e.value)>>;
     220        SEMICOLON = ;
     221        COMMA = <Parse-Const-Decls> ;
    102222      };
    103   e.rest = () (e.rest) ;
    104 };
    105 
    106 Parse-Object-Decls s.type (e.tokens) =
    107   {
    108     e.tokens : t.token e.rest = t.token :
    109       {
    110         ((e) (SEMICOLON)) = <Parse-Body e.rest> ;
    111         ((e.pos) (WORD e.name)) = e.pos :
    112           {
    113             s S s s = LOCAL (<Module-Name>);
    114             s.idx e = {
    115               <RFP-Module-Name <Lookup &RFP-Sources s.idx>>
    116                 :: e.module,
    117                 <"/=" (e.module) (<Module-Name>)>, IMPORT (e.module);
    118               EXPORT (<Module-Name>);
    119             };
    120           } :: s.linkage (e.module),
    121           e.module '.' e.name :: e.name,
    122           <Bind &Names (e.name) (s.type)>,
    123           (s.linkage s.type <To-Word e.name>)
    124           <Parse-Object-Decls s.type (e.rest)>;
    125         ((e.pos) (EOF)) =
    126           <RFP-Error
    127             (e.pos) ("Unexpected end of file during object declaration")>;
    128         ((e.pos) (e)) =
    129           <RFP-Error (e.pos) ("Unterminated declaration - \';\' expected")>,
    130           <Parse-Body e.tokens>;
    131       };
    132   };
    133 
    134 Parse-Const-Decls e.tokens, e.tokens : t.token e.rest = t.token :
    135   {
    136     ((e) (SEMICOLON)) = <Parse-Body e.rest> ;
    137     ((s.idx e) (WORD e.name)) =
    138       <Parse-Const-Decl (<Full-Name s.idx (e.name)>) (e.rest)>;
    139     ((e.pos) (EOF)) =
    140       <RFP-Error
    141         (e.pos) ("Unexpected end of file during constant declaration")>;
    142     ((e.pos) (e)) =
    143       <RFP-Error (e.pos) ("Unterminated declaration - \';\' expected")>,
    144       <Parse-Body e.tokens>;
    145   };
    146 
    147 Parse-Const-Decl (e.name) (e.tokens), e.tokens : t.token e.rest = t.token :
    148   {
    149     ((e) (EQUAL)) = e.rest : t.token2 e.rest2,
    150       {
    151         t.token2 : ((e.pos) (EOF)) =
    152           <RFP-Error
    153             (e.pos) ("Unexpected end of file during constant declaration")>;
    154         <Parse-Const-Expr e.rest> :: (e.expr) (e.rest),
    155         <Bind &Names (e.name) (CONST e.expr)>,
    156 (CONST <To-Word e.name> e.expr)
    157           <Parse-Const-Decls e.rest>;
    158       };
    159     ((e.pos) (EOF)) =
    160       <RFP-Error
    161         (e.pos) ("Unexpected end of file during constant declaration")>;
    162     ((e.pos) (e)) =
    163       <RFP-Error (e.pos) ("\'=\' expected")>,
    164       <Parse-Const-Decls e.tokens>;
    165   };
     223
     224Parse-Const-Decl e.name =
     225  <Expect-Token EQUAL> : e,
     226  <Parse-Const-Expr> :: e.expr,
     227  <Bind &Names (e.name) (CONST e.expr)>,
     228  (CONST <To-Word e.name> e.expr) <Parse-Const-Decls>;
    166229
    167230Full-Name s.idx (e.name) =
     
    170233Lookup-Name (e.pos) (e.name) =
    171234  <Domain &Names> :
    172     {
     235    \{
    173236      e (e.name) e.rest = (e.name) (e.rest);
    174237      e (e.module '.' e.name) e.rest =
     
    192255  };
    193256
     257Parse-Func-Decl // s.type = e.items
     258  s.type =
     259    <Expect-Token WORD> :: (e.pos) (s e.name),
     260      e.pos :
     261        {
     262          s S s s = LOCAL (<Module-Name>);
     263          s.idx e = {
     264            <RFP-Module-Name <Lookup &RFP-Sources s.idx>> :: e.module,
     265              <"/=" (e.module) (<Module-Name>)>, IMPORT (e.module);
     266            EXPORT (<Module-Name>);
     267          };
     268        } :: s.linkage (e.module),
     269          e.module '.' e.name :: e.name,
     270      <Parse-Format> :: e.in,
     271      <Expect-Token EQUAL> : e,
     272      <Parse-Format> :: e.out,
     273      <Expect-Token SEMICOLON> : e,
     274      <Bind &Names (e.name) (s.type s.linkage (e.in) (e.out))>,
     275      (s.linkage s.type <To-Word e.name> (e.in) (e.out));
     276
     277Parse-Format // [] = e.format
     278  = <Parse-Format-Terms> :: e.terms,
     279    <Expect-Token EVAR VVAR EMPTY> :: (e.pos) (s.type e.value),
     280    {
     281      s.type : EMPTY = ;
     282      (s.type);
     283    } :: e.var,
     284    e.terms e.var <Parse-Format-Terms>;
     285
     286Parse-Format-Terms // [] = e.terms
     287  = <Expect-Token LPAREN SYMBOLS NUMBER WORD SVAR TVAR EMPTY>
     288    :: (e.pos) (s.type e.value),
     289    {
     290      s.type : EMPTY = ;
     291      s.type : {
     292        LPAREN = (PAREN <Parse-Format>) :: e.hexpr,
     293          <Expect-Token RPAREN> : e, e.hexpr;
     294        SYMBOLS = e.value;
     295        NUMBER = e.value;
     296        WORD = <To-Word e.value>;
     297        s = (s.type);
     298      } :: e.term, e.term <Parse-Format-Terms>;
     299    };
     300
     301Parse-Hard-Expr // [] = e.format
     302  =
     303//<WriteLN Parse-Hard-Expr>,
     304    <Parse-Hard-Expr-Terms> :: e.terms,
     305    <Expect-Token EVAR VVAR EMPTY> :: (e.pos) (s.type e.value),
     306    {
     307      s.type : EMPTY = ;
     308      (s.type e.value);
     309    } :: e.var,
     310    e.terms e.var <Parse-Hard-Expr-Terms>;
     311
     312Parse-Hard-Expr-Terms // [] = e.terms
     313  =
     314//<WriteLN Parse-Hard-Expr-Terms>,
     315    <Expect-Token LPAREN SYMBOLS NUMBER WORD SVAR TVAR EMPTY>
     316    :: (e.pos) (s.type e.value),
     317    {
     318      s.type : EMPTY = ;
     319      s.type : {
     320        LPAREN = (PAREN <Parse-Hard-Expr>) :: e.hexpr,
     321          <Expect-Token RPAREN> : e, e.hexpr;
     322        SYMBOLS = e.value;
     323        NUMBER = e.value;
     324        WORD = <To-Word e.value>;
     325        s = (s.type e.value);
     326      } :: e.term, e.term <Parse-Hard-Expr-Terms>;
     327    };
     328
     329Parse-Func-Def // (e.pos) (s.type e.value) = e.items
     330  (e.pos) (s.type e.value) =
     331//<WriteLN Parse-Func-Def>,
     332    <Parse-Alt> :: e.items,
     333    <Expect-Token SEMICOLON> : e,
     334//<WriteLN "<-"Parse-Func-Def>,
     335    {
     336      <Lookup-Name (e.pos) (e.value)> :: e.name =
     337//<WriteLN <Domain &Names>>,
     338        <Lookup &Names e.name> :: e.nameinfo =
     339//<WriteLN e.nameinfo>,
     340          {
     341            e.nameinfo : FUNC s.linkage t.in t.out =
     342              e.name s.linkage t.in t.out;
     343            e.nameinfo : FUNC? s.linkage t.in t.out =
     344              e.name s.linkage t.in t.out;
     345            <RFP-Error (e.pos) ("\'" e.value "\' is not a function")>,
     346              e.name LOCAL () ();
     347          };
     348      e.value : 'Main' =
     349        <To-Word <Module-Name> '.' e.value> EXPORT () ();
     350      <RFP-Error (e.pos) ("Undefined name \'" e.value "\'" )>,
     351        e.value LOCAL () ();
     352    } :: e.name s.linkage t.in t.out,
     353    (s.linkage FUNCDEF <To-Word e.name> t.in t.out e.items);
     354
     355Parse-Alt // [] = e.items
     356  =
     357//<WriteLN Parse-Alt>,
     358    <Expect-Token LBRACE TLBRACE EMPTY> :: (e.pos) (s.type e.value),
     359    {
     360      s.type : EMPTY = <Parse-Sentence>;
     361      $iter
     362        {
     363          e.items (BRANCH <Parse-Sentence>) :: e.items,
     364          <Expect-Token SEMICOLON> : e, e.items;
     365        } :: e.items,
     366          <Expect-Token RBRACE EMPTY> : (e) (RBRACE e),
     367          {
     368            s.type : LBRACE = NOFAIL (BLOCK e.items);
     369            (BLOCK e.items);
     370          };
     371    };
     372
     373Parse-Sentence // [] = e.items
     374  =
     375//<WriteLN Parse-Sentence>,
     376    <Parse-Pattern> :: e.pattern,
     377    <Parse-Tail> :: e.tail,
     378    e.pattern e.tail;
     379
     380Tail? // [] = []
     381  = <Expect-Token COMMA NOT STAKE CUT FAIL EQUAL ERROR TRAP EMPTY> ::
     382    (e.pos) (s.type e.value),
     383    \{
     384      s.type : EMPTY = $fail;
     385      <Unget-Token (e.pos) (s.type e.value)>;
     386    };
     387
     388Parse-Tail // [] = e.items
     389  =
     390//<WriteLN Parse-Tail>,
     391    <Expect-Token COMMA NOT STAKE CUT FAIL EQUAL ERROR TRAP EMPTY> ::
     392      (e.pos) (s.type e.value),
     393    s.type :
     394      {
     395        COMMA = <Parse-Path>;
     396        NOT = <Parse-Source> <Parse-Tail>;
     397        CUT = CUT <Parse-Path>;
     398        FAIL = FAIL;
     399        EQUAL = <Parse-Path>;
     400        ERROR = ERROR <Parse-Path>;
     401        TRAP = <Parse-Path> :: e.try,
     402          <Expect-Token WITH> : e,
     403          (TRY e.try <Parse-Alt>);
     404        EMPTY = ;
     405      };
     406
     407Parse-Path // [] = e.item
     408  =
     409//<WriteLN Parse-Path>,
     410  {
     411    <Tail?>, <Parse-Tail>;
     412    <Parse-Source> :: e.source,
     413      {
     414        <Tail?>, <Parse-Tail>;
     415        <Expect-Token DCOLON ITER COLON EMPTY> :: (e) (s.type e),
     416          s.type : {
     417            DCOLON = <Parse-Hard-Expr> <Parse-Tail>;
     418            ITER = <Parse-Source> :: e.body,
     419              <Expect-Token DCOLON> : e,
     420              (ITER e.body <Parse-Hard-Expr> <Parse-Tail>);
     421            COLON = <Parse-Sentence>;
     422            EMPTY = ;
     423          };
     424      } :: e.items,
     425      e.source e.items;
     426  };
     427
     428Parse-Source // [] = e.item
     429  =
     430//<WriteLN Parse-Source>,
     431    <Expect-Token LBRACE TLBRACE EMPTY> :: (e) (s.type e),
     432    {
     433      s.type :
     434        \{
     435          LBRACE;
     436          TLBRACE;
     437        } =
     438          $iter
     439            {
     440              e.items (BRANCH <Parse-Path>) :: e.items,
     441              <Expect-Token SEMICOLON> : e, e.items;
     442            } :: e.items,
     443              <Expect-Token RBRACE EMPTY> : (e) (RBRACE e),
     444              {
     445                s.type : LBRACE = NOFAIL (BLOCK e.items);
     446                (BLOCK e.items);
     447              };
     448      <Parse-Result>;
     449    } :: e.items,
     450      <Expect-Token COLON EMPTY> :: (e) (s.type e),
     451        {
     452          s.type : COLON = e.items <Parse-Alt>;
     453          e.items;
     454        };
     455
     456Parse-Result // [] = e.items
     457  =
     458//<WriteLN Parse-Result>,
     459  {
     460    <Parse-Result-Term> : v.term =
     461      v.term <Parse-Result>;
     462    ;
     463  };
     464
     465Parse-Result-Term // [] = e.items
     466  =
     467//<WriteLN Parse-Result-Term>,
     468    <Expect-Token SYMBOLS NUMBER WORD REF LPAREN
     469      EVAR VVAR TVAR SVAR LBRACKET EMPTY>
     470    :: (e.pos) (s.type e.value),
     471    {
     472      s.type : EMPTY = ;
     473      s.type : SYMBOLS = e.value;
     474      s.type : NUMBER = e.value;
     475      s.type : WORD = <To-Word e.value>;
     476      s.type : REF = <Parse-Ref>;
     477      s.type : LPAREN =
     478        <Parse-Result> :: e.items,
     479        <Expect-Token RPAREN> : e, (PAREN e.items);
     480      s.type :
     481        \{
     482          EVAR;
     483          VVAR;
     484          TVAR;
     485          SVAR;
     486        } = (s.type e.value);
     487      s.type : LBRACKET =
     488        <Expect-Token WORD> :: (e.pos) (s.type e.value),
     489        {
     490          <Lookup-Name (e.pos) (e.value)> :: e.name =
     491            <Lookup &Names e.name> :: e.nameinfo =
     492              {
     493                e.nameinfo :
     494                  \{
     495                    FUNC e;
     496                    FUNC? e;
     497                  } = e.name;
     498                <RFP-Error (e.pos) ("\'" e.value "\' is not a function")>,
     499                  e.name;
     500              };
     501          <RFP-Error (e.pos) ("Undefined name \'" e.value "\'" )>,
     502            e.value;
     503        } :: e.name,
     504        (CALL <To-Word e.name> <Parse-Result>) :: e.items,
     505        <Expect-Token RBRACKET> : e, e.items;
     506    };
     507
     508Parse-Pattern // [] = e.items
     509  =
     510//<WriteLN Parse-Pattern>,
     511    <Expect-Token LEFT RIGHT EMPTY> : (e) (s.type e),
     512      {
     513        s.type : RIGHT = (RIGHT <Parse-Pattern-Expr>);
     514        (LEFT <Parse-Pattern-Expr>);
     515      };
     516
     517Parse-Pattern-Expr // [] = e.items
     518  =
     519//<WriteLN Parse-Pattern-Expr>,
     520  {
     521    <Parse-Pattern-Term> : v.term =
     522      v.term <Parse-Pattern-Expr>;
     523    ;
     524  };
     525
     526Parse-Pattern-Term // [] = e.items
     527  =
     528//<WriteLN Parse-Pattern-Term>,
     529    <Expect-Token SYMBOLS NUMBER WORD REF LPAREN EVAR VVAR TVAR SVAR EMPTY>
     530    :: (e.pos) (s.type e.value),
     531    {
     532      s.type : EMPTY = ;
     533      s.type : SYMBOLS = e.value;
     534      s.type : NUMBER = e.value;
     535      s.type : WORD = <To-Word e.value>;
     536      s.type : REF = <Parse-Ref>;
     537      s.type : LPAREN =
     538        <Parse-Pattern-Expr> :: e.items,
     539        <Expect-Token RPAREN> : e, (PAREN e.items);
     540      s.type :
     541        \{
     542          EVAR;
     543          VVAR;
     544          TVAR;
     545          SVAR;
     546        } = (s.type e.value);
     547    };
     548
     549Parse-Ref // [] = e.items
     550  = <Expect-Token WORD> :: (e.pos) (s.type e.value),
     551    {
     552      <Lookup-Name (e.pos) (e.value)> :: e.name =
     553        <Lookup &Names e.name> :: e.nameinfo =
     554          {
     555            e.nameinfo : CONST e.expr = e.expr;
     556            (REF <To-Word e.name>);
     557          };
     558      <RFP-Error (e.pos) ("Undefined name \'" e.value"\'" )>,
     559        (REF <To-Word e.value>);
     560    };
  • /to-imperative/trunk/compiler/rfp_parse.rfi

    r20 r30  
     1//
     2// Copyright (C) 1999, 2000 Refal+ Development Group
     3//
     4// Refal+ is free software; you can redistribute it and/or modify
     5// it under the terms of the GNU General Public License as published by
     6// the Free Software Foundation; either version 2 of the License, or
     7// (at your option) any later version.
     8//
     9// Refal+ is distributed in the hope that it will be useful,
     10// but WITHOUT ANY WARRANTY; without even the implied warranty of
     11// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     12// GNU General Public License for more details.
     13//
     14// You should have received a copy of the GNU General Public License
     15// along with Refal+; if not, write to the Free Software
     16// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
     17//
     18// $Source$
     19// $Revision$
     20// $Date$
     21// Author: Andrey Slepuhin <pooh@msu.ru>
     22
    123$func RFP-Parser e.tokens = t.as ;
  • /to-imperative/trunk/compiler/rfp_src.rf

    r20 r30  
    1616// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    1717//
    18 // $Version: $
     18// $Source$
     19// $Revision$
     20// $Date$
    1921// Author: Andrey Slepuhin <pooh@msu.ru>
    2022
  • /to-imperative/trunk/compiler/rfp_src.rfi

    r20 r30  
     1//
     2// Copyright (C) 1999, 2000 Refal+ Development Group
     3//
     4// Refal+ is free software; you can redistribute it and/or modify
     5// it under the terms of the GNU General Public License as published by
     6// the Free Software Foundation; either version 2 of the License, or
     7// (at your option) any later version.
     8//
     9// Refal+ is distributed in the hope that it will be useful,
     10// but WITHOUT ANY WARRANTY; without even the implied warranty of
     11// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     12// GNU General Public License for more details.
     13//
     14// You should have received a copy of the GNU General Public License
     15// along with Refal+; if not, write to the Free Software
     16// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
     17//
     18// $Source$
     19// $Revision$
     20// $Date$
     21// Author: Andrey Slepuhin <pooh@msu.ru>
     22
    123$func? RFP-Src-Open-File e.filename = e.source ;
    224$func? RFP-Src-Open-StdIN = e.source ;
  • /to-imperative/trunk/compiler/rfpc.rf

    r20 r30  
    1616// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    1717//
    18 // $Version: $
     18// $Source$
     19// $Revision$
     20// $Date$
    1921// Author: Andrey Slepuhin <pooh@msu.ru>
    2022
     
    4547//            <RFP-Pretty-Print () e.tokens>,
    4648//            <WriteLN e.tokens>,
     49            <Store &RFP-Token-Stack e.tokens>,
    4750            <RFP-Parser e.tokens> :: t.as,
    4851            <RFP-Pretty-Print () t.as>;
  • /to-imperative/trunk/compiler/rfpc.rfi

    r20 r30  
     1//
     2// Copyright (C) 1999, 2000 Refal+ Development Group
     3//
     4// Refal+ is free software; you can redistribute it and/or modify
     5// it under the terms of the GNU General Public License as published by
     6// the Free Software Foundation; either version 2 of the License, or
     7// (at your option) any later version.
     8//
     9// Refal+ is distributed in the hope that it will be useful,
     10// but WITHOUT ANY WARRANTY; without even the implied warranty of
     11// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     12// GNU General Public License for more details.
     13//
     14// You should have received a copy of the GNU General Public License
     15// along with Refal+; if not, write to the Free Software
     16// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
     17//
     18// $Source$
     19// $Revision$
     20// $Date$
     21// Author: Andrey Slepuhin <pooh@msu.ru>
     22
    123$const RFP-Dir-Separator = '/' ;
    224$const RFP-Root = '/usr' ;
    325$const RFP-Default-Include-Path = (&RFP-Root'/include/refal-plus') ;
    426$box RFP-Include-Path ;
     27$box RFP-Token-Stack ;
    528
    629$func Main = e ;
  • /to-imperative/trunk/configure

    r20 r30  
    11#!/bin/sh
     2
     3package=rfpc
     4version_major=0
     5version_minor=0
     6version_micro=0
     7version=$version_major.$version_minor.$version_micro
     8
     9install_dir=/usr/local
     10
     11help () {
     12  cat <<EOF
     13Usage: configure [options]
     14
     15Possible options are:
     16  -prefix <dir>         install directory (default /usr/local)
     17  -name                 shows package name
     18  -version              shows package version
     19EOF
     20  exit 1
     21}
     22
     23while true; do
     24  if [ -z "$1" ]; then break; fi
     25  case $1 in
     26  -prefix)
     27    shift
     28    if [ -z "$1" ]; then help; fi
     29    install_dir="$1"
     30    ;;
     31  -name)
     32    echo $package
     33    exit 0
     34    ;;
     35  -version)
     36    echo $version
     37    exit 0
     38    ;;
     39  -help|*)
     40    help
     41    ;;
     42  esac
     43  shift
     44done
     45
     46. ./config.functions
     47
     48config_mk=config.mk
     49subdirs_mk=subdirs.mk
     50
     51if [ -e "$config_mk" ] ; then
     52  rm $config_mk
     53fi
     54
     55if [ -e "$subdirs_mk" ] ; then
     56  rm $subdirs_mk
     57fi
     58
     59if [ -z "$RFP" ]; then RFP="rfp" ; fi
     60if [ -z "$RFPC" ]; then RFPC="rfpc" ; fi
     61
     62echon "Checking for working Refal+ compiler... "
     63cat <<EOF >cfgtest.rf
     64Main = ;
     65EOF
     66if $RFP -o cfgtest cfgtest.rf >/dev/null 2>&1; then
     67  echo "found"
     68  rm -f cfgtest cfgtest.rf
     69else
     70  echo "not found"
     71  rm -f cfgtest cfgtest.rf
     72  exit 1
     73fi
     74 
     75cat >>$config_mk <<EOF
     76RFP=$RFP
     77RFPC=$RFPC
     78EOF
     79
     80cat >>$subdirs_mk <<EOF
     81SUBDIRS+=src
     82EOF
     83
  • /to-imperative/trunk/rules.mk

    r20 r30  
    1818
    1919%.o: %.rf
    20         $(RFPC) -c $@ $<
     20        $(RFPC) $<
    2121
    2222%.o: %.c
Note: See TracChangeset for help on using the changeset viewer.