home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume1 / 8708 / 33 < prev    next >
Encoding:
Internet Message Format  |  1990-07-13  |  43.0 KB
  1. From: dietz@zhmti.UUCP (Dieter H. Zebbedies)
  2. Newsgroups: comp.sources.misc
  3. Subject: "Producer" translates Smalltalk to Objective-C (Part 4 of 5)
  4. Message-ID: <4220@ncoast.UUCP>
  5. Date: 20 Aug 87 01:57:37 GMT
  6. Sender: allbery@ncoast.UUCP
  7. Organization: Zebb-Hoff Machine Tool Inc's Automated Mfg. Project, Cleve., OH
  8. Lines: 1474
  9. Approved: allbery@ncoast.UUCP
  10. X-Archive: comp.sources.misc/8708/33
  11.  
  12. "Producer", A package to translate Smalltalk-80 code to your favorite
  13. object oriented language, Objective-C.
  14.  
  15. #!/bin/sh
  16. # to extract, remove the header and type "sh filename"
  17. if `test ! -d ./src`
  18. then
  19.   mkdir ./src
  20.   echo "mkdir ./src"
  21. fi
  22. if `test ! -s ./src/Substrate.h`
  23. then
  24. echo "writting ./src/Substrate.h"
  25. cat > ./src/Substrate.h << '\Rogue\Monster\'
  26. /*{^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  27. Substrate.h: Extensions to the Objective-C Primitive and Collection substrate
  28.     The macros hide nonPortable `features' of some C compilers (e.g. VMS).
  29. ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^}*/
  30. #ifndef SUBSTRATE_H
  31. #define SUBSTRATE_H
  32. #    include "objc.h"
  33. #    include "assert.h"
  34. #    undef CATEGORIES
  35. #    define CATEGORIES() (Substrate, Primitive)
  36.  
  37. /*{ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  38. Stylistic Conventions
  39.     The IMPORT/EXPORT convention (EXPORT int foo=aValue to export foo,
  40.     IMPORT int foo to import it) is used instead of of the usual C 
  41.     conventions (int foo=aValue to export foo and extern int foo to 
  42.     import it) to provides a distinctive marker on each global declaration
  43.     that string search tools key off of to find all global declarations 
  44.     reliably. The convention also provides a convenient way to overcome
  45.     deficiencies in some C compilers; notably VMS C.
  46. ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ }*/
  47. #    define LOCAL static
  48. #    define USE @requires
  49. #ifdef VMS
  50. #    define IMPORT globalref
  51. #    define EXPORT globaldef
  52. #else
  53. #    define IMPORT extern
  54. #    define EXPORT /*export*/
  55. #endif
  56. // Obsolete
  57. #    define FACTORY USE
  58.  
  59. /*{ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  60. Renaming
  61.     Translate all occurrences of external names that appear in the Primitive
  62.     or Collection categories to new names defined in the Substrate category.
  63. ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ }*/
  64. #define OrderedCollection OrdCltn
  65.  
  66. /*{ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  67. Bit banging macros
  68. ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ }*/
  69. #    define RBIT(bits, mask)    (bits &= ~mask)
  70. #    define SBIT(bits, mask)    (bits |=  mask)
  71. #    define TBIT(bits, mask) (bits &   mask)
  72.  
  73.     typedef int *WORD;            /* Amorphous typed machine word */
  74.     typedef unsigned int WRD;    /* amorphous type; `word' */
  75.     typedef char BYTE;
  76.     unsigned _strhash();
  77.     IMPORT void put();
  78. #endif
  79. \Rogue\Monster\
  80. else
  81.   echo "will not over write ./src/Substrate.h"
  82. fi
  83. if `test ! -s ./src/AbstractTranslation.m`
  84. then
  85. echo "writting ./src/AbstractTranslation.m"
  86. cat > ./src/AbstractTranslation.m << '\Rogue\Monster\'
  87. #include "Producer.h"
  88. = AbstractTranslation : Object CATEGORIES()
  89.     { id type; }
  90. + type:aType 
  91.     { return [[self new] type:aType]; }
  92. - type 
  93.     { return type; }
  94. - type:aType
  95.     { type = aType; return self; }
  96. - (STR)str
  97.     { return (STR)[self subclassResponsibility]; }
  98. - asTypedByteArray
  99.     { return (id)[self subclassResponsibility]; }
  100. - assignTypesTo:aSelector {
  101.     id s = [aSelector asByteArray];
  102.     info("%s ignoring type assignment of %s\n", NAMEOF(self), [s str]);
  103.     [s free]; return self;
  104. }
  105. \Rogue\Monster\
  106. else
  107.   echo "will not over write ./src/AbstractTranslation.m"
  108. fi
  109. if `test ! -s ./src/ArgumentList.m`
  110. then
  111. echo "writting ./src/ArgumentList.m"
  112. cat > ./src/ArgumentList.m << '\Rogue\Monster\'
  113. #include "Producer.h"
  114. = ArgumentList:Node CATEGORIES()
  115.     { id argumentType, argumentName; }
  116. + type:aType name:aName {
  117.     self = [super new];
  118.     argumentType = aType;
  119.     argumentName = aName;
  120.     return self;
  121. }
  122. - argumentType
  123.     { return argumentType; }
  124. - argumentName
  125.     { return argumentName; }
  126. \Rogue\Monster\
  127. else
  128.   echo "will not over write ./src/ArgumentList.m"
  129. fi
  130. if `test ! -s ./src/Block.m`
  131. then
  132. echo "writting ./src/Block.m"
  133. cat > ./src/Block.m << '\Rogue\Monster\'
  134. #include "Producer.h"
  135.     IMPORT id symbolScope;
  136.     USE Set;
  137. = Block:Node CATEGORIES() { id blockVariables, statements; }
  138. + statements:aStatementList 
  139.     { return [[self new] statements:aStatementList]; }
  140. - variables:aVarList { 
  141.     if (!aVarList || [aVarList isEmpty]) return self;
  142.     [aVarList addContentsTo:blockVariables = [Set new]];
  143.     [symbolScope add:blockVariables];
  144.     return self; 
  145. }
  146. - statements:aStatementList 
  147.     { statements = aStatementList; return self; }
  148.  
  149. - gen { BOOL needsCompound = blockVariables || [statements size] > 1;
  150.     if (needsCompound) gc('{'/*}*/);
  151. #ifndef COXLIB
  152.     [blockVariables elementsPerform:@selector(genDeclaration)];
  153. #else
  154.     [blockVariables eachElementPerform:@selector(genDeclaration)];
  155. #endif
  156.     [statements genExpr];
  157.     if (needsCompound) gc(/*{*/'}');
  158.     return self; 
  159. }
  160. - free { 
  161.     [symbolScope remove:blockVariables];
  162.     [blockVariables freeContents]; [blockVariables free];
  163.     [statements free];
  164.     return [super free];
  165. }
  166. - type 
  167.     { [statements type]; return types.BLOCK; }
  168. \Rogue\Monster\
  169. else
  170.   echo "will not over write ./src/Block.m"
  171. fi
  172. if `test ! -s ./src/CharConstant.m`
  173. then
  174. echo "writting ./src/CharConstant.m"
  175. cat > ./src/CharConstant.m << '\Rogue\Monster\'
  176. #include "Producer.h"
  177. = CharConstant : Constant CATEGORIES() {}
  178. - type
  179.     { return types.CHAR; }
  180. - gen
  181.     { gf("'%s'", [self str]); return self; }
  182. \Rogue\Monster\
  183. else
  184.   echo "will not over write ./src/CharConstant.m"
  185. fi
  186. if `test ! -s ./src/Class.m`
  187. then
  188. echo "writting ./src/Class.m"
  189. cat > ./src/Class.m << '\Rogue\Monster\'
  190. #include "Producer.h"
  191.     BOOL autoFileFlag;
  192.     USE OrderedCollection, Identifier;
  193.     IMPORT id symbolScope;
  194.     IMPORT STR index();
  195.     IMPORT id findSymbol();
  196. = Class:Object CATEGORIES() {
  197.     id name, superclass, instanceVariables, classVariables, pdn, category;
  198.     id instanceVariableScope, classVariableScope;
  199. }
  200. + name:aClass { self = [super new]; name = aClass; 
  201.     if (autoFileFlag) { char buf[80];
  202.         sprintf(buf, "%s.m", [name str]);
  203.         genOpen(buf);
  204.     }
  205.     return self; 
  206. }
  207. - superclass:aClass { superclass = aClass; return self; }
  208. - instanceVariableNames:aString { STR s = [aString str], end;
  209.     if (!instanceVariables) instanceVariables = [OrderedCollection new];
  210.     if (*s == '\'') s++;
  211.     while(end = index(s, ' ')) { 
  212.         while(*end == ' ') *end++ = 0;
  213.         [instanceVariables add:findSymbol([Identifier str:s])];
  214.         s = end;
  215.     }
  216.     if (end = index(s, '\'')) { *end = 0;
  217.         [instanceVariables add:findSymbol([Identifier str:s])];
  218.     }
  219.     [symbolScope add:instanceVariableScope=[instanceVariables asSet]];
  220.     return self; 
  221. }
  222. - classVariableNames:aString { STR s = [aString str], end;
  223.     if (!classVariables) classVariables = [OrderedCollection new];
  224.     if (*s == '\'') s++;
  225.     while(end = index(s, ' ')) { 
  226.         while(*end == ' ') *end++ = 0;
  227.         [classVariables add:findSymbol([Identifier str:s])];
  228.         s = end;
  229.     }
  230.     if (end = index(s, '\'')) { *end = 0;
  231.         [instanceVariables add:findSymbol([Identifier str:s])];
  232.     }
  233.     [symbolScope add:classVariableScope=[classVariables asSet]];
  234.     return self; 
  235. }
  236. - poolDictionaries:aString { pdn = aString; return self; }
  237. - category:aString { category = aString; return self; }
  238. - gen { STR start, end, index(); 
  239.     gn(); gs("#include \"st80.h\"\n");
  240.     gs("= "); [name gen]; gc(':'); [superclass gen]; gs(" CATEGORIES()");
  241.     gc('{'/*}*/);
  242. #ifndef COXLIB
  243.     [instanceVariables elementsPerform:@selector(genDeclaration)];
  244.     gc(/*{*/'}');
  245.     if (classVariables) 
  246.         [classVariables elementsPerform:@selector(genDeclaration)];
  247. #else
  248.     [instanceVariables eachElementPerform:@selector(genDeclaration)];
  249.     gc(/*{*/'}');
  250.     if (classVariables) 
  251.         [classVariables eachElementPerform:@selector(genDeclaration)];
  252. #endif
  253.     return self;
  254. }
  255. - free {
  256.     [symbolScope remove:instanceVariableScope];
  257.     [symbolScope remove:classVariableScope];
  258.     [classVariables freeContents]; [instanceVariables freeContents];
  259.     [classVariables free]; [instanceVariables free];
  260.     [name free];
  261.     [superclass free];
  262.     [pdn free];
  263.     [category free];
  264.     return [super free];
  265. }
  266. \Rogue\Monster\
  267. else
  268.   echo "will not over write ./src/Class.m"
  269. fi
  270. if `test ! -s ./src/Comment.m`
  271. then
  272. echo "writting ./src/Comment.m"
  273. cat > ./src/Comment.m << '\Rogue\Monster\'
  274. #include "Producer.h"
  275.     static id head = nil, tail = nil;
  276.     BOOL stripCommentsFlag = YES;
  277. = Comment:Node CATEGORIES() { STR text; }
  278. + str:(STR)aString { 
  279.     if (!aString) return nil;
  280.     self = [super new]; text = (STR)strCopy(aString);
  281.     if (head == nil) head = self; else tail->successor = self;
  282.     return tail = self;
  283. }
  284. + gen { genReset(); [head gen];
  285.     [head free]; head = tail = nil;
  286.     return self; 
  287. }
  288. + free 
  289.     { if (head) [head free]; head = tail = nil; return self; }
  290. - (STR)str 
  291.     { return text; }
  292. - free 
  293.     { free(text); return [super free]; }
  294. - gen { 
  295.     if (!stripCommentsFlag) { gf("// %s", text); [successor gen]; }
  296.     return self; 
  297. }
  298. \Rogue\Monster\
  299. else
  300.   echo "will not over write ./src/Comment.m"
  301. fi
  302. if `test ! -s ./src/Constant.m`
  303. then
  304. echo "writting ./src/Constant.m"
  305. cat > ./src/Constant.m << '\Rogue\Monster\'
  306. #include "Producer.h"
  307. = Constant:Symbol CATEGORIES()
  308. - gen 
  309.     { gs([self str]); return self; }
  310. - type
  311.     { return [self subclassResponsibility]; }
  312. - asByteArray
  313.     { return self; }
  314. \Rogue\Monster\
  315. else
  316.   echo "will not over write ./src/Constant.m"
  317. fi
  318. if `test ! -s ./src/Expr.m`
  319. then
  320. echo "writting ./src/Expr.m"
  321. cat > ./src/Expr.m << '\Rogue\Monster\'
  322. // Expressions: a source (a message or primary) for a value and a list of 
  323. //    targets (variables) to assign values to. Cascaded message expressions 
  324. //    are handled by linking expressions through their successor fields.
  325. //
  326. // Rewrites cascaded expressions like 
  327. //        Foo new bar gag extent:hack; bletch.
  328. //    as 
  329. //        cascadeReceiver = [[[Foo new] bar] gag].
  330. //        [cascadeReceiver extent:hack];
  331. //        [cascadeReceiver ...
  332. #include "Producer.h"
  333.     IMPORT id temporaryVariablePool;
  334.     USE Msg, List, Identifier;
  335. = Expr:Node CATEGORIES() {
  336.     id assignmentList;
  337.     id value;
  338. }
  339. + assign:anAssignmentList value:aValue 
  340.     { return [[[super new] assign:anAssignmentList] value:aValue]; }
  341. - assign:aList
  342.     { assignmentList = aList; return self; }
  343. - value:aValue
  344.     { if (value) info("value of %s reassigned\n", NAMEOF(self));
  345.     value = aValue; return self; }
  346. - value
  347.     { return value; }
  348. - gen { 
  349.     if (assignmentList) { id s, v;
  350.         for (s = [assignmentList eachElement]; v = [s next]; ) 
  351.             { [v gen]; gs(" = "); }
  352.         [s free];
  353.     }
  354.     [value gen]; 
  355.     if (successor) { gc(';'); [successor gen]; }
  356.     return self; 
  357. }
  358. - type { id type = [value type]; 
  359.     if (successor) [successor type];
  360. #ifndef COXLIB
  361.     if (assignmentList)
  362.         [assignmentList elementsPerform:@selector(type:rule:)
  363.             with:type with:"value assignment"];
  364. #else
  365.     if (assignmentList)
  366.         [assignmentList eachElementPerform:@selector(type:rule:)
  367.             with:type with:"value assignment"];
  368. #endif
  369.     return type;
  370. }
  371. - cascade:anExpr { 
  372.     id newReceiver = [Identifier uniqueIdentifier:"tmp"];
  373.     if ([value isKindOf:Msg]) { 
  374.         id newValue = [Msg receiver:newReceiver selector:[value selector]];
  375.         id newExpr = [Expr assign:assignmentList value:newValue];
  376.         value = [value receiver];
  377.         assignmentList = [List with:1, newReceiver];
  378.         [self successor:newExpr]; [newExpr successor:anExpr];
  379.         do { id msg = [newExpr value];
  380.             if ([msg isKindOf:Msg]) [msg receiver:newReceiver]; 
  381.         } while (newExpr = [newExpr successor]);
  382.     } else {
  383.         if (!assignmentList) assignmentList = [List new];
  384.         [assignmentList add:newReceiver];
  385.         [self successor:anExpr];
  386.     }
  387.     [temporaryVariablePool add:newReceiver];
  388.     return self;
  389. }
  390. - free { [assignmentList free]; [value free]; return [super free]; }
  391. \Rogue\Monster\
  392. else
  393.   echo "will not over write ./src/Expr.m"
  394. fi
  395. if `test ! -s ./src/FunctionTranslation.m`
  396. then
  397. echo "writting ./src/FunctionTranslation.m"
  398. cat > ./src/FunctionTranslation.m << '\Rogue\Monster\'
  399. #include "Producer.h"
  400. = FunctionTranslation : AbstractTranslation CATEGORIES() {
  401.     id functionName;
  402.     id functionArgumentList;
  403. }
  404. + name:aFunctionName args:anArgumentList {
  405.     self = [super new];
  406.     functionName = aFunctionName;
  407.     functionArgumentList = anArgumentList;
  408.     return self;
  409. }
  410. - genReceiver:aReceiver selector:aSelector {
  411.     id arg; unsigned argNumber = 0; USE Msg;
  412.     [functionName gen]; gc('(');
  413.     for (arg = functionArgumentList; arg; arg = [arg successor]) {
  414.         STR name = [arg str]; 
  415.         if (argNumber != 0) gc(',');
  416.         if (*name == '%') {
  417.             unsigned index = atoi(name+1);
  418.             if (index == 0) [aReceiver gen];
  419.             else if (index >= [aSelector size])
  420.                 wer("argument offset %d out of range", index);
  421.             else [[[aSelector at:index-1] argument] gen];
  422.         } else if (argNumber == 0) [aReceiver gen];
  423.         else [[[aSelector at:argNumber-1] argument] gen];
  424.         argNumber++;
  425.     }
  426.     gc(')'); return self;
  427. }
  428. - (STR)str { return [functionName str]; }
  429. #define MAXARRAY 2048
  430. - asTypedByteArray { char buf[MAXARRAY]; id arg; USE ByteArray;
  431.     strcpy(buf, [functionName str]);
  432.     for (arg = functionArgumentList; arg; arg = [arg successor]) {
  433.         sprintf(buf+strlen(buf), "(%s)%s ", 
  434.             [[arg argumentType] str], [[arg argumentName] str]);;
  435.     }
  436.     return [ByteArray str:buf];
  437. }
  438. \Rogue\Monster\
  439. else
  440.   echo "will not over write ./src/FunctionTranslation.m"
  441. fi
  442. if `test ! -s ./src/Identifier.m`
  443. then
  444. echo "writting ./src/Identifier.m"
  445. cat > ./src/Identifier.m << '\Rogue\Monster\'
  446. #include "Producer.h"
  447.     USE Set, OrdCltn;
  448.     IMPORT id identifierTranslator;
  449. = Identifier:ByteArray CATEGORIES() 
  450.     { id translation, type; }
  451. + name:aByteArray 
  452.     { return [self str:[aByteArray str]]; }
  453. + str:(STR)aString { 
  454.     self = [super str:aString];
  455.     type = types.UNKNOWN;
  456.     translation = [identifierTranslator find:self];
  457.     return self;
  458. }
  459. + uniqueIdentifier:(STR)aString { static int uniqueness = 0;
  460.     return [self sprintf:"%s%d", aString, uniqueness++];
  461. }
  462. - gen {
  463.     if (translation) [translation gen];
  464.     else gs([self str]); 
  465.     return self; 
  466. }
  467. - genDeclaration {
  468.     if (translation) [translation genDeclaration];
  469.     else {
  470.         if (type == nil) gs("<nil>"); else [type gen];
  471.         gc(' '); gs([self str]); gc(';');
  472.     }
  473.     return self;
  474. }
  475. - type { 
  476.     if (translation) return type = [translation type];
  477.     // dbg("%s: (%s)%s\n", NAMEOF(self), [type str], [self str]);
  478.     // if (type == types.UNKNOWN) [self type:types.ID rule:"default: first use"];
  479.     return type; 
  480. }
  481. - type:aType rule:(STR)aString {
  482.     if (translation && type != aType) {
  483.         info("attempt to change type of translated symbol %s ignored (%s)",
  484.             [self str], aString);
  485.         return self;
  486.     }
  487.     if (aType == nil)
  488.         return [self error:"nil type"]; 
  489.     if (type != types.UNKNOWN && aType != type) {
  490.         wer("%s %s; tried to change type from %s to %s ignored (%s)",
  491.             NAMEOF(self), [self str], [type str], [aType str], aString);
  492.     } else {
  493.         info("type of %s is (%s) (%s)\n", [self str], [aType str], aString);
  494.         type = aType;
  495.     }
  496.     return self;
  497. }
  498. - free { return nil; }
  499. =:
  500. \Rogue\Monster\
  501. else
  502.   echo "will not over write ./src/Identifier.m"
  503. fi
  504. if `test ! -s ./src/IdentifierTranslation.m`
  505. then
  506. echo "writting ./src/IdentifierTranslation.m"
  507. cat > ./src/IdentifierTranslation.m << '\Rogue\Monster\'
  508. // type inferencing template
  509. #include "Producer.h"
  510. #include "assert.h"
  511.     USE Set, IntArray, Msg;
  512.     IMPORT id identifierTranslator, globalSymbols;
  513. = IdentifierTranslation:ByteArray CATEGORIES() 
  514.     { id type, targetIdentifier; }
  515. + sourceName:sourceIdentifier targetType:aType targetName:anIdentifier {
  516.     id result;
  517.     self = [super str:[sourceIdentifier str]]; [sourceIdentifier free];
  518.     targetIdentifier = anIdentifier;
  519.     if (aType == 0 || aType == types.UNKNOWN) type = types.ID;
  520.     else type = aType;
  521.     [targetIdentifier type:type rule:"explicit rule"];
  522. #ifndef COXLIB
  523.     if ([identifierTranslator addNTest:self]) result = self;
  524.     else result = [identifierTranslator find:self];
  525. #else
  526.     result = [identifierTranslator add:self];
  527. #endif
  528.     if (result && result != self && result->type != type) {
  529.         dbg("result=%x result->type=%x\n", result, result->type);
  530.         wer("incompatible translations for identifier %s. Using %s, ignoring %s",
  531.             [self str], [type str], [result->type str]);
  532.     }
  533.     [globalSymbols add:self];
  534.     return self;
  535. }
  536. - type
  537.     { return type; }
  538. - type:aType rule:(STR)aString { 
  539.     info("IdentifierTranslation %s ignored type change from %s to %s",
  540.         [self str], [type str], [aType str]);
  541.     return self; 
  542. }
  543. - gen 
  544.     { gs([targetIdentifier str]); return self; }
  545. - genDeclaration { 
  546.     [type gen]; gc(' '); gs([targetIdentifier str]); gc(';');
  547.     return self;
  548. }
  549. - targetIdentifier
  550.     { return targetIdentifier; }
  551. - free
  552.     { return nil; }
  553. - asTypedByteArray 
  554.     { return [ByteArray sprintf:"(%s)%s", [type str], [self str]]; }
  555. =:
  556. \Rogue\Monster\
  557. else
  558.   echo "will not over write ./src/IdentifierTranslation.m"
  559. fi
  560. if `test ! -s ./src/List.m`
  561. then
  562. echo "writting ./src/List.m"
  563. cat > ./src/List.m << '\Rogue\Monster\'
  564. #include "Producer.h"
  565. = List:OrdCltn CATEGORIES()
  566. #ifndef COXLIB
  567. - gen { [self elementsPerform:_cmd]; return self; }
  568. #else
  569. - gen { [self eachElementPerform:_cmd]; return self; }
  570. #endif
  571. \Rogue\Monster\
  572. else
  573.   echo "will not over write ./src/List.m"
  574. fi
  575. if `test ! -s ./src/METHODDECLS.m`
  576. then
  577. echo "writting ./src/METHODDECLS.m"
  578. cat > ./src/METHODDECLS.m << '\Rogue\Monster\'
  579. #include "Producer.h"
  580. = METHODDECLS:Object CATEGORIES() {}
  581. - (BOOL)isEmpty {;}
  582. - (BOOL)isEqual:aStr {;}
  583. - (BOOL)isEqualSTR:(STR)aStr {;}
  584. - (BOOL)isUnary {;}
  585. - (STR)str {;}
  586. - (unsigned)hash {;}
  587. - (unsigned)size {;}
  588. - add:aLink {;}
  589. - argument {;}
  590. - argument:anArgument {;}
  591. - argumentType {;}
  592. - array:anArray {;}
  593. - asByteArray {;}
  594. - assign:aList {;}
  595. - assign:anAssignmentList value:aValue {;}
  596. - at:(unsigned)anInt {;}
  597. - cascade:anExpr {;}
  598. - category:aString {;}
  599. - classVariableNames:aString {;}
  600. - comment:aString {;}
  601. - elementsPerform:(SEL)aSelector with:arg1 with:arg2 {;}
  602. - elementsPerform:(SEL)aSelector with:arg1 {;}
  603. - elementsPerform:(SEL)aSelector {;}
  604. - eachElementPerform:(SEL)aSelector with:arg1 with:arg2 {;}
  605. - eachElementPerform:(SEL)aSelector with:arg1 {;}
  606. - eachElementPerform:(SEL)aSelector {;}
  607. - expr {;}
  608. - expr:anExpr {;}
  609. - free {;}
  610. - freeContents {;}
  611. - gen {;}
  612. - genDeclaration {;}
  613. - genExpr {;}
  614. - genPrivate {;}
  615. - genReceiver:aReceiver selector:aSelector {;}
  616. - initialize {;}
  617. - insert:aLink {;}
  618. - install:aTemplate translation:aTranslation {;}
  619. - instanceVariableNames:aString {;}
  620. - lastElement {;}
  621. - name:aByteArray {;}
  622. - name:aFunctionName args:anArgumentList {;}
  623. - name:aString argument:anArgument {;}
  624. - poolDictionaries:aString {;}
  625. - predecessorOf:aLink {;}
  626. - primitive:aToken {;}
  627. - receiver {;}
  628. - receiver:anObject selector:aSelector {;}
  629. - receiver:anObject {;}
  630. - receiverType {;}
  631. - receiverType:aType selector:aSelector {;}
  632. - remove:aLink {;}
  633. - selector {;}
  634. - selector:aSelector asFactory:(BOOL)isFactoryMethod {;}
  635. - selector:aSelector {;}
  636. - sourceName:sourceIdentifier targetType:aType targetName:anIdentifier {;}
  637. - statements:aStatementList {;}
  638. - str:(STR)aString {;}
  639. - successor {;}
  640. - successor:aLink {;}
  641. - superclass:aClass {;}
  642. - template:aTemplate translation:aTranslation {;}
  643. - translation {;}
  644. - translation:aTranslation {;}
  645. - translationFor:aMsg {;}
  646. - type {;}
  647. - type:aType name:aName {;}
  648. - type:aType rule:(STR)aString {;}
  649. - type:aType translation:aByteArray {;}
  650. - type:aType {;}
  651. - uniqueIdentifier:(STR)aString {;}
  652. - value {;}
  653. - value:aValue {;}
  654. - variables:aVarList {;}
  655. \Rogue\Monster\
  656. else
  657.   echo "will not over write ./src/METHODDECLS.m"
  658. fi
  659. if `test ! -s ./src/Method.m`
  660. then
  661. echo "writting ./src/Method.m"
  662. cat > ./src/Method.m << '\Rogue\Monster\'
  663. #include "Producer.h"
  664.     IMPORT id symbolScope;
  665.     USE Set, Identifier;
  666.     EXPORT id temporaryVariablePool = nil;
  667. = Method:Object CATEGORIES() {
  668.     id selector, comment, primitive, statements; 
  669.     id argumentVariables, localVariables;
  670.     id type, concatenatedSelector;
  671.     BOOL isFactory; 
  672.     id translation;
  673. }
  674. + selector:aSelector asFactory:(BOOL)aBoolean { id sel, arg;
  675.     self = [super new]; selector = aSelector; isFactory = aBoolean;
  676.     concatenatedSelector = [aSelector asByteArray];
  677.     argumentVariables = [Set new]; type = types.UNKNOWN;
  678.     [argumentVariables add:[[Identifier str:"self"] 
  679.         type:types.ID rule:"hardwired"]];
  680.     for (sel = aSelector; sel && (arg = [sel argument]); sel = [sel successor])
  681.         [argumentVariables add:arg];
  682.     [symbolScope add:argumentVariables];
  683.     temporaryVariablePool = localVariables = [Set new];
  684.     return self;
  685. }
  686. - receiverType
  687.     { return types.ID; }
  688. - comment:aString { comment = aString; return self; }
  689. - variables:aVarList { 
  690.     [aVarList addContentsTo:localVariables];
  691.     [symbolScope add:localVariables];
  692.     return self;
  693. }
  694. - selector
  695.     { return selector; }
  696. - statements:aStmtList 
  697.     { statements = aStmtList; return self; }
  698. - primitive:aToken 
  699.     { primitive = aToken; return self; }
  700. - gen { USE Return;
  701. dbg("//=======================Method gen==================================\n");
  702.     [self type];    // this triggers the type inferencing machinery
  703. dbg("//-----------------------Method gen----------------------------------\n");
  704.     gn(); gc(isFactory ? '+' : '-'); gc(' ');
  705.     if (type != types.ID) { gc('('); [type gen]; gc(')'); }
  706.     [selector genDeclaration]; gs(" {");
  707. #ifndef COXLIB
  708.     [localVariables elementsPerform:@selector(genDeclaration)];
  709. #else
  710.     [localVariables eachElementPerform:@selector(genDeclaration)];
  711. #endif
  712.     [primitive gen]; [statements gen]; 
  713.     if (![[statements lastElement] isKindOf:Return]) gs("return self;");
  714.     gc('}'); return self;
  715. }
  716. - type { IMPORT id msgTranslator; id t; STR failReason = "name not found";
  717.     id key, sourceStr, msgTranslation, stmt, s; 
  718.     if (translation) return [translation type];
  719.     [statements type]; [selector type];
  720.     key = [selector asByteArray]; sourceStr = [selector asTypedByteArray];
  721.     if (msgTranslation = [msgTranslator find:key]) { unsigned i, n; 
  722.         dbg("translation for method %s\n", [sourceStr str]);
  723.         if (![selector isUnary]) { id s;
  724.             for (s = selector; s; s = [s successor]) { id st = [s type];
  725.                 if (st == types.UNKNOWN) [s type:types.ID rule:"method arg"];
  726.             }
  727.         }
  728.         for (n = [msgTranslation size], i = 0; i < n; i++) { 
  729.             id s, p, targetPattern = [msgTranslation at:i], targetStr;
  730.             failReason = "types didn't match";
  731.             if (![selector isUnary]) { unsigned offset = 1;
  732.                 for (s = selector; s; s = [s successor]) {
  733.                     id rt = [s type], pt = [targetPattern at:offset++];
  734.                     dbg("    actualArgType=%s patternArgType=%s\n",
  735.                         [rt str], [pt str]);
  736.                     if ((pt != types.ANY) && (rt != pt))
  737.                         goto tryAgain;    // break out to try next pattern
  738.                 }
  739.             }
  740.             translation = [targetPattern translation];
  741.             type = [translation type];
  742.             targetStr = [translation asTypedByteArray];
  743.             info("method %s translated to (%s)%s (type match)\n", 
  744.                 [sourceStr str], [type str], [targetStr str]);
  745.             [targetStr free];
  746.             [translation assignTypesTo:selector];
  747.             goto succeed;
  748. tryAgain:;
  749.         }
  750.     }
  751.     info("method %s translated literally (%s)\n",
  752.         [sourceStr str], failReason);
  753. succeed:
  754.     if (!type) {
  755.         for (stmt = statements; stmt; stmt = [stmt successor]) {
  756.             if ([stmt isKindOf:Return])
  757.                 [self type:[stmt type] rule:"used type from return stmt"];
  758.         }
  759.     }
  760.     if (type == types.UNKNOWN) [self type:types.ID rule:"default method type"];
  761.     [key free]; [sourceStr free];
  762.     return type;
  763. }
  764. - type:aType rule:(STR)aString {
  765.     if (aType == nil) return [self error:"nil type"]; 
  766.     if (type != types.UNKNOWN && aType != type) {
  767.         wer("attempt to change type of method %s from %s to %s ignored (%s)",
  768.             [self str], [type str], [aType str], aString);
  769.     } else { id s = [selector asByteArray];
  770.         info("type of method %s set to (%s) (%s)\n", 
  771.             [s str], [aType str], aString);
  772.         [s free]; type = aType;
  773.     }
  774.     return self;
  775. }
  776. - free { 
  777.     [symbolScope remove:argumentVariables];
  778.     [symbolScope remove:localVariables];
  779.     [primitive free]; [selector free]; [comment free];
  780.     [argumentVariables freeContents]; [argumentVariables free];
  781.     [localVariables freeContents]; [localVariables free];
  782.     [concatenatedSelector free];
  783.     [statements free]; return [super free]; 
  784. }
  785. =:
  786. \Rogue\Monster\
  787. else
  788.   echo "will not over write ./src/Method.m"
  789. fi
  790. if `test ! -s ./src/Msg.m`
  791. then
  792. echo "writting ./src/Msg.m"
  793. cat > ./src/Msg.m << '\Rogue\Monster\'
  794. #include "Producer.h"
  795. = Msg:Object CATEGORIES() {
  796.     id receiver;
  797.     id selector;
  798.     id translation;
  799. }
  800.     IMPORT id msgTranslator;
  801.     USE Template;
  802. + receiver:anObject 
  803.     { return [[self new] receiver:anObject]; }
  804. + receiver:anObject selector:aSelector
  805.     { return [[[self new] receiver:anObject] selector:aSelector]; }
  806. + selector:aSelector
  807.     { return [[self new] selector:aSelector]; }
  808. - receiver 
  809.     { return receiver; }
  810. - receiverType
  811.     { return [receiver type]; }
  812. - receiver:anObject 
  813.     { receiver = anObject; return self; }
  814. - selector 
  815.     { return selector; }
  816. - selector:aSelector { 
  817.     selector = aSelector;
  818.     return self; 
  819. }
  820. - free {
  821.     [receiver free];
  822.     [selector free];
  823.     return [super free]; 
  824. }
  825.  
  826. // ByteArray Emulation
  827. - (STR)str 
  828.     { return [selector str]; }
  829. - (unsigned)hash 
  830.     { return _strhash([self str]); }
  831. - (BOOL)isEqual:aStr    
  832.     { return strcmp([self str], [aStr str]) == 0; }
  833. - (BOOL)isEqualSTR:(STR)aStr 
  834.     { return strcmp([self str], aStr) == 0; }
  835. - type { id type;
  836.     if (!translation) { unsigned i, n; STR failReason = 0;
  837.         id s, key = [selector asByteArray];
  838.         id msgTranslation, receiverType = [receiver type];
  839.         id sourceStr = [selector asTypedByteArray];
  840.         dbg("translating message [(%s) %s]\n",
  841.             [[receiver type] str], [sourceStr str]);
  842.         if (![selector isUnary]) {
  843.             for (s = selector; s; s = [s successor]) {
  844.                 id st = [s argumentType];
  845.                 if (st == types.UNKNOWN) [s type:types.ID rule:"msg arg"];
  846.             }
  847.         }
  848.         if (msgTranslation = [msgTranslator find:key]) {
  849.             for (n = [msgTranslation size], i = 0; i < n; i++) {
  850.                 unsigned offset = 0; id s, targetStr;
  851.                 id targetPattern = [msgTranslation at:i];
  852.                 id patternReceiverType = [targetPattern at:offset++];
  853.                 dbg("    actualReceiverType=%s patternReceiver=%s\n",
  854.                 [receiverType str], [patternReceiverType str]);
  855.                 failReason = "receiver types didn't match";
  856.                 if (patternReceiverType == types.ANY 
  857.                     || patternReceiverType == receiverType) {
  858.                     if (![selector isUnary]) { // if not unary selector
  859.                         failReason = "argument types didn't match";
  860.                         for (s = selector; s; s = [s successor]) {
  861.                             id rt = [s type], pt = [targetPattern at:offset++];
  862.                             dbg("    actualArgType=%s patternArgType=%s\n",
  863.                                 [rt str], [pt str]);
  864.                             if ((pt != types.ANY) && (rt != pt))
  865.                                 goto fail;    // break out to try next pattern
  866.                         }
  867.                     }
  868.                     translation = [targetPattern translation];
  869.                     targetStr = [translation asTypedByteArray];
  870.                     info("message [(%s)%s] translated to (%s)%s (type match)\n",
  871.                         [receiverType str], [sourceStr str],
  872.                         [[translation type] str], [targetStr str]);
  873.                     [targetStr free];
  874.                     goto succeed;
  875.                 }
  876. fail:;
  877.             }
  878.         } else failReason = "name not found";
  879.         info("message [(%s)%s] translated literally (%s)\n", 
  880.             [receiverType str], [sourceStr str], failReason);
  881. succeed:
  882.         [key free]; [sourceStr free]; 
  883.         if ([receiver type] == types.UNKNOWN)
  884.             [receiver type:types.ID rule:"message receiver"];
  885.     }
  886.     type = translation ? [translation type] : types.ID;
  887.     return type == types.UNKNOWN ? types.ID : type;
  888. }
  889. - gen {
  890.     if (translation) [translation genReceiver:receiver selector:selector];
  891.     else { 
  892.         gc('['); [receiver gen]; gc(' '); [selector gen]; gc(']'); }
  893.     return self; 
  894. }
  895. =:
  896. \Rogue\Monster\
  897. else
  898.   echo "will not over write ./src/Msg.m"
  899. fi
  900. if `test ! -s ./src/MsgArgPattern.m`
  901. then
  902. echo "writting ./src/MsgArgPattern.m"
  903. cat > ./src/MsgArgPattern.m << '\Rogue\Monster\'
  904. #include "Producer.h"
  905. = MsgArgPattern : IdArray CATEGORIES() 
  906.     { id translation; }
  907. + template:aTemplate translation:aTranslation { id s; unsigned i = 0;
  908.     self = [self new:[aTemplate size]+1];
  909.     [self at:i++ put:[aTemplate receiverType]];
  910.     for (s = [aTemplate selector]; s; s = [s successor]) {
  911.         id t = [s type];
  912.         if (t == 0 || t == types.UNKNOWN) t = types.ANY;
  913.         [self at:i++ put:t];
  914.     }
  915.     return [self translation:aTranslation];
  916. }
  917. - type
  918.     { return [translation type]; }
  919. - translation:aTranslation
  920.     { translation = aTranslation; return self; }
  921. - translation
  922.     { return translation; }
  923. \Rogue\Monster\
  924. else
  925.   echo "will not over write ./src/MsgArgPattern.m"
  926. fi
  927. if `test ! -s ./src/MsgNamePattern.m`
  928. then
  929. echo "writting ./src/MsgNamePattern.m"
  930. cat > ./src/MsgNamePattern.m << '\Rogue\Monster\'
  931. // Each message may have several translations depending on the type of
  932. //    the receiver and the message's arguments. MsgNamePattern holds the
  933. //    name of the message (concatenated selector in selectorByteArray)
  934. //    and an ordered collection of MsgArgPatterns. These are IdArrays
  935. //    holding the type of the receiver followed by the types of the arguments.
  936. //    Each MsgArgPattern also holds the translation for the messages that
  937. //    match in name and argument type.
  938. #include "Producer.h"
  939. = MsgNamePattern : OrdCltn CATEGORIES()
  940.     { id selectorByteArray; }
  941. + name:aByteArray
  942.     { self = [super new]; selectorByteArray = aByteArray; return self; }
  943. - (unsigned)hash
  944.     { return [selectorByteArray hash]; }
  945. - (BOOL)isEqual:aMsgNamePattern
  946.     { return [selectorByteArray isEqual:aMsgNamePattern]; }
  947. - (STR)str
  948.     { return [selectorByteArray str]; }
  949. \Rogue\Monster\
  950. else
  951.   echo "will not over write ./src/MsgNamePattern.m"
  952. fi
  953. if `test ! -s ./src/MsgTranslation.m`
  954. then
  955. echo "writting ./src/MsgTranslation.m"
  956. cat > ./src/MsgTranslation.m << '\Rogue\Monster\'
  957. #include "Producer.h"
  958. = MsgTranslation : AbstractTranslation CATEGORIES()
  959.     { id receiverType, selector; }
  960. + receiverType:aType selector:aSelector {
  961.     self = [super type:types.ID];
  962.     receiverType = aType ? aType : types.ANY;
  963.     selector = aSelector;
  964.     return self;
  965. }
  966. - selector
  967.     { return selector; }
  968. - receiverType
  969.     { return receiverType; }
  970. - (STR)str
  971.     { return [selector str]; }
  972. - genReceiver:aReceiver selector:aSelector {
  973.     USE Msg; unsigned argNumber = 0; id sel;
  974.     gc('['); [aReceiver gen]; 
  975.     for (sel = selector; sel; sel = [sel successor], argNumber++) {
  976.         STR name = [sel str]; gc(' ');
  977.         if (*name == '%') {
  978.             unsigned index = atoi(&name[1]);
  979.             if (index == 0)
  980.                 wer("%%0 not allowed in MsgPattern rules");
  981.             else if (index >= [aSelector size]) {
  982.                 wer("argument offset %d out of range", index);
  983.             } else {
  984.                 gs([[selector at:index-1] str]);
  985.                 [[[aSelector at:index-1] argument] gen];
  986.             }
  987.         } else { 
  988.             gs([[selector at:argNumber] str]); 
  989.             [[[aSelector at:argNumber] argument] gen];
  990.         }
  991.     }
  992.     gc(']'); return self;
  993. }
  994. - asTypedByteArray 
  995.     { return [selector asTypedByteArray]; }
  996. - free
  997.     { return nil; }
  998. - assignTypesTo:aSelector {
  999.     id s = aSelector, p = [self selector];
  1000.     while(s && p) { [s type:[p type]];
  1001.         s = [s successor]; p = [p successor];
  1002.     }
  1003.     return self;
  1004. }
  1005. \Rogue\Monster\
  1006. else
  1007.   echo "will not over write ./src/MsgTranslation.m"
  1008. fi
  1009. if `test ! -s ./src/MsgTranslator.m`
  1010. then
  1011. echo "writting ./src/MsgTranslator.m"
  1012. cat > ./src/MsgTranslator.m << '\Rogue\Monster\'
  1013. // MsgTranslator: a set of MsgNamePatterns. These hold a string (the
  1014. //    concatenated selector characters) and a collection of MsgArgPatterns
  1015. //    describing one of the types (for receiver and arguments) for which
  1016. //    a translation is known
  1017. #include "Producer.h"
  1018.     EXPORT id msgTranslator = nil;
  1019.     USE MsgNamePattern, MsgArgPattern, Msg;
  1020. = MsgTranslator : Set CATEGORIES()
  1021. + initialize 
  1022.     { if (!msgTranslator) msgTranslator = [self new]; return self; }
  1023. - install:aTemplate translation:aTranslation {
  1024.     id name = [[aTemplate selector] asByteArray];
  1025.     id msgNamePattern = [self find:name];
  1026.     if (msgNamePattern) [name free];
  1027.     else [self add:msgNamePattern=[MsgNamePattern name:name]];
  1028.     [msgNamePattern add:[MsgArgPattern
  1029.         template:aTemplate translation:aTranslation]];
  1030.     return self;
  1031. }
  1032. \Rogue\Monster\
  1033. else
  1034.   echo "will not over write ./src/MsgTranslator.m"
  1035. fi
  1036. if `test ! -s ./src/Node.m`
  1037. then
  1038. echo "writting ./src/Node.m"
  1039. cat > ./src/Node.m << '\Rogue\Monster\'
  1040. #include "Producer.h"
  1041. = Node:Object CATEGORIES() { id successor; }
  1042. - successor { return successor; }
  1043. - successor:aLink { id me = successor; successor = aLink; return me; }
  1044.  
  1045. - lastElement { while(successor) self = successor; return self; }
  1046. // Reply the predecessor of the indicated link.
  1047. - predecessorOf:aLink {
  1048.     do { if (successor == aLink) return self; } while (self = successor);
  1049.     return nil;
  1050. }
  1051. // Reply the n'th link in this chain.
  1052. - at:(unsigned)anInt { register unsigned i = anInt; register id obj = self;
  1053.     while (i-- && obj) obj = obj->successor;
  1054.     return obj ? obj : [self error:"range error: %d", anInt];
  1055. }
  1056. // Append another instance to this chain.
  1057. - add:aLink { id me = self; while (successor) self = successor;
  1058.     successor = aLink; return me;
  1059. }
  1060. // Free this link and all successors
  1061. - freeContents { register id next;
  1062.     do { next = successor; [super free]; } while (self = next);
  1063. }
  1064. // remove
  1065. - remove:aLink { self =[self predecessorOf:aLink];
  1066.      if (self == nil) return nil;
  1067.      successor= [ aLink successor];
  1068.      return aLink;
  1069. }
  1070. // insert
  1071. - insert:aLink 
  1072.     { [ aLink successor:successor]; successor= aLink; return self; }
  1073.  
  1074. - gen 
  1075.     { [self show]; [successor show]; return self; }
  1076. - free 
  1077.     { [successor free]; return [super free]; }
  1078.  
  1079. // Reply the number of linked instances
  1080. #ifdef OBSOLETE
  1081. - (unsigned)size 
  1082.     { register unsigned n = 1; while(self = successor) n++; return n; }
  1083. #endif
  1084. - (unsigned)size 
  1085.     { unsigned i; for (i=1; self = successor; i++); return i; }
  1086.  
  1087. #ifndef COXLIB
  1088. - elementsPerform:(SEL)aSelector {
  1089.     do { [self perform:aSelector]; } while (self = successor);
  1090.     return self;
  1091. }
  1092. - elementsPerform:(SEL)aSelector with:arg1 {
  1093.     do { [self perform:aSelector with:arg1]; } while (self = successor);
  1094.     return self;
  1095. }
  1096. - elementsPerform:(SEL)aSelector with:arg1 with:arg2 {
  1097.     do { [self perform:aSelector with:arg1 with:arg2]; } while (self = successor);
  1098.     return self;
  1099. }
  1100. #else
  1101. - eachElementPerform:(SEL)aSelector {
  1102.     do { [self perform:aSelector]; } while (self = successor);
  1103.     return self;
  1104. }
  1105. - eachElementPerform:(SEL)aSelector with:arg1 {
  1106.     do { [self perform:aSelector with:arg1]; } while (self = successor);
  1107.     return self;
  1108. }
  1109. - eachElementPerform:(SEL)aSelector with:arg1 with:arg2 {
  1110.     do { [self perform:aSelector with:arg1 with:arg2]; } while (self = successor);
  1111.     return self;
  1112. }
  1113. #endif
  1114. =:
  1115. \Rogue\Monster\
  1116. else
  1117.   echo "will not over write ./src/Node.m"
  1118. fi
  1119. if `test ! -s ./src/Scope.m`
  1120. then
  1121. echo "writting ./src/Scope.m"
  1122. cat > ./src/Scope.m << '\Rogue\Monster\'
  1123. // Symbol scoping
  1124. //    A scope is an ordered collection Sets of identifiers
  1125. #include "Producer.h"
  1126.     USE Set, IntArray, Msg;
  1127.     EXPORT id symbolScope  = nil,
  1128.         undefinedSymbols = nil,
  1129.         globalSymbols = nil,
  1130.         identifierTranslator = nil;
  1131. = Scope:OrderedCollection CATEGORIES() 
  1132. + initialize { 
  1133.     if (!symbolScope) {
  1134.         symbolScope = [self new]; 
  1135.         undefinedSymbols = [Set new];
  1136.         globalSymbols = [Set new];
  1137.         [symbolScope add:globalSymbols];
  1138.         [symbolScope add:undefinedSymbols];
  1139.         identifierTranslator = [Set new];
  1140.     }
  1141.     return self;
  1142. }
  1143. =:
  1144. id findSymbol(aVariable) id aVariable; {
  1145.     int i, n = [symbolScope size];
  1146.     for (i = n-1; i >= 0; i--) { id hit;
  1147.         if (hit = [[symbolScope at:i] find:aVariable]) 
  1148.             return hit;
  1149.     }
  1150.     info("undefined %s %s\n", NAMEOF(aVariable), [aVariable str]);
  1151.     [undefinedSymbols add:aVariable]; return aVariable;
  1152. }
  1153. \Rogue\Monster\
  1154. else
  1155.   echo "will not over write ./src/Scope.m"
  1156. fi
  1157. if `test ! -s ./src/NumberConstant.m`
  1158. then
  1159. echo "writting ./src/NumberConstant.m"
  1160. cat > ./src/NumberConstant.m << '\Rogue\Monster\'
  1161. #include "Producer.h"
  1162. = NumberConstant : Constant CATEGORIES() {}
  1163. - gen 
  1164.     { gs([self str]); return self; }
  1165. + str:(STR)aString
  1166.     { return [super str:aString]; }
  1167. - type 
  1168.     { return index([self str], '.') ? types.FLOAT : types.INT; }
  1169. \Rogue\Monster\
  1170. else
  1171.   echo "will not over write ./src/NumberConstant.m"
  1172. fi
  1173. if `test ! -s ./src/Return.m`
  1174. then
  1175. echo "writting ./src/Return.m"
  1176. cat > ./src/Return.m << '\Rogue\Monster\'
  1177. #include "Producer.h"
  1178. = Return:Node CATEGORIES() { id body; }
  1179. + expr:anExpr { self = [super new]; body = anExpr; return self; }
  1180. - gen { [self genExpr]; gc(';'); return self; }
  1181. - genExpr { gs("return "); [body gen]; return self; }
  1182. - free { [body free]; return [super free]; }
  1183. - type { return [body type]; }
  1184. \Rogue\Monster\
  1185. else
  1186.   echo "will not over write ./src/Return.m"
  1187. fi
  1188. if `test ! -s ./src/Selector.m`
  1189. then
  1190. echo "writting ./src/Selector.m"
  1191. cat > ./src/Selector.m << '\Rogue\Monster\'
  1192. #include "Producer.h"
  1193. #define strEq(p, q) (strcmp(p, q) == 0)
  1194. #define strHas(s, c) (index(s, c) != 0)
  1195. #define MAXSELECTOR 512
  1196.     STR strCopy(), xlate();
  1197.     USE ByteArray, IdArray; 
  1198.  
  1199. = Selector:Node CATEGORIES() 
  1200.     { STR name; id argument; }
  1201. + name:aString argument:anArgument 
  1202.     { return [[self name:aString] argument:anArgument]; }
  1203. + name:aString 
  1204.     { return [self str:[aString str]]; }
  1205. + str:(STR)aString { 
  1206.     self = [super new];
  1207.     name = strCopy(aString);
  1208.     if (strlen(name) < 1) return [self error:"nil selector"];
  1209.     return self; 
  1210. }
  1211. // Inherited deepCopy seems to not copy the name argument correctly
  1212. - deepCopy {
  1213.     id t = [[isa str:name] argument:argument]; 
  1214.     [t successor:[successor deepCopy]];
  1215.     return t;
  1216. }
  1217. - (BOOL)isUnary
  1218.     { return argument == nil; }
  1219. - asByteArray { char strBuf[MAXSELECTOR]; strBuf[0] = 0;
  1220.     do { strcat(strBuf, name); } while (self = successor);
  1221.     return [ByteArray str:strBuf];
  1222. }
  1223. - asTypeArray { id typeArray;
  1224.     if ([self isUnary]) typeArray = [IdArray new:0];
  1225.     else { 
  1226.         typeArray = [IdArray new:[self size]];
  1227.         do { [typeArray add:[argument type]]; } while (self = successor);
  1228.     }
  1229.     return typeArray;
  1230. }
  1231. - asTypedByteArray { char strBuf[MAXSELECTOR]; strBuf[0] = 0;
  1232.     do { strcat(strBuf, name);
  1233.         if (argument)
  1234.             sprintf(strBuf+strlen(strBuf), "(%s) ", [[argument type] str]);;
  1235.     } while (self = successor);
  1236.     return [ByteArray str:strBuf];
  1237. }
  1238.  
  1239. // ByteArray emulation
  1240. - (STR)str 
  1241.     { return name; }
  1242. - (unsigned)hash 
  1243.     { return _strhash(name); }
  1244. - (BOOL)isEqual:anObject 
  1245.     { return self == anObject || strcmp(name, [anObject str]) == 0; }
  1246. - (BOOL)isEqualSTR:(STR)aStr 
  1247.     { return strcmp(name, aStr) == 0; }
  1248. - type {
  1249.     if (successor) [successor type];
  1250.     return [argument type];
  1251. }
  1252. - type:aType
  1253.     { return [self type:aType rule:"force"]; }
  1254. - type:aType rule:(STR)aString 
  1255.     { [argument type:aType rule:aString]; return self; }
  1256. - argument:anArgument 
  1257.     { argument = anArgument; return self; }
  1258. - argument 
  1259.     { return argument; }
  1260. - argumentType
  1261.     { return [argument type]; }
  1262. - free 
  1263.     { free(name); [argument free]; return [super free]; }
  1264. - gen {
  1265.     gs(xlate(name)); [argument gen]; 
  1266.     if (successor) { gc(' '); [successor gen]; }
  1267.     return self; 
  1268. }
  1269. - genDeclaration {
  1270.     gs(xlate(name));
  1271.     if (argument && [argument type] != types.ID) 
  1272.         { gc('('); gs([[argument type] str]); gc(')'); }
  1273.     [argument gen];
  1274.     if (successor) { gc(' '); [successor genDeclaration]; }
  1275.     return self; 
  1276. }
  1277. =:
  1278. // Translate Smalltalk binary selectors to Objective-C keyword
  1279. static STR xlate(s) STR s; {
  1280.     static STR binarySelectorTbl= // parallel arrays!
  1281.             "+-/\\*~<>=@%&?!,|",
  1282.         objcSelectorStrings[]= { "plus", "minus", "slash", "backslash",
  1283.             "times", "tilde", "lesser", "greater", "equals", "point", "percent",
  1284.             "ampersand", "question", "bang", "comma", "or", "/*@*/", 0};
  1285.     STR i, index(); static char buf[MAXSELECTOR];
  1286.     *buf = 0;
  1287.     if (i = index(binarySelectorTbl, s[0])) {
  1288.         strcat(buf, objcSelectorStrings[i-binarySelectorTbl]);
  1289.         if (s[1]) {
  1290.             if (i = index(binarySelectorTbl, s[1]))
  1291.                 strcat(buf, objcSelectorStrings[i-binarySelectorTbl]);
  1292.             else wer("bad char in binary selector <%c>", s[1]);
  1293.             if (s[2]) wer("binary selector more than 2 chars long <%s>", s);
  1294.         }
  1295.         strcat(buf, ":");
  1296.         return buf;
  1297.     }
  1298.     return s;
  1299. }
  1300. \Rogue\Monster\
  1301. else
  1302.   echo "will not over write ./src/Selector.m"
  1303. fi
  1304. if `test ! -s ./src/SelectorConstant.m`
  1305. then
  1306. echo "writting ./src/SelectorConstant.m"
  1307. cat > ./src/SelectorConstant.m << '\Rogue\Monster\'
  1308. #include "Producer.h"
  1309. = SelectorConstant : Constant CATEGORIES() {}
  1310. - type
  1311.     { return types.SELECTOR; }
  1312. - gen
  1313.     { id t = types.SELECTOR;  
  1314.     dbg("%s: (%s)%s\n", NAMEOF(self), [t str], [self str]);
  1315.     gs("@selector("); [super gen]; gc(')'); return self; }
  1316. =:
  1317. \Rogue\Monster\
  1318. else
  1319.   echo "will not over write ./src/SelectorConstant.m"
  1320. fi
  1321. if `test ! -s ./src/StArray.m`
  1322. then
  1323. echo "writting ./src/StArray.m"
  1324. cat > ./src/StArray.m << '\Rogue\Monster\'
  1325. #include "Producer.h"
  1326. = StArray:OrdCltn  CATEGORIES() 
  1327.     { id type; }
  1328. - gen { id s, m;
  1329.     gs("={"); 
  1330.     for (s = [self eachElement]; m = [s next]; )
  1331.         { [m gen]; gs(", "); }
  1332.     [s free]; gc('}'); return self; 
  1333. }
  1334. - type { id s, m;
  1335.     if (type) return type;
  1336.     if ([self isEmpty]) return types.ID;
  1337.     type = [[self firstElement] type];
  1338.     for (s = [self eachElement]; m = [s next]; )
  1339.         if ([m type] != type) wer("this array holds diverse types");
  1340.     [s free];
  1341.     return type;
  1342. }
  1343. \Rogue\Monster\
  1344. else
  1345.   echo "will not over write ./src/StArray.m"
  1346. fi
  1347. if `test ! -s ./src/Stmt.m`
  1348. then
  1349. echo "writting ./src/Stmt.m"
  1350. cat > ./src/Stmt.m << '\Rogue\Monster\'
  1351. #include "Producer.h"
  1352. = Stmt:Node CATEGORIES() { id expr, type; }
  1353. + expr:anExpr { self = [super new]; expr = anExpr; return self; }
  1354. - expr { return expr; }
  1355. - free { [expr free]; return [super free]; }
  1356. - gen {
  1357.     [expr gen]; if (type != types.STMT) gc(';'); 
  1358.     [successor gen]; return self; 
  1359. }
  1360. - genExpr { [expr gen];
  1361.     if (successor) { if (type != types.STMT) gc(';'); [successor gen]; }
  1362.     return self; 
  1363. }
  1364. - type { 
  1365.     if (type) return type;
  1366.     type = [expr type]; 
  1367.     [successor type];
  1368.     return type;
  1369. }
  1370. \Rogue\Monster\
  1371. else
  1372.   echo "will not over write ./src/Stmt.m"
  1373. fi
  1374. if `test ! -s ./src/StringConstant.m`
  1375. then
  1376. echo "writting ./src/StringConstant.m"
  1377. cat > ./src/StringConstant.m << '\Rogue\Monster\'
  1378. #include "Producer.h"
  1379. = StringConstant : Constant CATEGORIES() {}
  1380. + str:(STR)aString { STR rindex(), p;
  1381.     if (*aString == '\'' && (p = rindex(aString, '\''))) {
  1382.         char c = *p; *p = 0;
  1383.         self = [super str:aString+1];
  1384.         *p = c;
  1385.         return self;
  1386.     } else return [super str:aString];
  1387. }
  1388. - type 
  1389.     { id t = types.CSTRING; return t; }
  1390. - gen
  1391.     { gc('"'); [super gen]; gc('"'); return self; }
  1392. =:
  1393. \Rogue\Monster\
  1394. else
  1395.   echo "will not over write ./src/StringConstant.m"
  1396. fi
  1397. if `test ! -s ./src/StringTranslation.m`
  1398. then
  1399. echo "writting ./src/StringTranslation.m"
  1400. cat > ./src/StringTranslation.m << '\Rogue\Monster\'
  1401. // Translate message to string
  1402. #include "Producer.h"
  1403. #include "ctype.h"
  1404. = StringTranslation:AbstractTranslation  CATEGORIES() 
  1405.     { id translation; }
  1406. + type:aType translation:aByteArray 
  1407.     { return [[self type:aType] translation:aByteArray]; }
  1408. - translation:aByteArray
  1409.     { translation = aByteArray; return self; }
  1410. - (STR)str
  1411.     { return [translation str]; }
  1412. - genReceiver:aReceiver selector:aSelector {
  1413.     STR rindex(), q, p;
  1414.     p = [translation str];
  1415.     for (; *p; p++) {
  1416.         if (*p == '\\') {
  1417.             gc(*p++); gc(*p); continue;
  1418.         } else if (*p == '%') {
  1419.             unsigned index = atoi(++p);
  1420.             if (index == 0) [aReceiver gen];
  1421.             else if (--index >= [aSelector size])
  1422.                 wer("bad rule", index+1);
  1423.             else [[[aSelector at:index] argument] gen];
  1424.             while (isdigit(*p)) p++; p--;
  1425.         } else if (*p == '\n') {
  1426.             while(isspace(*p)) p++; p--;
  1427.         } else gc(*p);
  1428.     }
  1429.     return self;
  1430. }
  1431. - asTypedByteArray 
  1432.     { return [translation asByteArray]; }
  1433. =:
  1434. static verifyArgCount(targetString, sourcePattern)
  1435.     STR targetString; id sourcePattern; 
  1436. {
  1437.     STR p;
  1438.     for (p = targetString; *p; p++) {
  1439.         if (*p == '\\') {
  1440.             *p++; continue;
  1441.         } else if (*p == '%') {
  1442.             unsigned index = atoi(++p);
  1443.             if (index != 0 && --index >= [sourcePattern size])
  1444.                 wer("no such argument");
  1445.             while (isdigit(*p)) p++; p--;
  1446.         }
  1447.     }
  1448. }
  1449. \Rogue\Monster\
  1450. else
  1451.   echo "will not over write ./src/StringTranslation.m"
  1452. fi
  1453. if `test ! -s ./src/Template.m`
  1454. then
  1455. echo "writting ./src/Template.m"
  1456. cat > ./src/Template.m << '\Rogue\Monster\'
  1457. #include "Producer.h"
  1458. #define MAXSELECTOR 5000
  1459. = Template : ByteArray CATEGORIES() 
  1460.     { id receiverType, selector; }
  1461. + receiverType:aType selector:aSelector {
  1462.     char strBuf[MAXSELECTOR];
  1463.     id s = aSelector; strBuf[0] = 0;
  1464.     for (s = aSelector; s;  s = [s successor]) strcat(strBuf, [s str]);
  1465.     self = [super str:strBuf];
  1466.     receiverType = aType;
  1467.     selector = aSelector;
  1468.     return self;
  1469. }
  1470. - receiverType
  1471.     { return receiverType; }
  1472. - selector
  1473.     { return selector; }
  1474. \Rogue\Monster\
  1475. else
  1476.   echo "will not over write ./src/Template.m"
  1477. fi
  1478. echo "Finished archive 4 of 5"
  1479. exit
  1480. ----
  1481. Dieter H. Zebbedies ('dee-ter  ayech  'zeb-ed-eez)
  1482.  Zebb-Hoff Mach. Tool's Automated Manufacturing Project Cleveland, OH
  1483.  (USnail): 9535 Clinton Rd, Cleveland, OH 44144 (+216 631 6100) (+216 741-5994)
  1484.  (UUCP): ...{decvax,sun,cbosgd}!cwruecmp!zhmti!dieter
  1485.  (CSNET/ARPA/BITNET): dieter@CWRU.EDU
  1486.